From 0f0fe9f2ff32c48109e3715b57e4198014b6c3c0 Mon Sep 17 00:00:00 2001
From: marting <marting>
Date: Thu, 23 Sep 1999 17:46:46 +0000
Subject: [PATCH] updates from 0.5.2

---
 scsh/awk.scm             | 256 ++++++++++++++++++-------
 scsh/char-set.scm        | 393 +++++++++++++++++++++++++++------------
 scsh/defrec.scm          |  61 +++++-
 scsh/endian.scm          |   8 +-
 scsh/fileinfo.scm        |  76 ++++++--
 scsh/filemtch.scm        |  38 ++--
 scsh/fname.scm           |  30 +--
 scsh/fr.scm              |  72 ++-----
 scsh/glob.scm            | 145 ++++++++++-----
 scsh/network.scm         |  15 +-
 scsh/rdelim.scm          |  19 +-
 scsh/rx/re-low.scm       |   2 +
 scsh/rx/re1.c            |  59 +++---
 scsh/rx/re1.h            |  10 +-
 scsh/scsh-interfaces.scm | 102 ++++++++--
 scsh/scsh-package.scm    | 116 ++++++++----
 scsh/time.scm            |  21 ++-
 scsh/tty.scm             |  52 +++++-
 scsh/utilities.scm       |  44 +++++
 19 files changed, 1069 insertions(+), 450 deletions(-)

diff --git a/scsh/awk.scm b/scsh/awk.scm
index 4fdc230..7654e96 100644
--- a/scsh/awk.scm
+++ b/scsh/awk.scm
@@ -1,10 +1,26 @@
 ;;; An awk loop, after the design of David Albertz and Olin Shivers.
 ;;; Copyright (c) 1994 by Olin Shivers.
 
+;;; This uses the new RX SRE syntax. Defines a Clinger-Rees expander for
+;;; the old, pre-SRE syntax AWK, and one for the new SRE-syntax AWK.
+
+;;; Imports:
 ;;; - Requires RECEIVE from RECEIVING package.
 ;;; - Would require DESTRUCTURE from DESTRUCTURING package, but it appears
 ;;;   to be broken, so we hack it w/cars and cdrs.
-;;; - Requires STRING-MATCH from SCSH package.
+;;; - Requires STRING-MATCH and STRING-MATCH? from RE-EXPORTS package.
+;;; - Requires regexp manipulation stuff from SRE-SYNTAX-TOOLS
+;;; - Requires ERROR from ERROR-PACKAGE.
+;;; - Requires ANY and FILTER frm SCSH-UTILITIES.
+;;;
+;;; Needs error-package receiving sre-syntax-tools scsh-utilities
+;;;
+;;; Exports:
+;;; (expand-awk exp r c)		Clinger-Rees macro expander, new syntax
+;;; (expand-awk/obsolete exp r c)	Clinger-Rees macro expander, old syntax
+;;;
+;;; next-range next-:range 		These four functions are used in the
+;;; next-range: next-:range:			code output by the expander.
 
 ;;; This should be hacked to convert regexp strings into regexp structures
 ;;; at the top of the form, and then just refer to the structs in the
@@ -19,13 +35,14 @@
 ;;;
 ;;; ;;; Count the number of non-comment lines of code in my Scheme source.
 ;;; (awk (read-line) (line) ((nlines 0))
-;;;   ("^[ \t]*;" nlines)		; A comment line.
-;;;   (else       (+ nlines 1)))	; Not a comment line.
+;;;   ((: bos (* white) ";")	nlines)		; A comment line.
+;;;   (else       		(+ nlines 1)))	; Not a comment line.
 ;;;
-;;;  ;;; Read numbers, counting the evens and odds.
+;;;  ;;; Read numbers, counting the evens and odds,
+;;;  ;;; and printing out sign information.
 ;;;  (awk (read) (val) ((evens 0) (odds 0))
-;;;     ((zero? val) (display "zero ") (values evens odds)) ; Tell me about
-;;;     ((> val 0)   (display "pos ")  (values evens odds)) ; sign, too.
+;;;     ((zero? val) (display "zero ") (values evens odds))
+;;;     ((> val 0)   (display "pos ")  (values evens odds))
 ;;;     (else        (display "neg ")  (values evens odds))
 ;;;
 ;;;     ((even? val) (values (+ evens 1) odds))
@@ -37,6 +54,17 @@
 ;;;       .
 ;;;       .
 ;;;   <clausen>)
+;;;
+;;; <clause> ::= (ELSE body ...)
+;;;          |   (:RANGE test1 test2 body ...) ; RANGE :RANGE RANGE: :RANGE:
+;;;          |   (AFTER body ...)
+;;;          |   (test => proc)
+;;;          |   (test ==> vars body ...)
+;;;          |   (test body ...)
+;;;
+;;;  test ::= integer | sre | (WHEN exp) | exp
+;;;  (sre/exp ambiguities resolved in favor of SRE)
+
 
 ;;; This macro is written using Clinger/Rees explicit-renaming low-level 
 ;;; macros. So it is pretty ugly. It takes a little care to generate 
@@ -145,17 +173,23 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (expand-awk exp r c)
+;;; If STRING-REGEXPS? is true, we use the old, obsolete syntax, where
+;;; a test form that is a string, such as "shivers|bdc", is treated as
+;;; a regular expression in the Posix string syntax. Otherwise, we use the
+;;; new SRE syntax, where strings are treated as SRE constants.
+
+(define (expand-awk exp r c)          (really-expand-awk exp r c #f))
+(define (expand-awk/obsolete exp r c) (really-expand-awk exp r c #t))
+
+(define (really-expand-awk exp r c string-regexps?)
   (let* ((%lambda  	(r 'lambda))	; Bind a mess of keywords.
 	 (%let	    	(r 'let))
-	 (%receive 	(r 'receive))
-	 (%values  	(r 'values))
 	 (%if		(r 'if))
 	 (%eof-object?	(r 'eof-object?))
 	 (%after	(r 'after))
 	 (%else		(r 'else))
 	 (%+		(r '+))
-	 (%make-regexp  (r 'make-regexp))
+	 (%rx		(r 'rx))
 
 	 (gensym (let ((i 0))
 		   (lambda (s)
@@ -173,7 +207,9 @@
 
 	 ;; Rip the form apart.
 	 (reader-exp (cadr exp))
-	 (rec/field-vars (caddr exp))
+	 ;; Replace #F's with gensym'd variables in the record/field vars.
+	 (rec/field-vars (map (lambda (v) (or v (r (gensym "anon-rfval"))))
+			      (caddr exp)))
 	 (rec-var (car rec/field-vars))	; The var bound to the record.
 	 (rest (cdddr exp)))		; Stuff after the rec&field-vars.
       
@@ -182,40 +218,48 @@
 		 (values #f (car rest) (cdr rest)) 	; form.
 		 (values (car rest) (cadr rest) (cddr rest)))
 
-      ;; Some analysis: what have we got?
-      ;; Range clauses, else clauses, line num tests,...
-      (let* ((recnum-tests?		; Do any of the clauses test the record
-	      (any? (lambda (clause)	; count? (I.e., any integer tests?)
-		      (let ((test (car clause)))
-			(or (integer? test)
-			    (and (range? clause)
-				 (or (integer? (cadr clause))
-				     (integer? (caddr clause)))))))
-		    clauses))
+      ;; If we are doing the old, obsolete Posix-string syntax, map
+      ;; the clause tests over to the new syntax.
+      (let* ((clauses (if string-regexps?
+			  (map (lambda (clause)
+				 (hack-clause-for-posix-string-syntax clause r c))
+			       clauses)
+			  clauses))
+
+	     ;; Some analysis: what have we got?
+	     ;; Range clauses, else clauses, line num tests,...
+	     (recnum-tests?		; Do any of the clauses test the record
+	      (any (lambda (clause)	; count? (I.e., any integer tests?)
+		     (let ((test (car clause)))
+		       (or (integer? test)
+			   (and (range? clause)
+				(or (integer? (cadr clause))
+				    (integer? (caddr clause)))))))
+		   clauses))
 
 	     ;; If any ELSE clauses, bind this to the var in which we
 	     ;; will keep the else state, otherwise #f.
-	     (else-var (and (any? (lambda (clause)
-				    (c (car clause) %else))
-				  clauses)
-			    (r 'else)))
+	     (else-var (and (any (lambda (clause)
+				   (c (car clause) %else))
+				 clauses)
+			    (r 'else-state)))
 
-	     ;; We compile all of the regexp patterns into regexp 
+	     ;; We compile all of the *static* regexp patterns into regexp 
 	     ;; data structures outside the AWK loop. So we need to
 	     ;; make a list of all the regexps that are used as tests.
 	     (patterns (apply append
 			      (map (lambda (clause)
 				     (let ((test (car clause)))
-				       (cond ((string? test) (list test))
+				       (cond ((sre-form? test r c) (list test))
 					     ((range? clause)
 					      (let ((t1 (cadr clause))
 						    (t2 (caddr clause)))
-						(append (if (string? t1)
+						(append (if (sre-form? t1 r c)
 							    (list t1)
 							    '())
-							(if (string? t2)
-							    (list t2)
-							    '()))))
+							 (if (sre-form? t2 r c)
+							     (list t2)
+							     '()))))
 					     (else '()))))
 				   clauses)))
 
@@ -227,16 +271,28 @@
 			       (if (member pat ans) ans (cons pat ans)))
 			     '())))
 
-	     ;; An alist matching regexp patterns with the vars to which
-	     ;; we will bind their compiled regexp data structure.
-	     (pats/vars (map (lambda (p) (cons p (r (gensym "re."))))
-			     patterns))
+	     (pats-static? (map (lambda (sre)
+				  (static-regexp? (parse-sre sre r c)))
+				patterns))
 
-	     ;; A LET-list binding the regexp vars to their compiled regexps.
-	     (regexp-inits (map (lambda (p/v)
-				  `(,(cdr p/v) (,%make-regexp ,(car p/v))))
-				pats/vars))
+	     ;; An alist matching each pattern with the exp that refers
+	     ;; to it -- a var if it's static, a Scheme (RX ...) exp otw.
+	     (pats/refs (map (lambda (pat static?)
+			       (cons pat
+				     (if static?
+					 (r (gensym "re."))
+					 `(,%rx ,pat))))
+			     patterns pats-static?))
 
+	     ;; A LET-list binding the regexp vars to their
+	     ;; compiled static regexps.
+	     (regexp-inits (apply append
+				  (map (lambda (p/r static?)
+					 (if static?
+					     `((,(cdr p/r) (,%rx ,(car p/r))))
+					     '()))
+				       pats/refs
+				       pats-static?)))
 
 	     ;; Make a list of state vars for the range clauses.
 	     ;; For each range clause, we need a boolean var to track
@@ -283,7 +339,7 @@
 
 	     (loop-body (awk-loop-body lp-var rec-var else-var
 				       rec-counter range-vars svars
-				       clauses pats/vars r c))
+				       clauses pats/refs r c))
 
 	     ;; Variables that have to be updated per-iteration, as a LET list.
 	     ;; Note that we are careful not to increment the record counter
@@ -306,12 +362,32 @@
 	        `(,%if (,%eof-object? ,rec-var) ,after-exp
 		       ,loop-body))))))))
 
+;;; This maps a clause in the old, obsolete syntax over to a clause
+;;; in the new, SRE syntax.
+(define (hack-clause-for-posix-string-syntax clause r c)
+  (let ((hack-simple-test (lambda (test)
+			    (cond ((string? test)
+				   `(,(r 'posix-string) ,test))
+				  ((integer? test) test)
+				  (else `(,(r 'when) ,test)))))
+	(test (car clause)))
+    (cond ((range-keyword? test r c)
+	   `(,test ,(hack-simple-test (cadr clause))
+		   ,(hack-simple-test (caddr clause))
+		   . ,(cdddr clause)))
+
+	  ((or (c test (r 'else))
+	       (c test (r 'after)))
+	   clause)
+
+	  (else `(,(hack-simple-test test) . ,(cdr clause))))))
+	  
 
 ;;; Expand into the body of the awk loop -- the code that tests & executes
 ;;; each clause, and then jumps to the top of the loop.
 
 (define (awk-loop-body lp-var rec-var else-var rec-counter 
-		       range-vars svars clauses pats/vars r c)
+		       range-vars svars clauses pats/refs r c)
   (let ((clause-vars (if else-var (cons else-var svars) svars))
 	(loop-vars (append (if rec-counter (list rec-counter) '())
 			   range-vars
@@ -329,7 +405,7 @@
 		   (let ((tail (expand (cdr clauses) (cdr range-vars))))
 		     (expand-range-clause clause tail (car range-vars)
 					  rec-var else-var rec-counter svars
-					  pats/vars
+					  pats/refs
 					  r c)))
 
 		  ((c test %after)	; An AFTER clause. Skip it.
@@ -343,7 +419,7 @@
 		   (let ((tail (expand (cdr clauses) range-vars)))
 		     (expand-simple-clause clause tail
 					   rec-var else-var rec-counter svars
-					   pats/vars r c)))))
+					   pats/refs r c)))))
 
 	  ;; No clauses -- just jump to top of loop.
 	  `(,lp-var . ,loop-vars)))))
@@ -351,49 +427,92 @@
 
 ;;; Make a Scheme expression out of a test form.
 ;;; Integer i		=>  (= i <record-counter>)
-;;; String  s		=>  (regexp-exec s <record>)
+;;; SRE s		=>  (regexp-search <re> <record>)
+;;; (when e)		=>  e
 ;;; Expression e	=>  e
+;;; 
+;;; If FOR-VALUE? is true, then we do regexp searches with REGEXP-SEARCH,
+;;; otherwise, we use the cheaper REGEXP-SEARCH?.
 
-(define (->simple-clause-test test-form rec-var rec-counter pats/vars r)
+(define (->simple-clause-test test-form for-value? rec-var rec-counter pats/refs r c)
   (cond ((integer? test-form) `(,(r '=) ,rec-counter ,test-form))
-	((string?  test-form)
-	 (let ((re-var (cond ((assoc test-form pats/vars) => cdr)
-			     (else (error "Impossible AWK error -- unknown regexp"
-					  test-form pats/vars)))))
-	   `(,(r 'regexp-exec) ,re-var ,rec-var)))
+
+	((sre-form? test-form r c)
+	 `(,(r (if for-value? 'regexp-search 'regexp-search?))
+	   ,(cdr (assoc test-form pats/refs))
+	   ,rec-var))
+
+	((and (pair? test-form)
+	      (c (r 'when) (car test-form)))
+	 (if (= 2 (length test-form)) (cadr test-form)
+	     (error "Illegal WHEN test in AWK" test-form)))
+
 	(else test-form)))
 
 
 (define (expand-simple-clause clause tail
 			      rec-var else-var rec-counter svars
-			      pats/vars r c)
+			      pats/refs r c)
   (let* ((%let          (r 'let))
-	 (%=            (r '=))
-	 (%string-match (r 'string-match))
 	 (%arrow        (r '=>))
+	 (%long-arrow   (r '==>))
 	 (%if           (r 'if))
+	 (%mss		(r 'match:substring))
 
          (test (car clause))
-	 (test (->simple-clause-test test rec-var rec-counter pats/vars r))
+	 (mktest (lambda (for-value?)
+		   (->simple-clause-test test for-value? rec-var
+					 rec-counter pats/refs r c)))
 
 	 ;; Is clause of the form (test => proc)
 	 (arrow? (and (= 3 (length clause))
 		      (c (cadr clause) %arrow)))
 
+	 ;; How about (test ==> (var ...) body ...)?
+	 (long-arrow? (and (< 3 (length clause))
+			   (c (cadr clause) %long-arrow)))
+
 	 (null-clause-list (null-clause-action else-var svars r))
 
 	 ;; The core form conditionally executes the body.
 	 ;; It returns the new else var and the new state vars, if any.
-	 (core (if arrow?
-		   (let* ((tv (r 'tval))		; APP is the actual 
-			  (app `(,(caddr clause) ,tv)))	; body: (proc tv).
-		     `(,%let ((,tv ,test))
-		        (,%if ,tv
-			      ,(clause-action (list app) else-var svars r c)
-			      . ,null-clause-list)))
+	 (core (cond (arrow?
+		      (let* ((tv (r 'tval))		   ; APP is the actual 
+			     (app `(,(caddr clause) ,tv))  ; body: (proc tv).
+			     (test (mktest #t)))
+			`(,%let ((,tv ,test))
+		           (,%if ,tv
+				 ,(clause-action (list app) else-var svars r c)
+				 . ,null-clause-list))))
 
-		   `(,%if ,test ,(clause-action (cdr clause) else-var svars r c)
-			  . ,null-clause-list)))
+		     (long-arrow?
+		      (let* ((tv (r 'tval))
+			     (test (mktest #t))
+			     (bindings ; List of LET bindings for submatches. 
+			      (let lp ((i 0)
+				       (vars (caddr clause))
+				       (bindings '()))
+				(if (pair? vars)
+				    (let ((var (car vars)))
+				      (lp (+ i 1) (cdr vars)
+					  (if var
+					      `((,var (,%mss ,tv ,i)) . ,bindings)
+					      bindings))) ; #F = "don't-care"
+				    bindings))))
+
+			`(,%let ((,tv ,test))
+		           (,%if ,tv 
+				 (,%let ,bindings ; Bind submatches.
+			           . ,(deblock (clause-action (cdddr clause)
+							      else-var svars
+							      r c)
+					       r c))
+				 . ,null-clause-list))))
+
+		     (else
+		      `(,%if ,(mktest #f) ,(clause-action (cdr clause)
+							  else-var svars r c)
+			     . ,null-clause-list))))
 
 	 (loop-vars (if else-var (cons else-var svars) svars)))
     
@@ -406,7 +525,7 @@
 
 (define (expand-range-clause clause tail range-var
 			     rec-var else-var rec-counter svars 
-			     pats/vars r c)
+			     pats/refs r c)
   (let* ((start-test (cadr clause))
 	 (stop-test (caddr clause))
 	 (body (cdddr clause))
@@ -423,10 +542,10 @@
 			  (else (error "Unrecognised range keyword!" clause)))))
 
 	 ;; Convert the start and stop test forms to code.
-	 (start-test (->simple-clause-test start-test rec-var
-					   rec-counter pats/vars r))
-	 (stop-test  (->simple-clause-test stop-test rec-var
-					   rec-counter pats/vars r))
+	 (start-test (->simple-clause-test start-test #f rec-var
+					   rec-counter pats/refs r c))
+	 (stop-test  (->simple-clause-test stop-test #f rec-var
+					   rec-counter pats/refs r c))
 
 	 (start-thunk `(,%lambda () ,start-test))	; ...and thunkate them.
 	 (stop-thunk  `(,%lambda () ,stop-test))
@@ -448,7 +567,6 @@
 	 (tail-exps (deblock tail r c))
 
 	 (%if      (r 'if))
-	 (%receive (r 'receive))
 	 (%let     (r 'let))
 	 
 	 ;; We are hard-wiring the else var to #t after this, so the core
diff --git a/scsh/char-set.scm b/scsh/char-set.scm
index 4746aaf..72aedbe 100644
--- a/scsh/char-set.scm
+++ b/scsh/char-set.scm
@@ -1,16 +1,52 @@
 ;;; -*-Scheme-*-
 ;;;
 ;;; Character Sets package
-;;; ported from MIT Scheme runtime
-;;; by Brian D. Carlstrom
-;;; Sleazy code.
+;;; - ported from MIT Scheme runtime
+;;;   by Brian D. Carlstrom
+;;; - Rehacked & extended by Olin Shivers 6/98.
+
+;;; This is not great code. Char sets are represented as 256-char
+;;; strings. If char i is ASCII 0, then it isn't in the set; if char i
+;;; is ASCII 1, then it is in the set.
+;;; - Should be rewritten to use bit strings, or at least byte vecs.
+;;; - Is ASCII/Latin-1 specific. Would certainly have to be rewritten
+;;;   for Unicode.
+;;; - The standard character sets are not Latin-1 compliant, just ASCII.
+
+;;; This code uses jar's DEFINE-RECORD-TYPE macro to define the char-set
+;;; record type, because the scsh-standard DEFINE-RECORD form automatically
+;;; defines a COPY-FOO function, which is not the one we want, being a shallow
+;;; copy of the record fields.
+
+;;; New dfns:
+;;; (char-set=  cs1 cs2 ...)
+;;; (char-set<= cs1 cs2 ...)
+;;; (char-set-fold kons knil cs)
+;;; (char-set-for-each f cs)
+;;; (char-set-copy cs)
+;;; (char-set-size cs)
+;;; char-set:printing		(char-printing?  c)
+;;; char-set:blank		(char-blank?     c)   
+;;; char-set:control		(char-control?   c) 
+;;; char-set:hex-digit		(char-hex-digit? c)
+;;; char-set:ascii		(char-ascii?     c)   
+;;; char-set:empty
+;;; char-set:full
+;;; char-set-every? pred cs
+;;; char-set-any    pred cs
+;;; char-set-adjoin  cset char -> cset
+;;; char-set-adjoin! cset char -> cset
+;;; char-set-delete  cset char -> cset
+;;; char-set-delete! cset char -> cset
 
 (define char:newline (ascii->char 13))
-(define char:tab (ascii->char 9))
-(define char:linefeed (ascii->char 13))
-(define char:page (ascii->char 12))
-(define char:return (ascii->char 10))
-(define char:space (ascii->char 32))
+(define char:tab     (ascii->char  9))
+(define char:vtab    (ascii->char 11))
+(define char:page    (ascii->char 12))
+(define char:return  (ascii->char 10))
+(define char:space   (ascii->char 32))
+
+(define (string-copy s) (substring s 0 (string-length s)))
 
 (define (string-fill-range! str lower upper ch)
   (do ((index lower (+ index 1)))
@@ -23,42 +59,133 @@
 
 ;;;; Character Sets
 
-(define (char-set? object)
-  (and (string? object)
-       (= (string-length object) 256)))
+;(define-record char-set
+;  s)	; 256-char string; each char is either ASCII 0 or ASCII 1.
+
+;;; Use jar's record macro.
+(define-record-type char-set :char-set
+  (make-char-set s)
+  char-set?
+  (s char-set:s))
+
+(define (char-set-copy cs) (make-char-set (string-copy (char-set:s cs))))
+
+;;; The = and <= code is ugly because it's n-ary.
+
+(define (char-set= cs1 . rest)
+  (let ((s1 (char-set:s cs1)))
+    (every (lambda (cs) (string=? s1 (char-set:s cs)))
+	   rest)))
+
+(define (char-set<= cs1 . rest)
+  (let lp ((s1 (char-set:s cs1))
+	   (rest rest))
+    (or (not (pair? rest))
+	(let ((s2 (char-set:s (car rest)))
+	      (rest (cdr rest)))
+	  (let lp2 ((i 255))
+	    (if (< i 0) (lp s2 rest)
+		(and (<= (char->ascii (string-ref s1 i))
+			 (char->ascii (string-ref s2 i)))
+		     (lp2 (- i 1)))))))))
+
+
+(define (char-set-size cs)
+  (let ((s (char-set:s cs)))
+    (let lp ((i 255) (size 0))
+      (if (< i 0) size
+	  (lp (- i 1)
+	      (if (= 0 (char->ascii (string-ref s i))) size (+ size 1)))))))
+
+(define (set-char-set cs in? . chars)
+  (let ((s (string-copy (char-set:s cs)))
+	(val (if in? (ascii->char 1) (ascii->char 0))))
+    (for-each (lambda (c) (string-set! s (char->ascii c) val))
+	      chars)
+    (make-char-set s)))
+
+(define (set-char-set! cs in? . chars)
+  (let ((s (char-set:s cs))
+	(val (if in? (ascii->char 1) (ascii->char 0))))
+    (for-each (lambda (c) (string-set! s (char->ascii c) val))
+	      chars))
+  cs)
+
+(define (char-set-adjoin  cs . chars) (apply set-char-set  cs #t chars))
+(define (char-set-adjoin! cs . chars) (apply set-char-set! cs #t chars))
+(define (char-set-delete  cs . chars) (apply set-char-set  cs #f chars))
+(define (char-set-delete! cs . chars) (apply set-char-set! cs #f chars))
+
+(define (char-set-for-each proc cs)
+  (let ((s (char-set:s cs)))
+    (let lp ((i 255))
+      (cond ((>= i 0)
+	     (if (not (= 0 (char->ascii (string-ref s i))))
+		 (proc (ascii->char i)))
+	     (lp (- i 1)))))))
+
+(define (char-set-fold kons knil cs)
+  (let ((s (char-set:s cs)))
+    (let lp ((i 255) (ans knil))
+      (if (< i 0) ans
+	  (lp (- i 1)
+	      (if (= 0 (char->ascii (string-ref s i)))
+		  ans
+		  (kons (ascii->char i) ans)))))))
+
+(define reduce-char-set (deprecated-proc char-set-fold 'char-set-fold
+					 "Use char-set-fold instead."))
+
+(define (char-set-every? pred cs)
+  (let ((s (char-set:s cs)))
+    (let lp ((i 255))
+      (or (< i 0)
+	  (if (= 0 (char->ascii (string-ref s i)))
+	      (lp (- i 1))
+	      (and (pred (ascii->char i))
+		   (lp (- i 1))))))))
+
+(define (char-set-any pred cs)
+  (let ((s (char-set:s cs)))
+    (let lp ((i 255))
+      (and (>= i 0)
+	   (if (= 0 (char->ascii (string-ref s i)))
+	       (lp (- i 1))
+	       (or (pred (ascii->char i))
+		   (lp (- i 1))))))))
+
 
 (define (char-set . chars)
   (chars->char-set chars))
 
 (define (chars->char-set chars)
-  (let ((char-set (make-string 256 (ascii->char 0))))
+  (let ((s (make-string 256 (ascii->char 0))))
     (for-each (lambda (char) 
-		(string-set! char-set (char->ascii char) (ascii->char 1)))
+		(string-set! s (char->ascii char) (ascii->char 1)))
 	      chars)
-    char-set))
+    (make-char-set s)))
 
 (define (string->char-set str)
-  (let ((char-set (make-string 256 (ascii->char 0))))
+  (let ((s (make-string 256 (ascii->char 0))))
     (do ((i (- (string-length str) 1) (- i 1)))
-	((< i 0) char-set)
-      (string-set! char-set (char->ascii (string-ref str i))
+	((< i 0) (make-char-set s))
+      (string-set! s (char->ascii (string-ref str i))
 		   (ascii->char 1)))))
 
 (define (ascii-range->char-set lower upper)
-  (let ((char-set (make-string 256 (ascii->char 0))))
-    (string-fill-range! char-set lower upper (ascii->char 1))
-    char-set))
+  (let ((s (make-string 256 (ascii->char 0))))
+    (string-fill-range! s lower upper (ascii->char 1))
+    (make-char-set s)))
 
 (define (predicate->char-set predicate)
-  (let ((char-set (make-string 256)))
-    (let loop ((code 0))
-      (if (< code 256)
-	  (begin (string-set! char-set code
-				 (if (predicate (ascii->char code)) 
-				     (ascii->char 1)
-				     (ascii->char 0)))
-		 (loop (+ 1 code)))))
-    char-set))
+  (let ((s (make-string 256)))
+    (let lp ((i 255))
+      (if (>= i 0)
+	  (begin (string-set! s i (if (predicate (ascii->char i)) 
+				      (ascii->char 1)
+				      (ascii->char 0)))
+		 (lp (- i 1)))))
+    (make-char-set s)))
 
 
 ;;; {string, char, char-set, char predicate} -> char-set
@@ -74,12 +201,13 @@
 
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 
-(define (char-set-members char-set)
-  (define (loop code)
-    (cond ((>= code 256) '())
-	  ((zero? (char->ascii (string-ref char-set code))) (loop (+ 1 code)))
-	  (else (cons (ascii->char code) (loop (+ 1 code))))))
-  (loop 0))
+(define (char-set-members cs)
+  (let ((s (char-set:s cs)))
+    (let lp ((i 255) (ans '()))
+      (if (< i 0) ans
+	  (lp (- i 1)
+	      (if (zero? (char->ascii (string-ref s i))) ans
+		  (cons (ascii->char i) ans)))))))
 
 ;;; De-releasing CHAR-SET-MEMBER?
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -90,108 +218,131 @@
 ;;; break code. I ended up just choosing a new proc name that consistent with
 ;;; its arg order -- (CHAR-SET-CONTAINS? cset char).
 
-(define (char-set-contains? char-set char)
-  (not (zero? (char->ascii (string-ref char-set (char->ascii char))))))
+(define (char-set-contains? cs char)
+  (not (zero? (char->ascii (string-ref (char-set:s cs)
+				       (char->ascii char))))))
 
 ;;; This actually isn't exported. Just CYA.
 (define (char-set-member? . args)
   (error "CHAR-SET-MEMBER? is no longer provided. Use CHAR-SET-CONTAINS? instead."))
 
-(define (char-set-invert char-set)
-  (predicate->char-set
-   (lambda (char) (not (char-set-contains? char-set char)))))
 
-(define (char-set-union char-set-1 char-set-2)
-  (predicate->char-set
-   (lambda (char)
-     (or (char-set-contains? char-set-1 char)
-	 (char-set-contains? char-set-2 char)))))
+;;; Set algebra
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (char-set-invert cs)
+  (predicate->char-set (lambda (char)
+			 (not (char-set-contains? cs char)))))
+
+(define (char-set-union . csets)
+  (if (pair? csets)
+      (apply char-set-union! (char-set-copy (car csets)) (cdr csets))
+      char-set:empty))
+
+(define (char-set-intersection . csets)
+  (if (pair? csets)
+      (apply char-set-intersection! (char-set-copy (car csets)) (cdr csets))
+      char-set:full))
+
+(define (char-set-difference cs1 . csets)
+  (if (pair? csets)
+      (apply char-set-difference! (char-set-copy cs1) csets)
+      cs1))
+
+
+;;; Linear set-algebraic ops
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; These guys are allowed, but not required, to side-effect their first
+;;; argument when computing their result. In other words, you must use them
+;;; as if they were completely functional, just like their non-! counterparts,
+;;; and you must additionally ensure that their first arguments are "dead"
+;;; at the point of call. In return, we promise a more efficient result, plus
+;;; allowing you to always assume char-sets are unchangeable values.
+
+;;; Apply P to each index and it's char in S: (P I C).
+;;; Used by the intersection & difference.
+(define (string-iter p s)
+  (let lp ((i (- (string-length s) 1)))
+    (cond ((>= i 0)
+	   (p i (string-ref s i))
+	   (lp (- i 1))))))
+
+(define (char-set-invert! cset)
+  (let ((s (char-set:s cset)))
+    (string-iter (lambda (i c)
+		     (string-set! s i (ascii->char (- 1 (char->ascii c)))))
+		 s))
+  cset)
+
+(define (char-set-union! cset1 . csets)
+  (let ((s (char-set:s cset1)))
+    (for-each (lambda (cset)
+		(char-set-for-each (lambda (c)
+				     (string-set! s (char->ascii c)
+						  (ascii->char 1)))
+				   cset))
+	      csets))
+  cset1)
+
+(define (char-set-intersection! cset1 . csets)
+  (let ((s (char-set:s cset1)))
+    (for-each (lambda (cset)
+		(string-iter (lambda (i c)
+			       (if (zero? (char->ascii c))
+				   (string-set! s i (ascii->char 0))))
+			     (char-set:s cset)))
+	      csets))
+  cset1)
+
+(define (char-set-difference! cset1 . csets)
+  (let ((s (char-set:s cset1)))
+    (for-each (lambda (cset)
+		(char-set-for-each (lambda (c)
+					  (string-set! s (char->ascii c)
+						       (ascii->char 0)))
+				   cset))
+	      csets))
+  cset1)
 
-(define (char-set-intersection char-set-1 char-set-2)
-  (predicate->char-set
-   (lambda (char)
-     (and (char-set-contains? char-set-1 char)
-	  (char-set-contains? char-set-2 char)))))
 
-(define (char-set-difference char-set-1 char-set-2)
-  (predicate->char-set
-   (lambda (char)
-     (and (char-set-contains? char-set-1 char)
-	  (not (char-set-contains? char-set-2 char))))))
 
 ;;;; System Character Sets
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define char-set:upper-case (ascii-range->char-set #x41 #x5B))
 (define char-set:lower-case (ascii-range->char-set #x61 #x7B))
-(define char-set:numeric (ascii-range->char-set #x30 #x3A))
-(define char-set:graphic (ascii-range->char-set #x20 #x7F))
-(define char-set:not-graphic (char-set-invert char-set:graphic))
-(define char-set:whitespace
-  (char-set char:newline char:tab char:linefeed 
-	    char:page char:return char:space))
-(define char-set:not-whitespace (char-set-invert char-set:whitespace))
+(define char-set:upper-case (ascii-range->char-set #x41 #x5B))
 (define char-set:alphabetic
   (char-set-union char-set:upper-case char-set:lower-case))
+(define char-set:numeric (ascii-range->char-set #x30 #x3A))
 (define char-set:alphanumeric
   (char-set-union char-set:alphabetic char-set:numeric))
-(define char-set:standard
-  (char-set-union char-set:graphic (char-set char:newline)))
+(define char-set:graphic  (ascii-range->char-set #x21 #x7F))
+(define char-set:printing (ascii-range->char-set #x20 #x7F))
+(define char-set:whitespace (char-set char:tab  char:newline char:vtab
+				      char:page char:return  char:space))
+(define char-set:blank (char-set char:space char:tab))
+(define char-set:control (char-set-union (ascii-range->char-set 0 32)
+					 (char-set (ascii->char 127))))
+(define char-set:punctuation
+  (string->char-set "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"))
+(define char-set:hex-digit (string->char-set "0123456789abcdefABCDEF"))
+(define char-set:ascii (ascii-range->char-set 0 128))
+(define char-set:empty (char-set))
+(define char-set:full (char-set-invert char-set:empty))
 
-(define (char-upper-case? char)
-  (char-set-contains? char-set:upper-case char))
 
-(define (char-lower-case? char)
-  (char-set-contains? char-set:lower-case char))
-
-(define (char-numeric? char)
-  (char-set-contains? char-set:numeric char))
-
-(define (char-graphic? char)
-  (char-set-contains? char-set:graphic char))
-
-(define (char-whitespace? char)
-  (char-set-contains? char-set:whitespace char))
-
-(define (char-alphabetic? char)
-  (char-set-contains? char-set:alphabetic char))
-
-(define (char-alphanumeric? char)
-  (char-set-contains? char-set:alphanumeric char))
-
-(define (char-standard? char)
-  (char-set-contains? char-set:standard char))
-
-;;; Bullshit legalese
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;$Header: /home/flat/Dropbox/Hacks/scsh/scsh-cvs/scsh/scsh/Attic/char-set.scm,v 1.1 1999/09/14 13:32:00 marting Exp $
-
-;Copyright (c) 1988 Massachusetts Institute of Technology
-
-;This material was developed by the Scheme project at the Massachusetts
-;Institute of Technology, Department of Electrical Engineering and
-;Computer Science.  Permission to copy this software, to redistribute
-;it, and to use it for any purpose is granted, subject to the following
-;restrictions and understandings.
-
-;1. Any copy made of this software must include this copyright notice
-;in full.
-
-;2. Users of this software agree to make their best efforts (a) to
-;return to the MIT Scheme project any improvements or extensions that
-;they make, so that these may be included in future releases; and (b)
-;to inform MIT of noteworthy uses of this software.
-
-;3. All materials developed as a consequence of the use of this
-;software shall duly acknowledge such use, in accordance with the usual
-;standards of acknowledging credit in academic research.
-
-;4. MIT has made no warrantee or representation that the operation of
-;this software will be error-free, and MIT is under no obligation to
-;provide any services, by way of maintenance, update, or otherwise.
-
-;5. In conjunction with products arising from the use of this material,
-;there shall be no use of the name of the Massachusetts Institute of
-;Technology nor of any adaptation thereof in any advertising,
-;promotional, or sales literature without prior written consent from
-;MIT in each case. 
+(define (char-set->pred cs) (lambda (c) (char-set-contains? cs c)))
 
+(define char-lower-case?	(char-set->pred char-set:lower-case))
+(define char-upper-case?	(char-set->pred char-set:upper-case))
+(define char-alphabetic?	(char-set->pred char-set:alphabetic))
+(define char-numeric?		(char-set->pred char-set:numeric))
+(define char-alphanumeric?	(char-set->pred char-set:alphanumeric))
+(define char-graphic?		(char-set->pred char-set:graphic))
+(define char-printing?		(char-set->pred char-set:printing))
+(define char-whitespace?	(char-set->pred char-set:whitespace))
+(define char-blank?		(char-set->pred char-set:blank))
+(define char-control?		(char-set->pred char-set:control))
+(define char-punctuation?	(char-set->pred char-set:punctuation))
+(define char-hex-digit?		(char-set->pred char-set:hex-digit))
+(define char-ascii?		(char-set->pred char-set:ascii))
diff --git a/scsh/defrec.scm b/scsh/defrec.scm
index 4f920b1..c90752a 100644
--- a/scsh/defrec.scm
+++ b/scsh/defrec.scm
@@ -37,7 +37,7 @@
 ;;;   (employee:sex emp)
 ;;;   (employee:married? emp)
 ;;; 
-;;; - Setter procedures:
+;;; - Field-setting procedures:
 ;;;   (set-employee:name emp "Janet Q. Random")
 ;;;   (set-employee:id emp 8271)
 ;;;   (set-employee:salary emp 20000)
@@ -45,6 +45,13 @@
 ;;;   (set-employee:sex emp 'female)
 ;;;   (set-employee:married? emp #t)
 ;;; 
+;;; - Field-modifier procedures:
+;;;   (modify-employee:salary emp (lambda (s) (* 1.03 s))) ; 3% raise
+;;;   ...similarly for other fields.
+;;;
+;;; - Record-copy procedure:
+;;;   (copy-employee emp) -> emp'
+;;;
 ;;; - A type predicate:
 ;;;   (employee? x)
 ;;; 
@@ -63,6 +70,9 @@
 ;;; will cause (make-ship 10 20 "Valdez") to print as
 ;;;   #{ship "Valdez"}
 
+;;; Dependencies:
+;;; - Code produced by the macro needs the RECORDS package.
+;;; - Macro-expander code needs ERROR-PACKAGE and RECEIVING
 
 (define-syntax define-record
   (lambda (form rename compare)
@@ -100,6 +110,9 @@
 			   (s-conc (s->s name) ":" (s->s field-name))))
 	     (set-name (lambda (field-name)
 			 (s-conc "set-" (s->s name) ":" (s->s field-name))))
+	     (mod-name (lambda (field-name)
+			 (s-conc "modify-" (s->s name) ":" (s->s field-name))))
+	     (copy-name (s-conc "copy-" (s->s name)))
 	     (pred-name (s-conc (s->s name) "?"))
 	     (maker-name (s-conc "make-" (s->s name)))
 	     (type-name (s-conc "type/" (s->s name)))
@@ -149,16 +162,44 @@
 	  (,%define ,pred-name (,%record-predicate ,type-name))
        
 	  ;; Accessors (EMPLOYEE:NAME emp), ...
-	  ,@(map (lambda (spec)
-		   `(,%define ,(field-name (spec-name spec))
-		      (,%record-accessor ,type-name ',(spec-name spec))))
-		 field-specs)
+	  ,@(map (lambda (field)
+		   `(,%define ,(field-name field)
+		      (,%record-accessor ,type-name ',field)))
+		 fields)
 
-	  ;; Setters (SET-EMPLOYEE:NAME emp name), ...
-	  ,@(map (lambda (spec)
-		   `(,%define ,(set-name (spec-name spec))
-		      (,%record-modifier ,type-name ',(spec-name spec))))
-		 field-specs)
+	  ;; Field setters (SET-EMPLOYEE:NAME emp name), ...
+	  ,@(map (lambda (field)
+		   `(,%define ,(set-name field)
+		      (,%record-modifier ,type-name ',field)))
+		 fields)
+
+	  ;; Field modifiers (MODIFY-EMPLOYEE:NAME emp proc), ...
+	  ,@(let ((%setter (rename 'setter)); set-ship:name
+		  (%rec    (rename 'r))	    ; parameter: record to be modified. 
+		  (%proc   (rename 'proc))) ; parameter: modifying procedure.
+	      (map (lambda (field)
+		     (let ((%setter-proc `(,%record-modifier ,type-name
+							     ',field))
+			   (%sel-proc `(,%record-accessor ,type-name ',field))
+			   (%selector (rename 'getter)))
+		      `(,%define ,(mod-name field)
+		         (,%let ((,%setter ,%setter-proc)
+				 (,%selector ,%sel-proc))
+		           (,%lambda (,%rec ,%proc)
+			     (,%setter ,%rec (,%proc (,%selector ,%rec))))))))
+		   fields))
+
+	  ;; Record copy procedure
+	  ,(let ((%rec (rename 'r))
+		 (accessors (map (lambda (f) (rename (gensym "f"))) fields)))
+	     `(,%define ,copy-name
+	        (,%let ((,maker (,%record-constructor ,type-name ',fields))
+		        . ,(map (lambda (field accessor)
+			 	 `(,accessor (,%record-accessor ,type-name
+								',field)))
+				fields accessors))
+	          (,%lambda (,%rec)
+		    (,maker . ,(map (lambda (a) `(,a ,%rec)) accessors))))))
 
 	  ;; Methods (we only handle DISCLOSE methods).
 	  ,@(map (lambda (m)
diff --git a/scsh/endian.scm b/scsh/endian.scm
index ec15454..8532354 100644
--- a/scsh/endian.scm
+++ b/scsh/endian.scm
@@ -33,7 +33,7 @@
 	 (+ (arithmetic-shift byte1 8)
 	    byte0))))
 
-(define net-to-host-32 net-to-host-32-big)
-(define net-to-host-16 net-to-host-16-big)
-(define host-to-net-32 net-to-host-32-big)
-(define host-to-net-16 net-to-host-16-big)
+(define net-to-host-32 net-to-host-32-little)
+(define net-to-host-16 net-to-host-16-little)
+(define host-to-net-32 net-to-host-32-little)
+(define host-to-net-16 net-to-host-16-little)
diff --git a/scsh/fileinfo.scm b/scsh/fileinfo.scm
index 3413fb7..9ec09ef 100644
--- a/scsh/fileinfo.scm
+++ b/scsh/fileinfo.scm
@@ -3,11 +3,31 @@
 ;;; chase? true (the default) means if the file is a symlink, chase the link
 ;;; and report on the file it references. chase? = #f means check the actual
 ;;; file itself, even if it's a symlink.
-;;; writeable means (1) file exists & is writeable OR (2) file doesn't exist
-;;;     but directory is writeable.
 
+;;; (file-not-accessible? perms fd/port/fname)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; PERMS is 3 bits, not 9.
+;;; writeable means (1) file exists & is writeable OR (2) file doesn't exist
+;;;     and directory is writeable. That is, writeable means writeable or
+;;;     creatable.
+;;;
+;;; There's a Posix call, access(), that checks using the *real* uid, not
+;;; the effective uid, so that setuid programs can figure out if the luser
+;;; has perms. file-not-accessible? is defined in terms of the effective uid, 
+;;; so we can't use access().
+;;; 
+;;; This is a kind of bogus function. The only way to do a real check is to
+;;; try an open() and see if it flies. Otherwise, there's an obvious atomicity
+;;; problem. Also, we special case root, saying root always has all perms. But
+;;; not even root can write on a read-only filesystem, such as a CD ROM. In
+;;; this case, we'd blithely say the file was writeable -- there's no way to
+;;; check for a ROFS without doing an open(). We need a euid analog to
+;;; access(). Ah, well.
+;;; 
+;;; I also should define a family of real uid perm-checking calls.
+;;;
 ;;; Return values:
-;;; #f			Accessible
+;;; #f			Accessible in at least one of the requested ways.
 ;;; search-denied	Can't stat
 ;;; permission		File exists but is protected
 ;;; 			(also for errno/rofs)
@@ -16,27 +36,43 @@
 ;;;
 ;;; Otherwise, signals an error.
 
-(define (file-not-accessible? perms fd/port/fname . maybe-chase?)
+(define (file-not-accessible? perms fd/port/fname)
   (let ((uid (user-effective-uid)))
-    (and (not (zero? uid)) ; Root can do what he likes.
-	 (with-errno-handler ((err data)
-			      ((errno/acces) 'search-denied)
-			      ((errno/noent) 'nonexistent)
-			      ((errno/notdir) 'not-directory))
+    (with-errno-handler ((err data)
+			 ((errno/acces) 'search-denied)
+			 ((errno/notdir) 'not-directory)
 
-	   (and (let* ((info (apply file-info fd/port/fname maybe-chase?))
-		       (acc (file-info:mode info)))
-		  (cond ((= (file-info:uid info) (user-effective-uid)) ; User
-			 (zero? (bitwise-and acc (arithmetic-shift perms 6))))
+			 ;; If the file doesn't exist, we usually return
+			 ;; 'nonexistent, but we special-case writability
+			 ;; for the directory check.
+			 ((errno/noent)
+			  (and (or (zero? (bitwise-and perms 2))
+				   ;; This string? test *has* to return #t.
+				   ;; If fd/port/fname is an fd or a port,
+				   ;; we wouldn't get an errno/noent error!
+				   ;; Just being paranoid...
+				   (not (string? fd/port/fname))
+				   ;; OK, check to see if we can create
+				   ;; files in the directory.
+				   (file-not-accessible? 2
+				     (directory-as-file-name
+				       (file-name-directory fd/port/fname))))
+			       'nonexistent)))
+
+      (and (let* ((info (file-info fd/port/fname))
+		  (acc (file-info:mode info)))
+	     (cond ((zero? uid) #f)	; Root can do as he wishes.
+
+		   ((= (file-info:uid info) (user-effective-uid)) ; User
+		    (zero? (bitwise-and acc (arithmetic-shift perms 6))))
 		      
-			((= (file-info:gid info) (user-effective-gid)) ; Group
-			 (zero? (bitwise-and acc (arithmetic-shift perms 3))))
-			((memv (file-info:gid info) (user-supplementary-gids))
-			 (zero? (bitwise-and acc (arithmetic-shift perms 3))))
+		   ((or (= (file-info:gid info) (user-effective-gid)) ; Group
+			(memv (file-info:gid info) (user-supplementary-gids)))
+		    (zero? (bitwise-and acc (arithmetic-shift perms 3))))
 		      
-			(else				    ; Other
-			 (zero? (bitwise-and acc perms)))))
-		'permission)))))
+		   (else		; Other
+		    (zero? (bitwise-and acc perms)))))
+	   'permission))))
 
 ;;;;;;
 
diff --git a/scsh/filemtch.scm b/scsh/filemtch.scm
index 5cb8a72..f89c94f 100644
--- a/scsh/filemtch.scm
+++ b/scsh/filemtch.scm
@@ -11,17 +11,28 @@
 ;;;                 root      Search starts from here. Usefully "." (cwd)
 ;;;                 dots? => if true, dot files will be matched.
 ;;;                          if false, dot files will not be matched.
-;;;                 pattern-list := a list of regular expressions or predicates
-;;;                                 Each member of the list corresponds
-;;;                                 to one or more levels in a directory.
-;;;                                 (A member with embedded "/" characters
-;;;                                  corresponds to multiple levels.)
-;;;                                 Example: ("foo" "bar" "\\.c$")
+;;;                 pattern-list := a list of 
+;;;                                   - strings
+;;;                                     These are split at /'s and then
+;;;                                     treated as Posix regexp strings.
+;;;                                   - regexps (typically made with RX macro)
+;;;                                   - predicates
+;;;                                 Each member of the list corresponds to one
+;;;                                 or more levels in a directory.  (A string
+;;;                                 with embedded "/" characters corresponds
+;;;                                 to multiple levels.)
+;;;                                 Example: 
+;;;                                 (file-match "." #f "foo" "bar" "\\.c$")
 ;;;                                     means match files that end in ".c"
 ;;;                                     if they reside in a directory with
 ;;;                                     a name that contains "bar", which
 ;;;                                     itself must reside in a directory
 ;;;                                     with a name that contains "foo".
+;;;                                  Here are two more equivalent specs
+;;;                                  for the example above:
+;;;                                  (file-match "." #f "foo/bar/\\.c$")
+;;;                                  (file-match "." #f (rx "foo") (rx "bar")
+;;;                                                     (rx ".c" eos))
 ;;;                                  If a member in the list is a predicate,
 ;;;                                  the predicate must be a procedure of
 ;;;                                  one argument.  This procedure is applied
@@ -40,16 +51,19 @@
 ;;;   when FILE-DIRECTORY? is applied to the bogus symlink.
 
 (define (file-match root dot-files? . patterns)
-  (let ((patterns (apply append (map split-pat patterns))))
+  (let ((patterns (apply append
+			 (map (lambda (p) (if (string? p)
+					      (map posix-string->regexp (split-pat p))
+					      p))
+			      patterns))))
     (let recur ((root root)
 		(patterns patterns))
       (if (pair? patterns)
 	  (let* ((pattern  (car patterns))
 		 (patterns (cdr patterns))
 		 (dir (file-name-as-directory root))
-		 (matcher (cond ((string? pattern)
-				 (let ((re (make-regexp pattern)))
-				   (lambda (f) (regexp-exec re f))))
+		 (matcher (cond ((regexp? pattern)
+				 (lambda (f) (regexp-search? re f)))
 
 				;; This arm makes a file-matcher using
 				;; predicate PATTERN. If PATTERN signals
@@ -87,7 +101,7 @@
   (if (procedure? pat) (list pat)
       (let lp ((i (string-length pat))
 	       (ans '()))
-	(cond ((rindex pat #\/ i) =>
-	       (lambda (j) (lp (cons (substring pat (+ j 1) i) ans) j)))
+	(cond ((string-index-right pat #\/ i) =>
+	       (lambda (j) (lp j (cons (substring pat (+ j 1) i) ans))))
 	      (else
 	       (cons (substring pat 0 i) ans))))))
diff --git a/scsh/fname.scm b/scsh/fname.scm
index 6072377..77d4f3b 100644
--- a/scsh/fname.scm
+++ b/scsh/fname.scm
@@ -68,7 +68,7 @@
 
 ;;; Returns FNAME's directory component in *directory form.*
 (define (file-name-directory fname)
-  (cond ((rindex fname #\/) =>
+  (cond ((string-index-right fname #\/) =>
 	 (lambda (rslash)
 	   (if (last-non-slash fname)
 	       (substring fname 0 (+ 1 rslash))
@@ -77,7 +77,7 @@
 
 
 (define (file-name-nondirectory fname)
-  (cond ((rindex fname #\/) =>
+  (cond ((string-index-right fname #\/) =>
 	 (lambda (rslash)
 	   (if (last-non-slash fname)
 	       (substring fname (+ 1 rslash) (string-length fname))
@@ -90,7 +90,7 @@
 	 (len (string-length fname)))
     (let split ((start 0))
       (cond ((>= start len) '())
-	    ((index fname #\/ start) =>
+	    ((string-index fname #\/ start) =>
 	     (lambda (slash)
 	       (cons (substring fname start slash)
 		     (split (+ slash 1)))))
@@ -128,7 +128,7 @@
 ;;; /usr/shivers/.login are not considered extensions.
 
 (define (file-name-extension-index fname)
-  (let ((dot (rindex fname #\.)))
+  (let ((dot (string-index-right fname #\.)))
     (if (and dot
 	     (> dot 0)
 	     (not (char=? #\/ (string-ref fname (- dot 1)))))
@@ -154,7 +154,7 @@
 				    (let* ((user (substring fname 1 end))
 					   (ui (name->user-info user)))
 				      (user-info:home-dir ui))))))
-	  (cond ((index fname #\/ 1) =>
+	  (cond ((string-index fname #\/ 1) =>
 		 (lambda (slash)
 		   (string-append (tilde->homedir slash) "/"
 				  (substring fname (+ slash 1) len))))
@@ -163,9 +163,8 @@
 
 (define (resolve-file-name fname . maybe-root)
   (let* ((root (ensure-file-name-is-nondirectory (:optional maybe-root ".")))
-	 (fname (ensure-file-name-is-nondirectory fname))
-	 (len (string-length fname)))
-    (if (zero? len) "/"
+	 (fname (ensure-file-name-is-nondirectory fname)))
+    (if (zero? (string-length fname)) "/"
 	(let ((c (string-ref fname 0)))
 	  (cond ((char=? #\/ c) fname) 	; Absolute file name.
 
@@ -222,6 +221,15 @@
   (simplify-file-name (apply resolve-file-name fname maybe-dir)))
 
 
+(define (absolute-file-name fname . maybe-root)
+  (let ((fname (ensure-file-name-is-nondirectory fname)))
+    (if (zero? (string-length fname)) "/"
+	(simplify-file-name
+	  (if (char=? #\/ (string-ref fname 0)) fname 	; Absolute file name.
+	      (let ((root (:optional maybe-root (cwd))))
+		(string-append (file-name-as-directory root) fname)))))))
+
+
 (define (home-dir . maybe-user)
   (if (pair? maybe-user)
       (let ((user (car maybe-user)))
@@ -248,7 +256,7 @@
     (let ((len (string-length s)))
       (cond
         ((zero? len) (apply string-append (reverse! ans)))
-	((index s #\$) =>
+	((string-index s #\$) =>
 	 (lambda (i)
 	   (let ((ans (cons (substring s 0 i) ans))
 		 (s (substring s (+ i 1) len))
@@ -256,13 +264,13 @@
 	     (if (zero? len) (lp ans "")
 		 (let ((next-char (string-ref s 0)))
 		   (cond ((char=? #\{ next-char)
-			  (cond ((index s #\}) =>
+			  (cond ((string-index s #\}) =>
 				 (lambda (i)
 				   (lp (cons (getenv (substring s 1 i)) ans)
 				       (substring s (+ i 1) len))))
 				(else (error "Unbalanced ${ delimiter in string" s))))
 			 (else
-			  (let ((i (or (index s #\/) len)))
+			  (let ((i (or (string-index s #\/) len)))
 			    (lp (cons (getenv (substring s 0 i)) ans)
 				(substring s i len))))))))))
 	(else (lp (cons s ans) ""))))))
diff --git a/scsh/fr.scm b/scsh/fr.scm
index 077005a..d98ceaf 100644
--- a/scsh/fr.scm
+++ b/scsh/fr.scm
@@ -1,5 +1,5 @@
 ;;; Field and record parsing utilities for scsh.
-;;; Copyright (c) 1994 by Olin Shivers.
+;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
 
 ;;; Notes:
 ;;; - Comment on the dependencies here...
@@ -54,43 +54,12 @@
 ;;; This has the effect you want with field parsing. For example, if you split
 ;;; a string with the empty pattern, you will explode the string into its
 ;;; individual characters:
-;;;     ((suffix-splitter "") "foo") -> #("" "f" "o" "o")
+;;;     ((suffix-splitter (rx "")) "foo") -> #("" "f" "o" "o")
 ;;; However, even though this boundary case is handled correctly, we don't
 ;;; recommend using it. Say what you mean -- just use a field splitter:
-;;;     ((field-splitter ".") "foo") -> #("f" "o" "o")
+;;;     ((field-splitter (rx any)) "foo") -> #("f" "o" "o")
 
 
-
-;;; (join-strings string-list [delimiter grammar]) => string
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Paste strings together using the delimiter string.
-;;;
-;;; (join-strings '("foo" "bar" "baz") ":") => "foo:bar:baz"
-;;;
-;;; DELIMITER defaults to a single space " "
-;;; GRAMMAR is one of the symbols {infix, suffix} and defaults to 'infix.
-
-;;; (join-strings strings [delim grammar])
-
-(define (join-strings strings . args)
-  (if (pair? strings)
-      (let-optionals args ((delim " ") (grammar 'infix))
-	(check-arg string? delim join-strings)
-	(let ((strings (reverse strings)))
-	  (let lp ((strings (cdr strings))
-		   (ans (case grammar
-			  ((infix)  (list (car strings)))
-			  ((suffix) (list (car strings) delim))
-			  (else (error "Illegal grammar" grammar)))))
-	    (if (pair? strings)
-		(lp (cdr strings)
-		    (cons (car strings) (cons delim ans)))
-	  
-		; All done
-		(apply string-append ans)))))
-
-      ""))	; Special-cased for infix grammar.
-
 ;;; FIELD PARSERS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; This section defines routines to split a string into fields.
@@ -100,13 +69,13 @@
 
 (define (->delim-matcher x)
   (if (procedure? x) x					; matcher proc
-      (let ((re (cond ((regexp? x) x)			; regexp pattern
-		      ((string? x) (make-regexp x))	; regexp string
-		      (else (error "Illegal pattern/parser" x)))))
-
-	;; The matcher proc.
+      (let ((re (cond ((string? x) (re-string x))
+		      ((char-set? x) (re-char-set x))
+		      ((char? x) (re-string (string x)))
+		      ((regexp? x) x)
+		      (else (error "Illegal field-reader delimiter value" x)))))
 	(lambda (s i)
-	  (cond ((regexp-exec re s i) =>
+	  (cond ((regexp-search re s i) =>
 		 (lambda (m) (values (match:start m 0) (match:end m 0))))
 		(else (values #f #f)))))))
 
@@ -154,7 +123,8 @@
 				match-delim cons-field
 				num-fields nfields-exact?))))))))
 
-(define default-field-matcher (->delim-matcher "[^ \t\n]+"))
+;;; Default field spec is runs of non-whitespace chars.
+(define default-field-matcher (->delim-matcher (rx (+ (~ white)))))
 
 ;;; (field-splitter [field-spec num-fields])
 
@@ -313,8 +283,8 @@
 
 ;;; Now, build the exported procedures: {infix,suffix,sloppy-suffix}-splitter.
 
-(define default-suffix-matcher (->delim-matcher "[ \t\n]+|$"))
-(define default-infix-matcher  (->delim-matcher "[ \t\n]+"))
+(define default-suffix-matcher (->delim-matcher (rx (| (+ white) eos))))
+(define default-infix-matcher  (->delim-matcher (rx (+ white))))
 
 (define infix-splitter
   (make-field-parser-generator default-infix-matcher  infix-field-loop))
@@ -408,21 +378,17 @@
 ;;; Repeatedly do (APPLY PROC M STATE) to generate new state values,
 ;;; where M is a regexp match structure made from matching against STRING.
 
-;(define (regexp-reduce string start regexp proc . state)
-;  (let ((end (string-length string))
-;	(regexp (if (string? regexp)
-;		    (make-regexp regexp)
-;		    regexp)))
-;
+;(define (regexp-fold string start regexp proc . state)
+;  (let ((end (string-length string)))
 ;    (let lp ((i start) (state state) (last-null? #f))
 ;      (let ((j (if last-null? (+ i 1) i)))
-;	(cond ((and (<= j end) (regexp-exec regexp string j)) =>
+;	(cond ((and (<= j end) (regexp-search regexp string j)) =>
 ;               (lambda (m)
 ;		 (receive state (apply proc m state)
 ;		   (lp (match:end m) state (= (match:start m) (match:end m))))))
 ;	      (else (apply values state)))))))
 ;
 ;(define (all-regexp-matches regexp string)
-;  (reverse (regexp-reduce string 0 regexp
-;			  (lambda (m ans) (cons (match:substring m 0) ans))
-;			  '())))
+;  (reverse (regexp-fold string 0 regexp
+;			 (lambda (m ans) (cons (match:substring m 0) ans))
+;			 '())))
diff --git a/scsh/glob.scm b/scsh/glob.scm
index 469ad80..271b59c 100644
--- a/scsh/glob.scm
+++ b/scsh/glob.scm
@@ -76,8 +76,8 @@
 	
 	(else (let* ((dots? (char=? #\. (string-ref pat 0))) ; Match dot files?
 		     (candidates (maybe-directory-files fname dots?))
-		     (re (make-regexp (glob->regexp pat))))
-		(values (filter (lambda (f) (regexp-exec re f)) candidates)
+		     (re (glob->regexp pat)))
+		(values (filter (lambda (f) (regexp-search? re f)) candidates)
 			#t))))) ; These guys exist for sure.
 
 ;;; The initial special-case above isn't really for the fast-path; it's
@@ -87,64 +87,113 @@
 
 ;;; Translate a brace-free glob pattern to a regular expression.
 
-(define (glob->regexp pat)
+(define glob->regexp
+  (let ((dot-star (re-repeat 0 #f re-any))) ; ".*" or (* any)
+    (lambda (pat)
+      (let ((pat-len (string-length pat))
+
+	    (str-cons (lambda (chars res)	; Reverse CHARS and cons the
+			(if (pair? chars)	; result string-re onto RES.
+			    (cons (re-string (list->string (reverse chars)))
+				  res)
+			    res))))
+
+	;; We accumulate chars into CHARS, and coalesce into a single string
+	;; with STR-CONS when we run across a non-char.
+	(let lp ((chars '())
+		 (res (list re-bos))
+		 (i 0))
+	  (if (= i pat-len)
+	      (re-seq (reverse (str-cons chars res)))
+
+	      (let ((c (string-ref pat i))
+		    (i (+ i 1)))
+		(case c
+		  ((#\\) (if (< i pat-len)
+			     (lp (cons (string-ref pat i) chars)
+				 res (+ i 1))
+			     (error "Ill-formed glob pattern -- ends in backslash" pat)))
+
+		  ((#\*) (lp '()
+			     (cons dot-star (str-cons chars res))
+			     i))
+		  ((#\?) (lp '()
+			     (cons re-any (str-cons chars res))
+			     i))
+				
+		  ((#\[) (receive (cset i) (parse-glob-bracket pat i)
+			   (lp '()
+			       (cons (re-char-set cset)
+				     (str-cons chars res))
+			       i)))
+
+		  (else  (lp (cons c chars) res i))))))))))
+
+
+;;; A glob bracket expression is [...] or [^...].
+;;; The body is a sequence of <char> and <char>-<char> ranges.
+;;; A <char> is any character except right-bracket, carat, hypen or backslash,
+;;; or a backslash followed by any character at all.
+
+(define (parse-glob-bracket pat i)
   (let ((pat-len (string-length pat)))
-    (let lp ((result '(#\^))
-	     (i 0)
-	     (state 'normal))
-      (if (= i pat-len)
+    (receive (negate? i) (if (and (< i pat-len) (char=? #\^ (string-ref pat i)))
+			     (values #t (+ i 1))
+			     (values #f i))
 
-	  (if (eq? state 'normal)
-	      (list->string (reverse (cons #\$ result)))
-	      (error "Illegal glob pattern" pat))
+      (let lp ((elts '()) (i i))
+	(if (>= i pat-len)
+	    (error "Ill-formed glob pattern -- no terminating close-bracket" pat)
 
+	    (let ((c (string-ref pat i))
+		  (i (+ i 1)))
+	      (case c
+		((#\])
+		 (let ((cset (fold (lambda (elt cset)
+				     (char-set-union
+				      cset
+				      (if (char? elt)
+					  (char-set elt)
+					  (ascii-range->char-set (char->ascii (car elt))
+								 (+ 1 (char->ascii (cdr elt)))))))
+				   char-set:empty
+				   elts)))
+		   (values (re-char-set (if negate?
+					    (char-set-invert cset)
+					    cset))
+			   i)))
 
-	  (let ((c (string-ref pat i))
-		(i (+ i 1)))
-	    (case state
-	      ((char-set)
-	       (lp (cons c result)
-		   i
-		   (if (char=? c #\]) 'normal 'char-set)))
+		((#\\)
+		 (if (>= i pat-len)
+		     (error "Ill-formed glob pattern -- ends in backslash" pat)
+		     (lp (cons (string-ref pat i) elts) (+ i 1))))
 
-	      ((escape)
-	       (lp (case c
-		     ((#\$ #\^ #\. #\+ #\? #\* #\| #\( #\) #\[)
-		      (cons c (cons #\\ result)))
-		     (else (cons c result)))
-		   i
-		   'normal))
+		((#\-)
+		 (cond ((>= i pat-len)
+			(error "Ill-formed glob pattern -- unterminated range." pat))
+		       ((or (null? elts) (not (char? (car elts))))
+			(error "Ill-formed glob pattern -- range has no beginning." pat))
+		       (else (lp (cons (cons (car elts) (string-ref pat i)) elts)
+				 (+ i 1)))))
 
-	      ;; Normal
-	      (else (case c
-		      ((#\\) (lp result i 'escape))
-		      ((#\*) (lp (cons #\* (cons #\. result)) i 'normal))
-		      ((#\?) (lp (cons #\. result) i 'normal))
-		      ((#\[) (lp (cons c result) i 'char-set))
-		      ((#\$ #\^ #\. #\+ #\|  #\( #\))
-		             (lp (cons c (cons #\\ result)) i 'normal))
-		      (else  (lp (cons c result) i 'normal))))))))))
+		(else (lp (cons c elts) i)))))))))
 
 
 ;;; Is the glob pattern free of *'s, ?'s and [...]'s?
 (define (constant-glob? pattern)
   (let ((patlen (string-length pattern)))
-    (let lp ((i 0)
-	     (escape? #f))	; Was last char an escape char (backslash)?
-      (if (= i patlen)
-
-	  (if escape?
-	      (error "Ill-formed glob pattern" pattern)
-	      #t)
-
+    (let lp ((i 0))
+      (or (= i patlen)
 	  (let ((next-i (+ i 1)))
-	    (if escape? (lp next-i #f)
-		(case (string-ref pattern i)
-		  ((#\* #\? #\[) #f)
-		  ((#\\) (lp next-i #t))
-		  (else  (lp next-i #f)))
-;		(lp next-i #f)))))))
-))))))
+	    (case (string-ref pattern i)
+	      ((#\\) ; Escape char
+	       (if (= next-i patlen)
+		   (error "Ill-formed glob pattern -- ends in backslash"
+			  pattern)
+		   (lp (+ next-i 1))))
+	      ((#\* #\? #\[) #f)
+	      (else  (lp next-i))))))))
+
 
 ;;; Make an effort to get the files in the putative directory PATH.
 ;;; If PATH isn't a directory, or some filesys error happens (such
diff --git a/scsh/network.scm b/scsh/network.scm
index ae42aa6..1452eb0 100644
--- a/scsh/network.scm
+++ b/scsh/network.scm
@@ -47,8 +47,18 @@
 		     (else 
 		      (error "socket-connect: unsupported protocol-family ~s"
 			     protocol-family)))))
-    (connect-socket sock addr)
-    sock))
+    ;; Close the socket and free the file-descriptors
+    ;; if the connect fails:
+    (let ((connected #f))
+      (dynamic-wind
+       (lambda () #f)
+       (lambda () (connect-socket sock addr) (set! connected #t))
+       (lambda ()
+         (if (not connected)
+             (close-socket sock))))
+      (if connected
+          sock
+          #f))))
 
 (define (bind-listen-accept-loop protocol-family proc arg)
   (let* ((sock (create-socket protocol-family socket-type/stream))
@@ -238,6 +248,7 @@
 (define-foreign %listen/errno
   (listen (integer sockfd)	; socket fdes
 	  (integer backlog))	; backlog
+	no-declare ; for Linux
   (to-scheme integer errno_or_false))
 
 (define-errno-syscall (%listen sockfd backlog) %listen/errno)
diff --git a/scsh/rdelim.scm b/scsh/rdelim.scm
index 8d8cc96..05a0a91 100644
--- a/scsh/rdelim.scm
+++ b/scsh/rdelim.scm
@@ -165,7 +165,8 @@
 	(error "Illegal START/END substring indices"
 	       buf start end %read-delimited!))
 
-    (let ((delims (->char-set delims)))
+    (let* ((delims (->char-set delims))
+	   (sdelims (char-set:s delims)))
 
       (if (and (fdport? port) (not gobble?))
 
@@ -173,7 +174,7 @@
 	  (let lp ((start start) (total 0))
 	    (let ((fd (fdport-data:fd (fdport-data port))))
 	      (receive (terminator num-read)
-		       (%read-delimited-fd!/errno delims buf
+		       (%read-delimited-fd!/errno sdelims buf
 						  fd start end)
 	        (let ((total (+ num-read total)))
 		  (cond ((not (integer? terminator)) (values terminator total))
@@ -221,9 +222,11 @@
   fixnum)	; number of chars skipped.
 
 
+;;; JMG: I added scset here without knowing, what I do !!
 (define (skip-char-set skip-chars . maybe-port)
-  (let ((port (:optional maybe-port (current-input-port)))
-	(cset (->char-set skip-chars)))
+  (let* ((port (:optional maybe-port (current-input-port)))
+	(cset (->char-set skip-chars))
+	(scset (char-set:s cset)))
     
     (cond ((not (input-port? port))
 	   (error "Illegal value -- not an input port." port))
@@ -232,7 +235,7 @@
 	  ((fdport? port)
 	   (let lp ((total 0))
 	     (receive (err num-read) (%skip-char-set-fd/errno
-				      cset (fdport-data:fd (fdport-data port)))
+				      scset (fdport-data:fd (fdport-data port)))
 	       (let ((total (+ total num-read)))
 		 (cond ((not err) total)
 		       ((= errno/intr err) (lp total))
@@ -263,7 +266,7 @@
 ;;; (read-paragraph [port handle-delim])
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define blank-line-regexp (make-regexp "^[ \t]*\n$"))
+(define blank-line-regexp (rx bos (* white) #\newline eos))
 
 (define (read-paragraph . args)
   (let-optionals args ((port         (current-input-port))
@@ -274,14 +277,14 @@
 	(cond ((eof-object? line)
 	       (if (eq? handle-delim 'split) (values line line) line))
 
-	      ((regexp-exec blank-line-regexp line) (lp))
+	      ((regexp-search? blank-line-regexp line) (lp))
 
 	      ;; Then, read in non-blank lines.
 	      (else
 	       (let lp ((lines (list line)))
 		 (let ((line (read-line port 'concat)))
 		   (if (and (string? line)
-			    (not (regexp-exec blank-line-regexp line)))
+			    (not (regexp-search? blank-line-regexp line)))
 
 		       (lp (cons line lines))
 
diff --git a/scsh/rx/re-low.scm b/scsh/rx/re-low.scm
index 1cebb22..6fdcc3a 100644
--- a/scsh/rx/re-low.scm
+++ b/scsh/rx/re-low.scm
@@ -1,6 +1,8 @@
 ;;; Regular expression matching for scsh
 ;;; Copyright (c) 1994 by Olin Shivers.
 
+(foreign-init-name "re_low")
+
 (foreign-source
   "/* Make sure foreign-function stubs interface to the C funs correctly: */"
   "#include <sys/types.h>"
diff --git a/scsh/rx/re1.c b/scsh/rx/re1.c
index d5d020d..b01710a 100644
--- a/scsh/rx/re1.c
+++ b/scsh/rx/re1.c
@@ -26,10 +26,11 @@
 **   and return a non-zero error code.
 */
 
-int compile_re(scheme_value re_str, int sm_p, regex_t **cr)
+int compile_re(s48_value re_str, int sm_p, regex_t **cr)
 {
-    char *s = &STRING_REF(re_str, 0);
-    int len = STRING_LENGTH(re_str);
+  // JMG: char *s = &STRING_REF(re_str, 0);
+  char *s = s48_extract_string(re_str);
+    int len = S48_STRING_LENGTH(re_str);
     int err;
     regex_t *re = Alloc(regex_t);
 
@@ -75,14 +76,15 @@ int compile_re(scheme_value re_str, int sm_p, regex_t **cr)
 ** Return 0 on success; #f if no match; non-zero integer error code otherwise.
 */
 
-scheme_value re_search(const regex_t *re, scheme_value str, int start,
-		       scheme_value trans_vec, int max_psm,
-		       scheme_value start_vec, scheme_value end_vec)
+s48_value re_search(const regex_t *re, s48_value str, int start,
+		       s48_value trans_vec, int max_psm,
+		       s48_value start_vec, s48_value end_vec)
 {
-  char *s = &STRING_REF(str,0);		/* Passed as a scheme_value because */
-  int len = STRING_LENGTH(str);		/* it might contain nul bytes.      */
+  // JMG: char *s = &STRING_REF(str,0);		/* Passed as a s48_value because */
+  char *s = s48_extract_string(str);
+  int len = S48_STRING_LENGTH(str);		/* it might contain nul bytes.      */
 
-  int vlen = VECTOR_LENGTH(start_vec);
+  int vlen = S48_VECTOR_LENGTH(start_vec);
   int retval;
 
   regmatch_t static_pmatch[10], *pm;
@@ -91,7 +93,7 @@ scheme_value re_search(const regex_t *re, scheme_value str, int start,
   if( max_psm < 10 ) pm = static_pmatch;
   else {
       pm = Malloc(regmatch_t, max_psm+1);/* Add 1 for the whole-match info. */
-      if( !pm ) return ENTER_FIXNUM(-1);
+      if( !pm ) return s48_enter_fixnum(-1);
       }
   
   pm[0].rm_so = start;
@@ -103,26 +105,31 @@ scheme_value re_search(const regex_t *re, scheme_value str, int start,
   if( !retval && max_psm >= 0 ) { 
       int i;
 
-      VECTOR_REF(start_vec,0) = ENTER_FIXNUM(pm[0].rm_so);    /* whole-match */
-      VECTOR_REF(end_vec,0)   = ENTER_FIXNUM(pm[0].rm_eo);
+      //JMG:      S48_VECTOR_REF(start_vec,0) = s48_enter_fixnum(pm[0].rm_so);    /* whole-match */
+      //S48_VECTOR_REF(end_vec,0)   = s48_enter_fixnum(pm[0].rm_eo);
+
+      S48_VECTOR_SET(start_vec,0, s48_enter_fixnum(pm[0].rm_so));
+      S48_VECTOR_SET(end_vec,0, s48_enter_fixnum(pm[0].rm_eo));
 
       for( i=vlen-1; --i >= 0; ) {			      /* submatches  */
-	  scheme_value j_scm = VECTOR_REF(trans_vec,i);
-	  if( j_scm != SCHFALSE ) {
-	      int j = EXTRACT_FIXNUM(j_scm);
+	  s48_value j_scm = S48_VECTOR_REF(trans_vec,i);
+	  if( j_scm != S48_FALSE ) {
+	      int j = s48_extract_fixnum(j_scm);
 	      int k = pm[j].rm_so,
 		  l = pm[j].rm_eo;
-	      VECTOR_REF(start_vec,i+1) = (k != -1) ? ENTER_FIXNUM(k) : SCHFALSE;
-	      VECTOR_REF(end_vec,  i+1) = (l != -1) ? ENTER_FIXNUM(l) : SCHFALSE;
-	      }
+	      //	JMG      S48_VECTOR_REF(start_vec,i+1) = (k != -1) ? s48_enter_fixnum(k) : S48_FALSE;
+	      //S48_VECTOR_REF(end_vec,  i+1) = (l != -1) ? s48_enter_fixnum(l) : S48_FALSE;
+	      S48_VECTOR_SET(start_vec,i+1, (k != -1) ? s48_enter_fixnum(k) : S48_FALSE);
+	      S48_VECTOR_SET(end_vec,  i+1, (l != -1) ? s48_enter_fixnum(l) : S48_FALSE);
 	  }
       }
+      }
 
   if( max_psm >= 10 ) Free(pm);
 
-  if( retval==REG_NOMATCH ) return SCHFALSE;
-  if( ! retval ) return SCHTRUE;
-  return ENTER_FIXNUM(retval);
+  if( retval==REG_NOMATCH ) return S48_FALSE;
+  if( ! retval ) return S48_TRUE;
+  return s48_enter_fixnum(retval);
   }
 
 
@@ -133,11 +140,13 @@ scheme_value re_search(const regex_t *re, scheme_value str, int start,
 ** Put the number of survivors in nummatch.
 */
 
-int filter_stringvec(scheme_value re_str, char const **stringvec)
+int filter_stringvec(s48_value re_str, char const **stringvec)
 {
-  int re_len     = STRING_LENGTH(re_str);/* Passed as a scheme_value because */
-  char *re_chars = &STRING_REF(re_str,0);/* it might contain nul bytes.      */
-  regex_t re;
+  int re_len     = S48_STRING_LENGTH(re_str);/* Passed as a s48_value because */
+  //JMG: char *re_chars = &STRING_REF(re_str,0);/* it might contain nul bytes.      */
+  char *re_chars = s48_extract_string (re_str);/* it might contain nul bytes.      */
+ 
+ regex_t re;
 
   char const **p, **q;
 
diff --git a/scsh/rx/re1.h b/scsh/rx/re1.h
index 141dd75..49878b2 100644
--- a/scsh/rx/re1.h
+++ b/scsh/rx/re1.h
@@ -1,13 +1,13 @@
 /* Exports from re1.c */
 
-int compile_re(scheme_value sre, int sm_p, regex_t **cr);
+int compile_re(s48_value sre, int sm_p, regex_t **cr);
 
-scheme_value re_search(const regex_t *re, scheme_value str, int start,
-		       scheme_value trans_vec, int max_psm,
-		       scheme_value start_vec, scheme_value end_vec);
+s48_value re_search(const regex_t *re, s48_value str, int start,
+		       s48_value trans_vec, int max_psm,
+		       s48_value start_vec, s48_value end_vec);
 
 /* Filter a vector of strings by a regexp. */
-int filter_stringvec(scheme_value re_str, char const **stringvec);
+int filter_stringvec(s48_value re_str, char const **stringvec);
 
 /* Error code -> error msg */
 const char *re_errint2str(int errcode, const regex_t *re);
diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm
index 1aad5d1..480cb4f 100644
--- a/scsh/scsh-interfaces.scm
+++ b/scsh/scsh-interfaces.scm
@@ -208,7 +208,7 @@
 			      port->sexp-list
 			      port->string-list
 			      port->list
-			      reduce-port
+			      port-fold reduce-port
 			      port->fdes
 			      read-string
 			      read-string!
@@ -283,7 +283,7 @@
 	  directory-files
 	  glob
 	  glob-quote
-	  file-match
+;	  file-match
 
 	  create-temp-file
 	  temp-file-iterate
@@ -418,6 +418,7 @@
 	  exec-path-list))
 
 
+;;; Kill me?
 (define-interface scsh-regexp-interface
   (export string-match
 	  regexp-match?
@@ -425,15 +426,18 @@
 	  match:end
 	  match:substring
 	  make-regexp
+	  ->regexp
 	  regexp?
-	  regexp-exec
+	  regexp-search
 	  regexp-substitute
 	  regexp-substitute/global
 	  regexp-quote))
 
 
 (define-interface scsh-string-interface
-  (export substitute-env-vars index rindex))
+  (export substitute-env-vars
+	  ;string-index string-index-right ; Now in string-lib
+	  ))
 
 (define-interface scsh-file-names-interface
   (export file-name-as-directory
@@ -453,6 +457,7 @@
 	  simplify-file-name
 	  resolve-tilde-file-name
 	  resolve-file-name
+	  absolute-file-name
 	  home-dir
 	  home-file))
 
@@ -485,6 +490,18 @@
 	  set-date:week-day	
 	  set-date:year-day
 
+	  modify-date:seconds
+	  modify-date:minute	
+	  modify-date:hour   	
+	  modify-date:month-day	
+	  modify-date:month   	
+	  modify-date:year    	
+	  modify-date:tz-name	
+	  modify-date:tz-secs	
+	  modify-date:summer?	
+	  modify-date:week-day	
+	  modify-date:year-day
+
 	  time+ticks
 	  ticks/sec
 	  time
@@ -553,13 +570,15 @@
 
 
 (define-interface scsh-utilities-interface
-  (export del delete index rindex reduce filter first any first? nth
-	  any? every? mapv mapv! vector-every? copy-vector initialize-vector
+  (export del delete filter first first? nth
+	  fold fold-right
+	  any every
+	  mapv mapv! vector-every? copy-vector initialize-vector vector-append
+	  vfold vfold-right
 	  check-arg conjoin disjoin negate compose reverse! call/cc
 	  deprecated-proc
 	  deposit-bit-field
-	  real->exact-integer
-	  string-replace! substring-replace!))
+	  real->exact-integer))
 
 ;;; semi-standard network magic numbers
 ;;; should be available on all platforms
@@ -665,9 +684,19 @@
 
 
 (define-interface char-set-interface
-  (export char:newline char:tab char:linefeed char:page char:return char:space
+  (export char:newline char:tab char:page char:return char:space char:vtab
 	  char-ascii?
+
 	  char-set?
+	  char-set-copy
+	  char-set=
+	  char-set<=
+	  char-set-size
+
+	  char-set-adjoin  char-set-delete
+	  char-set-adjoin! char-set-delete!
+	  char-set-for-each
+	  char-set-fold reduce-char-set
 
 	  char-set
 	  chars->char-set
@@ -679,27 +708,53 @@
 	  char-set-members
 	  char-set-contains?
 
+	  char-set-every?
+	  char-set-any
+
 	  char-set-invert
 	  char-set-union
 	  char-set-intersection
 	  char-set-difference
 
-	  char-set:upper-case
+	  char-set-invert!
+	  char-set-union!
+	  char-set-intersection!
+	  char-set-difference!
+
 	  char-set:lower-case
-	  char-set:numeric
-	  char-set:whitespace
-	  char-set:not-whitespace
+	  char-set:upper-case
 	  char-set:alphabetic
+	  char-set:numeric
 	  char-set:alphanumeric
 	  char-set:graphic
+	  char-set:printing
+	  char-set:whitespace
+	  char-set:blank
+	  char-set:control
+	  char-set:punctuation
+	  char-set:hex-digit
+	  char-set:ascii
+	  char-set:empty
+	  char-set:full
 
-	  char-upper-case?
 	  char-lower-case?
-	  char-numeric?
-	  char-whitespace?
+	  char-upper-case?
 	  char-alphabetic?
+	  char-numeric?
 	  char-alphanumeric?
-	  char-graphic?))
+	  char-graphic?
+	  char-printing?
+	  char-whitespace?
+	  char-blank?
+	  char-control?
+	  char-punctuation?
+	  char-hex-digit?
+	  char-ascii?
+
+	  ;; This is not properly part of the interface,
+	  ;; and should be moved to an internals interface --
+	  ;; it is used by rdelim.scm code.
+	  char-set:s))
 
 
 (define-interface scsh-field-reader-interface
@@ -717,7 +772,8 @@
 	  skip-char-set))
 
 (define-interface awk-interface
-  (export (awk :syntax)))
+  (export (awk :syntax)
+	  (awk/posix-string :syntax)))
 
 (define-interface scsh-dbm-interface
   (export dbm-open
@@ -956,6 +1012,16 @@
 	  tty-info:min			set-tty-info:min
 	  tty-info:time			set-tty-info:time
 
+	  modify-tty-info:control-chars
+	  modify-tty-info:input-flags 
+	  modify-tty-info:output-flags  
+	  modify-tty-info:control-flags
+	  modify-tty-info:local-flags
+	  modify-tty-info:input-speed
+	  modify-tty-info:output-speed
+	  modify-tty-info:min
+	  modify-tty-info:time
+
 	  make-tty-info			copy-tty-info
 
 	  tty-info
diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm
index eac2e7d..e3465f8 100644
--- a/scsh/scsh-package.scm
+++ b/scsh/scsh-package.scm
@@ -27,12 +27,16 @@
 
 
 (define-structure error-package (export error warn)
-  (open signals))
+  (open signals)
+  (optimize auto-integrate)
+  )
 
 
 (define-structure scsh-utilities scsh-utilities-interface
-  (open bitwise error-package let-opt scheme)
-  (files utilities))
+  (open bitwise error-package loopholes let-opt scheme)
+  (files utilities)
+  (optimize auto-integrate)
+  )
 
 
 ;;; This guy goes into the FOR-SYNTAX part of scsh's syntax exports.
@@ -44,24 +48,36 @@
 	scsh-utilities	; check-arg
 	scheme
 	)
-  (files syntax-helpers))
+  (files syntax-helpers)
+  (optimize auto-integrate)
+  )
 
 
 ;;; The bufpol/{block, line, none} values
 (define-structure buffered-io-flags buffered-io-flags-interface
   (open defenum-package scheme)
-  (files (machine bufpol)))
+  (files (machine bufpol))
+  (optimize auto-integrate)
+  )
 
 
 (define-structure char-set-package char-set-interface  
-  (open error-package ascii scheme)
-  (files char-set))
+  (open error-package
+	ascii
+	define-record-types	; JAR's record macro.
+	scsh-utilities		; For DEPRECATED-PROC
+	scheme)
+  (files char-set)
+  (optimize auto-integrate)
+  )
 
 
 (define-structures ((tty-flags tty-flags-interface)
 		    (scsh-internal-tty-flags scsh-internal-tty-flags-interface))
   (open scheme ascii bitwise)
-  (files (machine tty-consts)))
+  (files (machine tty-consts))
+  (optimize auto-integrate)
+  )
 
 
 (define-structure scsh-version scsh-version-interface
@@ -126,10 +142,10 @@
    (scsh-level-0-internals (export set-command-line-args!
 				   init-scsh-hindbrain
 				   init-scsh-vars))
-   (scsh-regexp-package scsh-regexp-interface))
-  (open 
-   ;scheme define-foreign-syntax defrec-package receiving ascii
-        enumerated
+;   (scsh-regexp-package scsh-regexp-interface)
+)
+  (for-syntax (open scsh-syntax-helpers scheme))
+  (open enumerated
 	external-calls           ;JMG new FFI
 	structure-refs
 	cig-aux
@@ -143,7 +159,7 @@
 	records
 	extended-ports
 	partial-s48-ports
-	ports
+;	ports
 	build
 	bigbit
 	bitwise
@@ -162,13 +178,20 @@
 	scsh-internal-tty-flags	; Not exported
 	let-opt			; optional-arg parsing & defaulting
 	
-	architecture
+	architecture     ; Was this by JMG ??
 	interrupts	; signal handler code
 
+	re-level-0
+	rx-syntax
+
+	string-lib
+
+	loopholes	; For my bogus CALL-TERMINALLY implementation.
+
 	scheme
 	
 	
-	i/o
+	i/o                  ; all these seem to be for scsh-0.6 JMG
 	i/o-internal
 	channels channel-i/o
 	low-channels
@@ -200,7 +223,7 @@
 	 filesys
 	 fileinfo
 	 glob
-	 filemtch
+;	 filemtch
 	 time			; New in release 0.2.
 	 (machine time_dep)
 	 network		; New in release 0.3.
@@ -210,19 +233,25 @@
 	 pty			; New in release 0.4.
 	 sighandlers		; New in release 0.5.
 	 scsh
-	; re
-	; rdelim
-	 ))
+;	 re
+;	 rdelim   ;rdelim omitted for noew by JMG
+	 )
+;  (optimize auto-integrate)
+  )
 
 (define-structure defrec-package (export (define-record :syntax))
   (open records scheme)
   (for-syntax (open scheme error-package receiving))
-  (files defrec))
+  (files defrec)
+  (optimize auto-integrate)
+  )
 
 (define-structure defenum-package (export (define-enum-constant  :syntax)
 					  (define-enum-constants :syntax))
   (open scheme)
-  (files enumconst))
+  (files enumconst)
+  (optimize auto-integrate)
+  )
 
 ;;; This code opens so many modules of gruesome, low-level S48 internals 
 ;;; that these two modules are segregated into separate packages, each
@@ -278,10 +307,12 @@
 (define-structure field-reader-package scsh-field-reader-interface
   (open receiving		; receive
 	char-set-package
-	scsh-utilities
+	scsh-utilities		; nth
 	error-package		; error
 	scsh-level-0		; delimited readers
-	scsh-regexp-package
+;	scsh-regexp-package
+	re-exports
+	string-lib		; join-strings
 	let-opt			; optional-arg parsing & defaulting
 	scheme
 	)
@@ -289,46 +320,63 @@
 
 
 (define-structures
-  ((awk-expander-package (export expand-awk))
+  ((awk-expander-package (export expand-awk expand-awk/obsolete))
    (awk-support-package (export next-range next-:range
 				next-range: next-:range:)))
   (open receiving		; receive
 	scsh-utilities	
 	error-package		; error
-	scsh-regexp-package
+;	scsh-regexp-package
+;	re-exports
+	sre-syntax-tools
 	scheme
 	)
   (files awk))
 	 
 
 (define-structure awk-package awk-interface
-  (open awk-support-package scsh-regexp-package receiving scheme)
+  (open awk-support-package	; These packages provide all the stuff 
+	re-exports		; that appears in the code produced by 
+	receiving		; an awk expansion.
+	scheme)
   (for-syntax (open awk-expander-package scheme))
-  (begin (define-syntax awk expand-awk)))
+  (begin (define-syntax awk expand-awk)
+	 (define-syntax awk/posix-string expand-awk/obsolete)))
 
+;;; Exports an AWK macro that is just AWK/POSIX-STRING.
+(define-structure obsolete-awk-package (export (awk :syntax))
+  (open awk-package)
+  (begin (define-syntax awk 
+           (syntax-rules () ((awk body ...) (awk/posix-string body ....))))))
 
 (define-structure scsh
   (compound-interface (interface-of scsh-level-0)
 		      (interface-of scsh-startup-package)
-		      ;JMG scsh-regexp-interface
-		      ;JMG scsh-field-reader-interface 	; new in 0.3
+;		      scsh-regexp-interface
+		      re-exports-interface
+		      re-old-funs-interface
+		      scsh-field-reader-interface 	; new in 0.3
 ;		      scsh-dbm-interface
 		      (export repl)
-		      ; JMG:awk-interface
+		      awk-interface
 		      )
 
   (open structure-refs
 	scsh-level-0
 	scsh-level-0-internals
-	scsh-regexp-package
+	re-exports
+	re-old-funs
+;	scsh-regexp-package
 	scsh-startup-package
 ;	dbm
-;	awk-package
-;	field-reader-package
+	awk-package
+	field-reader-package
 	scheme)
 
   (access scsh-top-package)
-  (begin (define repl (structure-ref scsh-top-package repl))))
+  (begin (define repl (structure-ref scsh-top-package repl)))
+  (optimize auto-integrate)
+  )
 
 (define-structure scsh-here-string-hax (export)
   (open reading
diff --git a/scsh/time.scm b/scsh/time.scm
index a5f88a3..2b3bab2 100644
--- a/scsh/time.scm
+++ b/scsh/time.scm
@@ -65,6 +65,18 @@
 (define set-date:week-day	set-%date:week-day)
 (define set-date:year-day	set-%date:year-day)
 
+(define modify-date:seconds	modify-%date:seconds)
+(define modify-date:minute	modify-%date:minute)
+(define modify-date:hour	modify-%date:hour)
+(define modify-date:month-day	modify-%date:month-day)
+(define modify-date:month	modify-%date:month)
+(define modify-date:year	modify-%date:year)
+(define modify-date:tz-name	modify-%date:tz-name)
+(define modify-date:tz-secs	modify-%date:tz-secs)
+(define modify-date:summer?	modify-%date:summer?)
+(define modify-date:week-day	modify-%date:week-day)
+(define modify-date:year-day	modify-%date:year-day)
+
 (define (make-date s mi h md mo y . args)
   (let-optionals args ((tzn #f) (tzs #f) (s?  #f) (wd  0)  (yd  0))
     (make-%date s mi h md mo y tzn tzs s? wd yd)))
@@ -295,14 +307,15 @@
 	       (if (< offset 0)
 		   (values #\+ (- offset))	    ; Notice the flipped sign
 		   (values #\- offset))		    ; of SIGN.
-        (let* ((offset (modulo offset 86400))
-	       (h (quotient offset 3600))
+        (let* ((offset (modulo offset 86400))	; seconds/day
+	       (h (quotient offset 3600))	; seconds/hour
 	       (m (quotient (modulo offset 3600) 60))
 	       (s (modulo offset 60)))
 	  (if (zero? s)
 	      (if (zero? m)
 		  (format #f "~a~a~d" name sign h)	; name+h
 		  (format #f "~a~a~a:~a"		; name+hh:mm
-			  sign (two-digits h) (two-digits m)))
+			  name sign (two-digits h) (two-digits m)))
 	      (format #f "~a~a~a:~a:~a"			; name+hh:mm:ss
-		      sign (two-digits h) (two-digits m) (two-digits s)))))))
+		      name sign
+		      (two-digits h) (two-digits m) (two-digits s)))))))
diff --git a/scsh/tty.scm b/scsh/tty.scm
index de6cb0f..2440ea0 100644
--- a/scsh/tty.scm
+++ b/scsh/tty.scm
@@ -70,6 +70,14 @@
 (define set-tty-info:min 		set-%tty-info:min)
 (define set-tty-info:time 		set-%tty-info:time)
 
+(define modify-tty-info:control-chars 	modify-%tty-info:control-chars)
+(define modify-tty-info:input-flags 	modify-%tty-info:input-flags)
+(define modify-tty-info:output-flags 	modify-%tty-info:output-flags)
+(define modify-tty-info:control-flags 	modify-%tty-info:control-flags)
+(define modify-tty-info:local-flags 	modify-%tty-info:local-flags)
+(define modify-tty-info:min 		modify-%tty-info:min)
+(define modify-tty-info:time 		modify-%tty-info:time)
+
 ;;; Encode the speeds at assignment time.
 (define (set-tty-info:input-speed info speed)
   (set-%tty-info:input-speed-code info (encode-baud-rate speed))
@@ -79,6 +87,11 @@
   (set-%tty-info:output-speed-code info (encode-baud-rate speed))
   (set-%tty-info:output-speed      info speed))
 
+(define (modify-tty-info:input-speed info proc)
+  (set-tty-info:input-speed info (proc (tty-info:input-speed info))))
+
+(define (modify-tty-info:output-speed info proc)
+  (set-tty-info:output-speed info (proc (tty-info:output-speed info))))
 
 (define (make-tty-info iflags oflags cflags lflags ispeed ospeed min time)
   (make-%tty-info (make-string num-ttychars (ascii->char 0))
@@ -101,9 +114,14 @@
 		  (tty-info:time	       info)))
 		  
 
-;;; (tty-info fd/port)
+
+(define (sleazy-call/file tty opener proc)
+  (if (string? tty) (opener tty proc)
+      (sleazy-call/fdes tty proc)))
+
+;;; (tty-info [fd/port/fname])
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Retrieve tty-info bits from a tty.
+;;; Retrieve tty-info bits from a tty. Arg defaults to current input port.
 
 (define (tty-info fdport)
   (let ((control-chars (make-string num-ttychars)))
@@ -138,11 +156,33 @@
   integer integer
   integer integer)
 
+(define-foreign %bogus-tty-info/errno
+  ("scheme_tcgetattrB" (integer fdes)
+                       (var-string control-chars)
+		       (vector-desc ivec))
+  (to-scheme integer errno_or_false))
 
-;;; (set-tty-info       fdport option info)	[Not exported]
-;;; (set-tty-info/now   fdport option info)
-;;; (set-tty-info/drain fdport option info)
-;;; (set-tty-info/flush fdport option info)
+(define-errno-syscall (%bogus-tty-info fdes control-chars ivec)
+  %bogus-tty-info/errno)
+  
+(define (%%bogus-tty-info fd control-chars)
+  (let ((ivec (make-vector 10)))
+    (%bogus-tty-info fd control-chars ivec)
+    ivec))
+
+;(define (%tty-info fdes cc)
+;  (let ((ivec (%%bogus-tty-info fdes cc)))
+;    (values (vector-ref ivec 0) (vector-ref ivec 1)
+;	    (vector-ref ivec 2) (vector-ref ivec 3)
+;	    (vector-ref ivec 4) (vector-ref ivec 5)
+;	    (vector-ref ivec 6) (vector-ref ivec 7)
+;	    (vector-ref ivec 8) (vector-ref ivec 9)
+;	    cc)))
+
+;;; (set-tty-info       tty option info)	[Not exported]
+;;; (set-tty-info/now   tty option info)
+;;; (set-tty-info/drain tty option info)
+;;; (set-tty-info/flush tty option info)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Assign tty-info bits to a tty.
 
diff --git a/scsh/utilities.scm b/scsh/utilities.scm
index ea65614..89398a5 100644
--- a/scsh/utilities.scm
+++ b/scsh/utilities.scm
@@ -40,6 +40,19 @@
 		 (if (pair? rest) (lp (f val (car rest)) (cdr rest))
 		     val))))
     (lp zero l)))
+
+(define (fold kons knil lis)
+  (let lp ((lis lis) (ans knil))
+    (if (pair? lis)
+	(lp (cdr lis) (kons (car lis) ans))
+	ans)))
+
+(define (fold-right kons knil lis)
+  (let recur ((lis lis))
+    (if (pair? lis)
+	(let ((head (car lis)))		; Won't need LIS after RECUR call. 
+	  (kons head (recur (cdr lis))))
+	knil)))
 				      
 (define (filter pred list)
   (letrec ((filter (lambda (list)
@@ -115,6 +128,37 @@
 	((< i 0) v)
       (vector-set! v i (init i)))))
 
+(define (vector-append . vecs)
+  (let* ((vlen (fold (lambda (v len) (+ (vector-length v) len)) 0 vecs))
+	 (ans (make-vector vlen)))
+    (let lp1 ((vecs vecs) (to 0))
+      (if (pair? vecs)
+	  (let* ((vec (car vecs))
+		 (len (vector-length vec)))
+	    (let lp2 ((from 0) (to to))
+	      (cond ((< from len)
+		     (vector-set! ans to (vector-ref vec from))
+		     (lp2 (+ from 1) (+ to 1)))
+		    (else (lp1 (cdr vecs) to)))))))
+    ans))
+      
+
+(define (vfold kons knil v)
+  (let ((len (vector-length v)))
+    (do ((i 0 (+ i 1))
+	 (ans knil (kons (vector-ref v i) ans)))
+	((>= i len) ans))))
+
+(define (vfold-right kons knil v)
+  (do ((i (- (vector-length v) 1) (- i 1))
+       (ans knil (kons (vector-ref v i) ans)))
+      ((< i 0) ans)))
+
+
+;;; We loophole the call to ERROR -- the point is that perhaps the
+;;; user will interact with a breakpoint, and proceed with a new
+;;; value, which we will then pass to a new invocation of CHECK-ARG
+;;; for approval.
 (define (check-arg pred val caller)
   (if (pred val) val
       (check-arg pred (error "Bad argument" val pred caller) caller)))