diff --git a/Makefile b/Makefile
index e76751f4..602a2d02 100644
--- a/Makefile
+++ b/Makefile
@@ -10,7 +10,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       spcwar rwg libmax rat z emaxim rz maxtul aljabr cffk das ell ellen \
       jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \
       tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \
-      draw wl taa tj6 budd sharem ucode rvb kldcp
+      draw wl taa tj6 budd sharem ucode rvb kldcp math
 DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
       chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
       xfont maxout ucode moon acount alan channa fonts games graphs humor \
diff --git a/build/lisp.tcl b/build/lisp.tcl
index 9a8f41f8..0b11532b 100644
--- a/build/lisp.tcl
+++ b/build/lisp.tcl
@@ -858,3 +858,15 @@ respond "*" "complr\013"
 respond "_" "games;_chase\r"
 respond "_" "\032"
 type ":kill\r"
+
+# Kermit
+respond "*" ":link math;defset fasl,lisp;\r"
+respond "*" ":complr\r"
+respond "_" "math;common\r"
+respond "_" "math;kermit\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":lisp math; kermit dumper\r"
+respond "to dump.|" "(kermit-dump)"
+expect ":KILL"
+respond "*" ":link sys3;ts kermit,math;\r"
diff --git a/doc/info/kermit.4 b/doc/info/kermit.4
new file mode 100755
index 00000000..dfd36bcf
--- /dev/null
+++ b/doc/info/kermit.4
@@ -0,0 +1,109 @@
+-*-Text-*-
+
+This is the file INFO;KERMIT >, which documents KERMIT, a file-transfer
+program.
+
+File: Kermit	Node: Top		Up: (DIR)	Next: Simple
+
+Kermit is a file transfer program which can send and receive text files
+over a terminal line.  It is particularly useful for transferring files
+between an ITS and a PC or other random computer which has a modem but
+isn't connected to any network.
+
+* Menu:
+
+* Simple::		Basic usage.
+* Filenames::		File name syntax.
+* Parameters::		Setting internal parameters.
+
+
+File: Kermit	Node: Simple		Up: Top		Next: Filenames
+
+For purposes of this presentation, I'll refer to the machine which is at
+the other end of the connection as the "PC", even though of course it
+can be any machine which runs Kermit.
+
+Typical use of Kermit is as follows:
+
+  1. Get ahold of a terminal emulator and a kermit program for your PC.
+     Often these come together in a single package.  Kermit has many
+     implementations, inluding versions for Unix, IBM PC (crosstalk?),
+     Macintosh, VAX/VMS, and Symbolics 3600.  Many of these are public
+     domain.  I think the MIT microcomputer store sells it.  You can
+     also get it from Columbia University, which is where Kermit originated.
+
+  2. Start the terminal emulator, dial up the ITS machine on the phone,
+     and log in.
+
+  3. Run the Kermit server with the DDT command :KERMIT.  It will inform
+     you that it is entering Kermit server mode.
+
+  4. On the PC, run the kermit user program.  This is usually a command
+     processor or menu which has commands like GET, SEND, and FINISH.
+
+  5. Issue GET and SEND commands to receive or transmit files.
+
+  6. Issue a FINISH command to halt the ITS KERMIT server.
+
+  7. Return to the terminal emulator to get back to ITS, etc.
+
+
+File: Kermit	Node: Filenames		Up: Top		Next: Parameters
+
+In order to accomodate Kermit user programs which are unable to send or
+receive filenames with spaces in them, ITS Kermit will treat a period in
+the filename as a FN1/FN2 separator.  E.g., to get file FOO STUFF in the
+current directory, issue the command GET FOO.STUFF.  Yes, this means
+that you can't ask for files that have dots in their names; this is an
+unfortunate limitation.
+
+A second filename of LSP, LISP, TXT, or SCM will be ignored (treated
+like >).  (This is controlled by the variable *ITS-UNINTERESTING-TYPES*;
+see the Parameters node.)
+
+To accomodate Kermit programs that don't like semicolons, but do
+like colons, ITS Kermit will treat FOO: as if it were FOO;,assuming
+that there is no FOO device.
+
+File: Kermit	Node: Parameters		Up: Top		
+
+Kermit is a Maclisp program.  A number of interesting internal
+parameters are stored as the values of Lisp global variables.  They can
+be changed by using SETQ at a read-eval-print loop or in your Kermit
+init file.  For example, if your uname is FOO, you can put
+
+    (PUSH "tex" *ITS-UNINTERESTING-TYPES*)
+
+in your Kermit init file FOO KERMIT.
+
+To get to a read-eval-print loop, type control-G.  To enter Kermit
+server mode again, call the function SERVE with no arguments.
+
+E.g.:
+
+        ^G
+	QUIT
+	(PUSH "tex" *ITS-UNINTERESTING-TYPES*)
+	(...)
+	(SERVE)
+	Entering KERMIT server mode.
+
+Here are some of the things you can set:
+
+  Variable             Default  Description
+  *DEBUG?*	       NIL      T means supply debugging info as you run
+  *VERSION-NUMBERS?*   NIL      T means include version numbers in file names,
+				 whenever possible
+  *MAX-RETRY-COUNT*    10.      Times to retry a packet
+  *MIN-TIMEOUT*	       2        Minimum timeout interval in seconds
+  *SERVER-TIMEOUT*     30       Timeout interval when in server mode
+  *SERIAL-INPUT*       NIL      Input stream for serial line
+  *SERIAL-OUTPUT*      NIL      Output stream for serial line
+  *COMMENTARY-STREAM*  terminal Stream for messages to user
+  *DEFAULT-PATHNAME-DEFAULTS*
+
+The variable *ITS-UNINTERESTING-TYPES* is a list of file types that
+should be treated as if they aren't there.  The default value is
+("LISP" "LSP" "SCM" "TXT" "lisp" "lsp" "scm" "txt" "" :UNSPECIFIC).
+
+See the source code (AI: MATH; KERMIT >) for further inspiration.
diff --git a/doc/math/kermit.order b/doc/math/kermit.order
new file mode 100755
index 00000000..18a2b7c3
--- /dev/null
+++ b/doc/math/kermit.order
@@ -0,0 +1,105 @@
+-*-Text-*-
+
+This is the file INFO;KERMIT >, which documents KERMIT, a file-transfer
+program.
+
+File: Kermit	Node: Top		Up: (DIR)	Next: Simple
+
+Kermit is a file transfer program which can send and receive text files
+over a terminal line.  It is particularly useful for transferring files
+between an ITS and a PC or other random computer which has a modem but
+isn't connected to any network.
+
+* Menu:
+
+* Simple::		Basic usage.
+* Filenames::		File name syntax.
+* Parameters::		Setting internal parameters.
+
+
+File: Kermit	Node: Simple		Up: Top        Next: Filenames
+
+
+For purposes of this presentation, I'll refer to the machine which is at
+the other end of the connection as the "PC", even though of course it
+can be any machine which runs Kermit.
+
+Typical use of Kermit is as follows:
+
+  1. Get ahold of a terminal emulator and a kermit program for your PC.
+     Often these come together in a single package.  Kermit has many
+     implementations, inluding versions for Unix, IBM PC (crosstalk?),
+     Macintosh, VAX/VMS, and Symbolics 3600.  Many of these are public
+     domain.  I think the MIT microcomputer store sells it.  You can
+     also get it from Columbia University, which is where Kermit originated.
+
+  2. Start the terminal emulator, dial up the ITS machine on the phone,
+     and log in.
+
+  3. Run the Kermit server with the DDT command :KERMIT.  It will inform
+     you that it is entering Kermit server mode.
+
+  4. On the PC, run the kermit user program.  This is usually a command
+     processor or menu which has commands like GET, SEND, and FINISH.
+
+  5. Issue GET and SEND commands to receive or transmit files.
+
+  6. Issue a FINISH command to halt the ITS KERMIT server.
+
+  7. Return to the terminal emulator to get back to ITS, etc.
+
+
+File: Kermit	Node: Filenames		Up: Top		Next: Parameters
+
+
+In order to accomodate Kermit user programs which are unable to send or
+receive filenames with spaces in them, ITS Kermit will treat a period in
+the filename as a FN1/FN2 separator.  E.g., to get file FOO TXT in the
+current directory, issue the command GET FOO.TXT.
+
+A second filename of LSP, LISP, TXT, or SCM will be ignored (treated
+like >).  (This is controlled by the Maclisp variable
+*ITS-UNINTERESTING-TYPES*; see below.)
+
+To accomodate Kermit user programs which don't like semicolons, but do
+like colons, ITS Kermit will treat FOO: as if it were FOO; (assuming
+that there is no FOO device).
+
+By default, ITS Kermit will transmit version numbers for files which
+have them.  E.g. if you ask to get file FOO.LSP, and there is a local
+file FOO 23, ITS Kermit will say that it is transmitting FOO.LSP.23.
+If you don't want this, you'll have to set *VERSION-NUMBERS?* to NIL
+(see below).
+
+
+File: Kermit	Node: Parameters		Up: Top		
+
+
+Kermit is a Maclisp program.  A number of interesting internal
+parameters are stored as the values of global variables, and therefore
+can be changed by using SETQ at a read-eval-print loop.
+
+To get to a read-eval-print loop, type control-G.  To enter Kermit
+server mode, call the function SERVE with no arguments.
+
+E.g.:
+
+        ^G
+	QUIT
+	(PUSH "tex" *ITS-UNINTERESTING-TYPES*)
+	(...)
+	(SERVE)
+	Entering KERMIT server mode.
+
+Here are some of the things you can set:
+
+(DEFVAR *DEBUG?*	  NIL "T means supply debugging info as you run")
+(DEFVAR *VERSION-NUMBERS?* T  "T means include version numbers in file names")
+(DEFVAR *MAX-RETRY-COUNT* 10. "times to retry a packet")
+(DEFVAR *MIN-TIMEOUT*	  2   "minimum timeout interval in seconds")
+(DEFVAR *SERVER-TIMEOUT*  30  "timeout interval when in server mode")
+(DEFVAR *SERIAL-INPUT*	  NIL "input stream for serial line")
+(DEFVAR *SERIAL-OUTPUT*	  NIL "output stream for serial line")
+(DEFVAR *COMMENTARY-STREAM* *TERMINAL-IO* "stream for messages to user")
+
+See the source code (AI: MATH; KERMIT >) for inspiration.
diff --git a/doc/programs.md b/doc/programs.md
index 2c2aedc3..5aabaf67 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -101,6 +101,7 @@
 - JEDGAR, counter spying tool.
 - JOBS, list jobs by category.
 - JOTTO, word-guessing game.
+- KERMIT, file transfer.
 - KLDCP, KL10 diagnostics console program.
 - KLFEDR, KL10 frontend directory tool.
 - KLRUG, KL10 frontend debugger.
diff --git a/src/math/common.88 b/src/math/common.88
new file mode 100644
index 00000000..10abfea4
--- /dev/null
+++ b/src/math/common.88
@@ -0,0 +1,659 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: (KERMIT LISP) -*-
+
+;;; Common-Lisp-in-Maclisp
+;;; Jonathan Rees   MIT   Jan-Feb 1986
+
+;;; Please don't take this seriously.  It exists only to make KERMIT and
+;;; a couple of other things of mine work.
+
+(setq gc-overflow nil)
+
+;;; Change read syntax
+
+(eval-when (eval load compile)
+  (setq base 10. ibase 10. *nopoint t)
+  (sstatus syntax 47. 2.)
+  (sstatus syntax 92. 132416.)
+  (or (get 'sharpm 'version)
+      (load '((lisp) sharpm)))
+  (defprop defsetf ((dsk math) defset fasl) autoload))
+
+(declare (mapex t))
+
+(eval-when (eval load compile)
+(defsharp \\ (macro-arg)
+  (declare (special \#-symbolic-characters-table))
+  (let ((first-char (tyipeek)))
+    (cond ((not (or (and (>= first-char 65.) (<= first-char 90.))
+		    (and (>= first-char 97.) (<= first-char 122.))))
+	   ;; Not alphabetic
+	   (tyi))
+	  (t
+	   (let ((foo (read)))
+	     (cond ((= (flatc foo) 1) first-char)
+		   (t
+		    (let ((probe (assq foo \#-symbolic-characters-table)))
+		      (cond (probe (cdr probe))
+			    (t (error "unknown #\\ character name" foo 'fail-act)))))))))))
+)
+
+(push '(LINE . 10.) |#-SYMBOLIC-CHARACTERS-TABLE|)
+(push '(PAGE . 12.) |#-SYMBOLIC-CHARACTERS-TABLE|)
+
+;;; -- Macros & special forms
+
+(defmacro lisp:catch (tag &rest body)
+  `(*catch ,tag ,@body))
+
+(defmacro lisp:throw (tag value)
+  `(*throw ,tag ,value))
+
+(defmacro defparameter (var val &rest foo)
+  `(progn 'compile
+	  (defvar ,var nil ,@foo)
+	  (setq ,var ,val)))
+
+(defmacro defconstant (&rest x)
+  `(defconst ,@x))  ;randomness in MLMAC
+
+(defun require (module &optional (filename module))
+  (or (get module 'version)
+      (load filename)))
+
+(defun provide (module)
+  (putprop module t 'version))
+
+(defmacro the (type obj) type obj)
+
+;;; DEFSUBST isn't Common Lisp, but Maclisp has no (declare (inline ...)).
+
+(defmacro defsubst (name bvl &rest body)
+  (let ((body (if (null (cdr body)) (car body) `(progn ,@body))))
+    `(defmacro ,name ,bvl
+       (sublis (list ,@(mapcar #'(lambda (var) `(cons ',var ,var)) bvl))
+	       ',body))))
+
+(defmacro incf (place &optional (amount 1))
+  `(setf ,place (+ ,place ,amount)))
+
+(defmacro decf (place &optional (amount 1))
+  `(setf ,place (- ,place ,amount)))
+
+(defmacro multiple-value-setq (&rest x)
+  `(multiple-value ,@x))
+
+(defmacro case (key &rest clauses)
+  `(caseq ,key ,@(mapcar #'(lambda (clause)
+			     (if (eq (car clause) 'otherwise)
+				 (cons 't (cdr clause))
+				 clause))
+			 clauses)))
+
+;(eval-when (eval load compile)
+;  (or (status feature defstruct)
+;      (load '((dsk liblsp) struct))))
+
+;;; -- Internal utility
+
+(defmacro let-keyword-args (specs rest &rest body)
+  (cond ((null specs) body)
+	(t `(let* ,(mapcar #'(lambda (spec)
+			       (let ((name (if (atom spec) spec (car spec)))
+				     (init (if (atom spec) nil  (cadr spec))))
+				 `(,name
+				   (let ((,name (member ',(symbolconc ': name) ,rest)))
+				     (if ,name (cadr ,name) ,init)))))
+			   specs)
+	      ,@body))))
+
+;;; -- Randomness
+
+(declare (unspecial args))
+
+(defvar *terminal-io* t)
+(defvar *debug-io* t)
+(defvar *standard-input* t)
+(defvar *standard-output* t)
+
+;;; -- Various functions
+
+(cond ((status feature complr)
+       (*lexpr import export in-package make-package lisp:open lisp:close
+	       aref concatenate make-pathname merge-pathnames
+	       make-broadcast-stream)))
+
+(defmacro consp (x) `(not (atom ,x)))
+(defmacro symbol-value (x) `(symeval ,x))
+(defmacro symbol-function (x) x)
+(defmacro lisp:apply (&rest stuff) `(lexpr-funcall ,@stuff))
+
+(defmacro char-code (x) x)
+(defmacro code-char (x) x)
+(defmacro char= (&rest stuff) `(= ,@stuff))
+(defmacro char< (&rest stuff) `(< ,@stuff))
+(defmacro char> (&rest stuff) `(> ,@stuff))
+(defmacro char<= (&rest stuff) `(<= ,@stuff))
+(defmacro char>= (&rest stuff) `(>= ,@stuff))
+
+(defun alpha-char-p (c)
+  (or (and (>= c 65.) (<= c 90.))
+      (and (>= c 97.) (<= c 122.))))
+
+(defun graphic-char-p (c)
+  (and (>= c 32.) (< c 127.)))
+
+;;; Packages
+
+(defvar *package* 'user)
+
+(defconstant :use ':use)
+
+(defun find-package (name) name)
+
+(defun in-package (package &rest ignore)
+  (setq *package* package))
+
+(defun export (symbols &rest ignore) nil)
+
+(defmacro shadow (symbols &optional (pkg '*package*))
+  `(eval-when (eval load compile)
+     (*shadow ,symbols ,pkg)))
+
+(defun *shadow (symbols pkg) pkg
+  (mapc #'(lambda (symbol)
+	    (cond ((and (not (get symbol 'shadows))
+			(not (get symbol 'shadowed-by)))
+		   (remob symbol)
+		   (let ((new (intern (copysymbol symbol nil))))
+		     (putprop symbol new 'shadowed-by)
+		     (putprop new symbol 'shadows)))))
+	(if (and symbols (atom symbols))
+	    (list symbols)
+	    symbols)))
+
+(defun make-package (&rest ignore)
+  (*array nil 'obarray nil))
+
+;;; Arrays
+
+(defconstant :element-type ':element-type)
+(defconstant :fill-pointer ':fill-pointer)
+
+(defun make-array (dimensions &rest rest)
+  (let-keyword-args ((element-type 't)
+		     (fill-pointer nil))
+		    rest
+    (let* ((dimensions (if (atom dimensions) (list dimensions) dimensions))
+	   (the-array
+	     (lexpr-funcall #'*array nil
+			    (cond ((memq element-type
+					 '(character string-char fixnum))
+				   'fixnum)
+				  ((eq element-type 'float) 'flonum)
+				  (t 't))
+			    dimensions)))
+      (hunk the-array
+	    (if (not (fixp fill-pointer)) (car dimensions) fill-pointer)
+	    'array))))
+
+(defun lisp:arrayp (obj)
+  (and (hunkp obj) (eq (cdr obj) 'array)))
+
+(defmacro array-array (array)
+  `(cxr 1 ,array))
+
+(defmacro fill-pointer (array)
+  `(cxr 2 ,array))
+
+(defun aref (array &rest subscripts)
+  (cond ((simple-string-p array)
+	 (getcharn array (1+ (car subscripts))))
+	(t
+	 (apply (array-array array) subscripts))))
+
+;;; (defsetf aref ((aref array &rest subscripts) value) t
+;;;   `(store (funcall (array-array ,array) ,@subscripts) ,value))
+
+(PROGN 'COMPILE
+       (DEFUN |AREF SETF-X-ACCESS| (|SETF-struct..44| ARRAY &REST SUBSCRIPTS) 
+	 (LET ((|Function..43| (SETF-FUNCTION |SETF-struct..44|)))
+	   (LIST* |Function..43| ARRAY SUBSCRIPTS)))
+       (DEFUN |AREF SETF-X-INVERT| (|SETF-struct..44| VALUE ARRAY &REST SUBSCRIPTS) 
+	 (LET ((AREF (SETF-FUNCTION |SETF-struct..44|)))
+	   AREF
+	   `(STORE (FUNCALL (ARRAY-ARRAY ,ARRAY) ,@SUBSCRIPTS) ,VALUE)))
+       (DEFUN (AREF SETF-X) (|access-spec..42|) 
+	 (LET (((|Function..43| ARRAY . SUBSCRIPTS) |access-spec..42|))
+	      (SETF-STRUCT '|AREF SETF-X-ACCESS|
+			   '|AREF SETF-X-INVERT|
+			   'T
+			   (LIST* ARRAY SUBSCRIPTS)
+			   |Function..43|)))
+       'AREF)
+
+;;; Simple strings
+
+(defun simple-string-p (obj)
+  (and (symbolp obj) (get obj '+internal-string-marker)))
+
+(defun stringicate (symbol)
+  (putprop symbol t '+internal-string-marker)
+  symbol)
+
+;;; Strings
+
+(defun stringp (obj)
+  (or (simple-string-p obj)
+      (lisp:arrayp obj)))
+
+(defun string-elt (string index)
+  (cond ((symbolp string)
+	 (getcharn string (1+ index)))
+	(t
+	 (arraycall fixnum (array-array string) index))))
+
+(defun set-string-elt (string index value)
+  (store (arraycall fixnum (array-array string) index) value))
+
+(defsetf string-elt ((string-elt string index) value) t
+  `(set-string-elt ,string ,index ,value))
+
+(defun coerce (obj type)
+  (cond ((and (listp obj) (eq type 'string))
+	 (stringicate (maknam obj)))
+	((and (stringp obj) (eq type 'string)) obj)
+	((and (symbolp obj) (eq type 'list)) (exploden obj))
+	((and (lisp:arrayp obj) (eq type 'list))
+	 (do ((i (1- (fill-pointer obj)) (1- i))
+	      (l '() (cons (aref obj i) l)))
+	     ((< i 0) l)))
+	((and (listp obj) (eq type 'list)) obj)
+	((eq (typep obj) type) obj)
+	(t (error "bad args to COERCE" (list obj type) 'fail-act))))
+
+(defun unkludgify-string (data)
+  (cond ((simple-string-p data) data)
+	(t (coerce (coerce data 'list) 'string))))
+
+;;; Sequences
+
+(defun concatenate (type &rest seqs)
+  (coerce (apply #'append
+		 (mapcar #'(lambda (seq) (coerce seq 'list))
+			 seqs))
+	  type))
+
+(defun lisp:length (seq)
+  (cond ((symbolp seq) (flatc seq))
+	((lisp:arrayp seq) (fill-pointer seq))
+	(t (length seq))))
+
+
+
+;;; Pathnames
+
+(defsubst pathname-host      (pathname) (cxr 1 pathname))
+(defsubst pathname-device    (pathname) (cxr 2 pathname))
+(defsubst pathname-directory (pathname) (cxr 3 pathname))
+(defsubst pathname-name	     (pathname) (cxr 4 pathname))
+(defsubst pathname-type	     (pathname) (cxr 5 pathname))
+(defsubst pathname-version   (pathname) (cxr 6 pathname))
+    
+(defsubst pathnamep (thing)
+  (and (hunkp thing) (eq (cdr thing) 'pathname)))
+
+(defun pathname (thing)
+  (cond ((pathnamep thing) thing)
+	((symbolp thing) (parse-namestring thing))
+	((stringp thing) (parse-namestring (unkludgify-string thing)))
+	((consp thing)
+	 ;; ITS namelist!
+	 (namelist->pathname thing))
+	(t (error "can't coerce to pathname" thing 'fail-act))))
+
+(defconstant :defaults  ':defaults)
+(defconstant :host	':host)
+(defconstant :device	':device)
+(defconstant :directory ':directory)
+(defconstant :name	':name)
+(defconstant :type	':type)
+(defconstant :version   ':version)
+
+(defvar *default-pathname-defaults*
+  (hunk nil nil nil nil nil nil 'pathname))
+
+(defun make-pathname (&rest rest)
+  (let-keyword-args ((defaults  *default-pathname-defaults*)
+		     (host      (pathname-host      defaults))
+		     (device	(pathname-device    defaults))
+		     (directory (pathname-directory defaults))
+		     (name	(pathname-name	    defaults))
+		     (type	(pathname-type	    defaults))
+		     (version	(pathname-version   defaults)))
+		    rest
+    (hunk host device directory name type version 'pathname)))
+
+(defconstant :newest ':newest)
+(defconstant :oldest ':oldest)
+(defconstant :wild   ':wild)
+
+(defun merge-pathnames (pathname &optional
+				 (defaults *default-pathname-defaults*)
+				 (default-version ':newest))
+  (let ((pathname (pathname pathname))
+	(defaults (pathname defaults)))
+    (hunk (or (pathname-host pathname) (pathname-host defaults))
+	  (or (pathname-device pathname) (pathname-device defaults))
+	  (or (pathname-directory pathname) (pathname-directory defaults))
+	  (or (pathname-name pathname) (pathname-name defaults))
+	  (or (pathname-type pathname) (pathname-type defaults))
+	  (or (pathname-version pathname) default-version (pathname-version defaults))
+	  'pathname)))
+
+;;;   [device:] [directory;] name [.type [.version]]
+
+(defun parse-namestring (thing)
+  (cond ((lisp:arrayp thing)
+	 (parse-namestring (unkludgify-string thing)))
+	(t
+	 (parse-namestring-aux (coerce thing 'list)))))
+
+(defun parse-namestring-aux (l)
+  (multiple-value-bind (piece delimiter l)
+		       (get-namestring-piece l '(#\: #\; #\. #\space))
+    (cond ((null delimiter)
+	   (make-pathname ':name piece))
+	  ((char= delimiter #\:)
+	   (make-pathname ':device piece ':defaults (parse-namestring-aux l)))
+	  ((char= delimiter #\;)
+	   (make-pathname ':directory piece ':defaults (parse-namestring-aux l)))
+	  (t
+	   (multiple-value-bind (type delimiter l)
+				(get-namestring-piece l '(#\. #\space))
+	     (make-pathname ':name piece
+			    ':type type
+			    ':version (if (not delimiter)
+					  nil
+					  (string->version (get-namestring-piece-aux l)))))))))
+
+(defun get-namestring-piece (l delims)
+  (do ((l l (cdr l))
+       (z '() (cons (car l) z)))
+      ((null l)
+       (values (get-namestring-piece-aux (reverse z)) nil '()))
+    (if (member (car l) delims)
+	(return (values (get-namestring-piece-aux (reverse z)) (car l) (cdr l))))))
+
+(defun get-namestring-piece-aux (l)
+  (let ((l (coerce l 'string)))
+    (cond ((samepnamep l '*) :wild)
+	  ((samepnamep l '>) :newest)
+	  ((samepnamep l '<) :oldest)
+	  (t l))))
+
+(defun string->version (sym)
+  (let ((probe (*catch 'foo
+		 (let ((*rset-trap #'(lambda ignore (*throw 'foo nil))))
+		   (readlist (exploden sym))))))
+    (cond ((not (numberp probe)) sym)
+	  ((= probe 0) :newest)
+	  ((= probe -1) :oldest)
+	  (t probe))))
+
+(defun pathname-lessp (n1 n2)
+  (let ((h1 (pathname-host n1))
+	(h2 (pathname-host n2)))
+    (or (component-lessp h1 h2)
+	(and (component-equalp h1 h2)
+	     (let ((d1 (pathname-device n1))
+		   (d2 (pathname-device n2)))
+	       (or (component-lessp d1 d2)
+		   (and (component-equalp d1 d2)
+			(let ((d1 (pathname-directory n1))
+			      (d2 (pathname-directory n2)))
+			  (or (component-lessp d1 d2)
+			      (and (component-equalp d1 d2)
+				   (let ((a1 (pathname-name n1))
+					 (a2 (pathname-name n2)))
+				     (or (component-lessp a1 a2)
+					 (and (component-equalp a1 a2)
+					      (let ((t1 (pathname-type n1))
+						    (t2 (pathname-type n2)))
+						(or (component-lessp t1 t2)
+						    (and (component-equalp t1 t2)
+							 (component-lessp (pathname-version n1)
+									  (pathname-version n2))))))))))))))))))
+
+;;; null < string < number  [keywords don't figure]
+
+(defun component-lessp (x y)
+  (cond ((null x) (not (null y)))
+	((null y) nil)
+	((symbolp x) (and (symbolp y) (alphalessp x y)))
+	(t (and (numberp y) (< x y)))))
+
+;;; The following ought to do case-insensitive comparison!!
+
+(defun component-equalp (x y)
+  (or (equal x y)
+      (and (symbolp x) (symbolp y) (samepnamep x y))))
+
+;;; Pathname ITSification stuff: coercion between namelists & pathnames.
+
+(defun namelist->pathname (thing)
+  (let* ((thing (namelist thing))
+	 (v (de-its-ify-component (caddr thing) t)))
+    (hunk (status site)
+	  (de-its-ify-component (caar thing) nil)
+	  (de-its-ify-component (cadar thing) nil)
+	  (de-its-ify-component (cadr thing) nil)
+	  (if (versionp v) nil v)	;Check file attribute list?
+	  (if (versionp v) v nil)
+	  'pathname)))
+
+(defun de-its-ify-component (x numberp)
+  numberp   ;was useful once, I guess
+  (cond ((eq x '*) nil)
+	((null x) "NIL")
+	((not (symbolp x)) x)
+	((eq x '>) ':newest)
+	((eq x '<) ':oldest)
+	(t (string->version x))))
+
+(defun versionp (x)
+  (or (numberp x) (eq x ':newest) (eq x ':oldest)))
+
+(defvar *its-uninteresting-types*
+  '("TXT" "LSP" "LISP" "SCM" "" "txt" "lsp" "lisp" "scm" :unspecific))
+
+(defun pathname->namelist (pathname)
+  (let ((dev (pathname-device pathname))
+	(dir (pathname-directory pathname))
+	(name (pathname-name pathname))
+	(type (pathname-type pathname))
+	(version (pathname-version pathname)))
+    `((,(its-ify-component dev)
+       ,@(if (null (pathname-directory pathname))
+	     '()
+	     `(,(its-ify-component dir))))
+      ,(its-ify-component name)
+      ,(if (or (null type)
+	       (string-member type *its-uninteresting-types*))
+	   (its-ify-component version)
+           (its-ify-component type)))))
+
+(defun its-ify-component (x)
+  (cond ((null x) '*)
+	((eq x ':wild) '*)
+	((eq x ':newest) '>)
+	((eq x ':oldest) '<)
+	(t x)))
+
+(defun string-member (string string-list)
+  (do ((l string-list (cdr l)))
+      ((null l) nil)
+    (if (and (symbolp (car l)) (samepnamep string (car l)))
+	(return l))))
+
+(defun lisp:namestring (thing)
+  (stringicate (namestring (if (pathnamep thing)
+			       (pathname->namelist thing)
+			       thing))))
+
+;;; I/O routines
+
+(format nil "T")    ;Make sure FORMAT is loaded
+
+(defun probe-file (pathname)
+  (let* ((p (pathname pathname))
+	 (q (probef (pathname->namelist p))))
+    (and q (merge-pathnames q p nil))))
+
+;;; DIRECTORY: returns a list of pathnames for all local files
+;;; matching a given pattern.
+(defun lisp:directory (p)
+  (let ((p (pathname p)))
+    (cond ((and (not (eq (pathname-device    p) ':wild))
+		(not (eq (pathname-directory p) ':wild))
+		(not (eq (pathname-name	     p) ':wild))
+		(not (eq (pathname-type	     p) ':wild))
+		(not (eq (pathname-version   p) ':wild)))
+	   (let ((p (probe-file p)))
+	     (if p (list p) '())))
+	  (t
+	   (let* ((p (merge-pathnames p (pathname defaultf) nil))
+		  (p1 (cond ((eq (pathname-version p) ':newest)
+			     (make-pathname :version ':wild
+					    :defaults p))
+			    (t p)))
+		  (n (pathname->namelist p1))
+		  (foo (sort (mapcan #'(lambda (n)
+					 (let ((q (pathname n)))
+					   (if (pathname-matches-p q p)
+					       (list q)
+					     '())))
+				     (allfiles (list n)))
+			     #'pathname-lessp)))
+	     (cond ((eq (pathname-version p) ':newest)
+		    ;; Remove all but newest versions from list.
+		    (do ((l (reverse foo)
+			    (do ((ll l (cdr ll)))
+				((or (null ll)
+				     (not (equal-except-version (car l) (car ll))))
+				 ll)))
+			 (z '() (cons (car l) z)))
+			((null l) z)))
+		   (t foo)))))))
+
+(defun pathname-matches-p (p q)
+  (and (component-matches-p (pathname-host      p) (pathname-host q))
+       (component-matches-p (pathname-device    p) (pathname-device q))
+       (component-matches-p (pathname-directory p) (pathname-directory q))
+       (component-matches-p (pathname-name	p) (pathname-name q))
+       (component-matches-p (pathname-type	p) (pathname-type q))
+       (component-matches-p (pathname-version	p) (pathname-version q))))
+
+(defun component-matches-p (x y)
+  (or (null x)
+      (null y)
+      (eq y ':wild)
+      (and (numberp x) (memq y '(:newest :oldest)))
+      (component-equalp x y)))
+
+#+clutter-up-address-space
+(defun dir (x)   ;Test routine for above - arg should be upper case!
+  (mapc #'(lambda (p)
+	    (format t "~&~7@<~a:~> ~7@<~a;~> ~6a ~6a ~6d"
+		    (pathname-device p)
+		    (pathname-directory p)
+		    (pathname-name p)
+		    (or (pathname-type p) "")
+		    (or (pathname-version p) "")))
+	(directory (pathname x)))
+  '*)
+
+(defun equal-except-version (p q)
+  (and (component-equalp (pathname-host      p) (pathname-host q))
+       (component-equalp (pathname-device    p) (pathname-device q))
+       (component-equalp (pathname-directory p) (pathname-directory q))
+       (component-equalp (pathname-name	p) (pathname-name q))
+       (component-equalp (pathname-type	p) (pathname-type q))))
+
+;;; OPEN and other common-lispy file functions.
+
+(defconstant :direction ':direction)
+(defconstant :output	':output)
+(defconstant :input	':input)
+(defconstant :if-does-not-exist ':if-does-not-exist)
+(defconstant :if-exists ':if-exists)
+(defconstant :abort     ':abort)
+
+(defvar *open-output-files* '())  ;a-list of (<file> . <final-name>)
+
+;;; For opening files only!  And in image mode no less!
+;;; The only parameter combinations implemented are those needed for
+;;; KERMIT!
+
+(defun lisp:open (pathname &rest r)
+  (let-keyword-args ((direction :input)
+		     (if-does-not-exist 'unsupplied)
+		     (if-exists 'unsupplied))
+		    r
+    (let ((n (pathname->namelist (pathname pathname))))
+      (*catch 'fnf
+        (cond ((eq direction :input)
+	       (let ((io-lossage
+		      (if (null if-does-not-exist)
+			  #'(lambda ignore (*throw 'fnf nil))
+			  io-lossage)))
+		 (open n '(in image block))))
+	      (t
+	       (let* ((io-lossage
+		       (if (null if-exists)
+			   #'(lambda ignore (*throw 'fnf nil))
+			   io-lossage))
+		      (file (open (mergef '((* *) _kerm_ >) n)
+				  '(out image block))))
+		 (push (cons file n) *open-output-files*)
+		 file)))))))
+
+(defun lisp:close (stream &rest r)
+  (let-keyword-args ((abort nil)) r
+    (let ((probe (assq stream *open-output-files*)))
+      (cond ((not probe) (close stream))
+	    (t
+	     (setq *open-output-files* (delq probe *open-output-files*))
+	     (if abort
+		 (delete-file stream)
+		 (rename-file stream (cdr probe))))))))
+
+(defun rename-file (from to)
+  (renamef from (if (pathnamep to)
+		    (pathname->namelist to)
+		    to)))
+
+(defun delete-file (file)
+  (deletef (if (pathnamep file)
+	       (pathname->namelist file)
+	       file)))
+
+(defun make-broadcast-stream (&rest streams)
+  (apply #'append
+	 (mapcar #'(lambda (stream)
+		     (if (atom stream) (list stream) stream))
+		 streams)))
+
+(defsubst end-of-file-p (c)     ;Called only on value of +TYI
+  ;; ITS end-of-file
+  (or (< c 0)
+      (let ()
+	(declare (special *image?*))
+	(and (not *image?*) (= c 3)))))
+
+;;; That's all, folks
+
+(setf (get 'common 'loadedp) t)
+
+;;; Local Modes:
+;;; Lisp let-keyword-args Indent:2
+;;; End:
diff --git a/src/math/kermit.170 b/src/math/kermit.170
new file mode 100755
index 00000000..f89245cc
--- /dev/null
+++ b/src/math/kermit.170
@@ -0,0 +1,1140 @@
+;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: (KERMIT LISP) -*-
+
+;;; Common Lisp KERMIT
+
+;;; Authorship Information:
+;;;    Mark David (LMI)           Original version, using KERMIT.C as a guide
+;;;    George Carrette (LMI)      Various enhancements
+;;;    Mark Ahlstrom (Honeywell)  Port to 3600 (edits marked with ";1;")
+;;;    Jonathan Rees (MIT)	  Major total rewrite for Maclisp/Common Lisp
+
+;;; Don't make any attempt to understand this code without having access
+;;; to the Kermit Protocol Manual, Frank Da Cruz, Columbia University,
+;;; 5th edition.
+
+;;; This code is written in Common Lisp, but will run in Maclisp given
+;;; a Common Lisp compatibility mode (see AI: MATH; COMMON >).  To
+;;; port to an arbitrary CL implementation, one must supply
+;;; appropriate low-level primitives for doing read-with-timeout and
+;;; no-echo terminal I/O.
+
+;;; I think the main thing making it not yet usable outside of Maclisp
+;;; is that it doesn't convert CR/LF into NEWLINE on the way in and out.
+
+;;;+ Bugs
+;;; What to do about the control-C's at the end of ITS files?
+;;; There's apparently no way to distinguish them from legitimate control-C's.
+;;; Right now they're interpreted exactly the same as end of file.
+;;;
+;;; The receive packet size rightly ought to be about 93 or so, but
+;;; for some reason can't RECEIVE packets bigger than about 64 bytes.
+;;; For the life of me I can't figure out why.  Debug this some day.
+;;;  [And due to a bug in Kermit-9000, I have set the packet size down
+;;;  to 50 (probably should be 32) to try to make SURE...]
+
+;;; The low level 3600 hacks are undebugged!!
+;;;-
+
+#+Maclisp
+(EVAL-WHEN (EVAL LOAD COMPILE)
+  (OR (GET 'COMMON 'LOADEDP) (LOAD '((DSK MATH) COMMON))))
+
+(IN-PACKAGE 'KERMIT :USE '(LISP))
+
+(SHADOW '(LOG))
+
+(EXPORT '(SERVE
+	  SET-LINE
+	  GET-FILE
+	  SEND-FILE
+	  FINISH
+	  BYE))
+
+(DEFVAR *KERMIT-VERSION*
+	#+Maclisp   (STATUS OPSYS)
+	#+Symbolics "Symbolics"
+	#-(or Maclisp Symbolics) (LISP-IMPLEMENTATION-TYPE))
+
+#+Maclisp
+(PROGN 'COMPILE
+  (DECLARE (*LEXPR SEND-ERROR-PACKET INIT-SERIAL-I/O))
+  (DECLARE (FIXNUM (SERIAL-WRITE-CHAR FIXNUM))
+	   (FIXNUM (SERIAL-READ-CHAR))))
+
+;;; Fundamental constants
+(DEFCONSTANT *SOH*     (CODE-CHAR 1)    "start of header")
+(DEFCONSTANT *MAX-PACKET-SIZE* (- 128. 32.) "maximum packet size")
+
+;;; The following three values merely need to answer true to FAILP
+;;; and not be legal packet types.
+(DEFCONSTANT *TIMED-OUT*       (CODE-CHAR 2))
+(DEFCONSTANT *LENGTH-ERROR*    (CODE-CHAR 3))
+(DEFCONSTANT *CHECKSUM-ERROR*  (CODE-CHAR 4))
+(DEFCONSTANT *BOGUS-CHARACTER* (CODE-CHAR 5))
+
+;;; If you want Kermit to be re-entrant you'll have to specbind everything
+;;; from here on down, excpting the state machine variables which are
+;;; bound by RUN-STATE-MACHINE.
+
+;;; Global parameters, user-adjustable
+(DEFVAR *IMAGE?*          NIL "T means 8-bit mode")
+(DEFVAR *DEBUG?*	  NIL "T means supply debugging info as you run")
+(DEFVAR *VERSION-NUMBERS?* NIL "T means include version numbers in file names")
+(DEFVAR *MAX-RETRY-COUNT* 10. "times to retry a packet")
+(DEFVAR *MIN-TIMEOUT*	  2   "minimum timeout interval in seconds")
+(DEFVAR *SERVER-TIMEOUT*  30  "timeout interval when in server mode")
+(DEFVAR *SERIAL-INPUT*	  NIL "input stream for serial line")
+(DEFVAR *SERIAL-OUTPUT*	  NIL "output stream for serial line")
+(DEFVAR *COMMENTARY-STREAM* *TERMINAL-IO* "stream for messages to user")
+(DEFVAR *LOG*		  NIL "log file")
+
+;;; Packet reception parameters (see KPM page 26):
+(DEFVAR *RECEIVE-PACKET-SIZE* 50 "maximum packet size")  ;see bug remark, above
+(DEFVAR *MY-TIMEOUT*  10       "seconds after which I time out")
+(DEFVAR *MY-PAD*      0        "number of padding characters I need")
+(DEFVAR *MY-PAD-CHAR* #\SPACE  "char I want as a padding char")
+(DEFVAR *MY-EOL*      #\RETURN "my kind of return char")
+(DEFVAR *MY-QUOTE*    #\#      "my quote character")
+
+;;; Packet transmission parameters:
+(DEFVAR *SEND-PACKET-SIZE* 80 "maximum send packet size")	;MAXL
+(DEFVAR *TIMEOUT*  15       "timeout for remote host on sends")	;TIME
+(DEFVAR *PAD*	   0        "how much padding to send")		;NPAD
+(DEFVAR *PAD-CHAR* #\SPACE  "padding character to send")	;PADC
+(DEFVAR *EOL*	   #\RETURN "end-of-line character to send")	;EOL
+(DEFVAR *QUOTE*	   #\#      "quote character in outgoing data")	;QCTL
+
+;;; Packet buffers, globally allocated for no very good reason
+(DEFPARAMETER *RECEIVE-PACKET*
+  (MAKE-ARRAY *MAX-PACKET-SIZE* :ELEMENT-TYPE 'STRING-CHAR :FILL-POINTER 0)
+  "receive packet buffer")
+
+(DEFPARAMETER *SEND-PACKET*
+  (MAKE-ARRAY *MAX-PACKET-SIZE* :ELEMENT-TYPE 'STRING-CHAR :FILL-POINTER 0)
+  "send packet buffer")
+
+;;; State machine variables, bound by RUN-STATE-MACHINE
+(DEFVAR *SERVER-MODE*     NIL "true if in server mode")
+(DEFVAR *FILES-TO-SEND*   '() "list of source/dest filename pairs")
+(DEFVAR *COMMAND*         NIL "generic or other command to execute")
+(DEFVAR *SEQUENCE-NUMBER* 0   "the packet number")
+(DEFVAR *RETRY-COUNT*     0   "times this packet retried")
+(DEFVAR *STREAM*	  NIL "file pointer for current disk file")
+(DEFVAR *DISCARD*	  NIL "T if current file is to be discarded")
+
+
+;;; Utility routines & macros
+
+#-(OR Maclisp Symbolics)  ;COMMON > defines this for Maclisp
+(DEFMACRO DEFSUBST (NAME ARGS &BODY BODY)
+  `(PROGN 'COMPILE
+	  (DEFUN ,NAME ,ARGS ,@BODY)
+	  (PROCLAIM '(INLINE ,NAME))))
+
+#+Symbolics
+(DEFMACRO DEFSUBST (NAME ARGS &BODY BODY)
+  `(SCL:DEFSUBST ,NAME ,ARGS ,@BODY))
+
+#-Maclisp
+(PROGN 'COMPILE
+
+(DEFSUBST STRING-ELT (S I)   ;Not the same as CHAR!
+  (AREF (THE STRING S) I))
+
+(DEFSUBST SET-STRING-ELT (S I C)
+  (SETF (AREF (THE STRING S) I) C))
+
+(DEFMACRO UNKLUDGIFY-STRING (S)
+  S)
+
+(DEFUN QUIT () NIL)
+)  ;psilcaM-#
+
+
+(DEFMACRO MESSAGE (&REST CRUFT)
+  `(IF (OR (NOT *SERVER-MODE*) *DEBUG?* *LOG*)
+       (FORMAT *COMMENTARY-STREAM* ,@CRUFT)))
+
+(DEFMACRO DEBUG-MESSAGE (&REST CRUFT)
+  `(IF *DEBUG?*
+       (FORMAT *DEBUG-IO* ,@CRUFT)))
+
+(DEFMACRO STRING-APPEND (&REST STRINGS)
+  `(CONCATENATE 'STRING ,@STRINGS))
+
+#-Maclisp
+(PROGN 'COMPILE
+;;; Character-set-independent ASCII character conversion
+
+(DEFPARAMETER ASCII-CHARS
+  (CONCATENATE 'VECTOR
+	       '(#\NULL)
+	       (MAKE-LIST 7)
+	       '(#\BACKSPACE #\TAB #\NEWLINE NIL #\PAGE #\RETURN)
+	       (MAKE-LIST 18)
+	       " !\"#$%&'()*+,-./0123456789:;<=>?"
+	       "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"
+	       "`abcdefghijklmnopqrstuvwxyz{|}~"
+	       '(#\RUBOUT)))
+
+(DEFUN ASCII->CHAR (N)
+  (OR (SVREF ASCII-CHARS N)
+      (CODE-CHAR N)))
+
+(DEFPARAMETER NATIVE-CHARS
+  (LET ((TABLE (MAKE-HASH-TABLE :TEST 'EQUAL :SIZE 128))
+	(LEAST     10000000)
+	(GREATEST -10000000))
+    (DO ((I 0 (+ I 1)))
+	((>= I (LENGTH ASCII-CHARS))
+	 (LET ((V (MAKE-ARRAY (+ (- GREATEST LEAST) 1))))
+	   (DO ((I LEAST (+ I 1)))
+	       ((> I GREATEST) (CONS LEAST V))
+	     (SETF (SVREF V (- I LEAST)) (GETHASH I TABLE)))))
+      (LET ((CH (SVREF ASCII-CHARS I)))
+	(WHEN CH
+	  (LET ((CODE (CHAR-CODE CH)))
+	    (SETQ LEAST    (MIN LEAST    CODE))
+	    (SETQ GREATEST (MAX GREATEST CODE))
+	    (SETF (GETHASH CODE TABLE) I)))))))
+
+(DEFUN CHAR->ASCII (CHAR)
+  (LET ((INDEX (- (CHAR-CODE CHAR) (CAR NATIVE-CHARS))))
+    (IF (OR (< INDEX 0)
+	    (>= INDEX (LENGTH (CDR NATIVE-CHARS))))
+	(CHAR-CODE CHAR)
+	(OR (SVREF (CDR NATIVE-CHARS) INDEX)
+	    (CHAR-CODE CHAR)))))
+)
+
+#+Maclisp
+(PROGN 'COMPILE
+(DEFMACRO CHAR->ASCII (C) C)
+(DEFMACRO ASCII->CHAR (N) N)
+)
+
+;;; INTEGER->GRAPHIC: converts a number to a graphic character by adding
+;;;   32 and deasciizing.
+;;; GRAPHIC->INTEGER: undoes INTEGER->GRAPHIC.
+;;; CTL: converts between control characters and printable characters by
+;;;   toggling the control bit (i.e. ^a becomes a and a becomes ^a).
+
+(DEFSUBST INTEGER->GRAPHIC (N)
+  (ASCII->CHAR (+ N 32.)))
+
+(DEFSUBST GRAPHIC->INTEGER (CH)
+  (- (CHAR->ASCII CH) 32.))
+
+(DEFSUBST CTL (CH)
+  (ASCII->CHAR (LOGXOR (CHAR->ASCII CH) #o100)))
+
+(DEFSUBST COMPUTE-FINAL-CHECKSUM (CHKSUM)
+  (LOGAND (+ (ASH (LOGAND CHKSUM #o0300) -6) CHKSUM) #o077))
+
+;;; ACKP, NACKP, ERRP, FAILP
+;;; Predicates applied to packet type returned by RECEIVE-PACKET:
+;;; an ACK (Y), a NACK (N), an error message (E), or a failed
+;;; packet transmission (timeout, bad checksum, or illegal length).
+
+(DEFSUBST ACKP (TYPE)
+  (CHAR= TYPE #\Y))
+
+(DEFSUBST NACKP (TYPE)
+  (CHAR= TYPE #\N))
+
+(DEFSUBST ERRP (TYPE)
+  (CHAR= TYPE #\E))
+
+(DEFSUBST FAILP (TYPE)
+  (CHAR< TYPE #\SPACE))
+
+;;; Top-level entry routines
+
+;;; Specify a terminal line [e.g. (SET-LINE "TTA1:")]:
+
+(DEFUN SET-LINE (LINE)
+  (INIT-SERIAL-I/O LINE))
+
+;;; Server mode:
+
+(DEFUN SERVE ()				;See LIBDOC; TTY >
+  (FORMAT *COMMENTARY-STREAM*
+	  "~&Entering KERMIT server mode.~
+	   ~%Control-G throws to Lisp top level, (SERVE) starts serving again.~%")
+  ;; Kludge!!!  Logging isn't done right at all.  Ought to use broadcast stream
+  ;; so that logging works even when not in server mode.
+  (IF *LOG*
+      (FORMAT *LOG* "~2&----- Entering server mode -----~&"))
+  (UNWIND-PROTECT
+    (LET ((*COMMENTARY-STREAM* (OR *LOG* *COMMENTARY-STREAM*))
+	  (*DEBUG-IO* (OR *LOG* *DEBUG-IO*)))
+      (LET ((STATUS (RUN-STATE-MACHINE #'RECEIVE-SERVER-IDLE T '() NIL)))
+	(IF (EQ STATUS 'LOGOUT) (QUIT) STATUS)))
+    (IF *LOG* (FORMAT *LOG* "~&----- Leaving server mode -----~&"))))
+
+;;; Send a file:
+
+(DEFUN SEND-FILE (LOCAL-FILESPEC &OPTIONAL REMOTE-FILESPEC)
+  (LET ((XFER-LIST (MAKE-TRANSFER-LIST LOCAL-FILESPEC REMOTE-FILESPEC)))
+    (COND ((NULL XFER-LIST)
+	   (MESSAGE "~&No files match this specification: ~S" LOCAL-FILESPEC))
+	  (T
+	   (RUN-STATE-MACHINE #'SEND-INIT NIL XFER-LIST NIL)))))
+
+;;; Get a file:
+
+(DEFUN GET-FILE (REMOTE-SPEC &OPTIONAL LOCAL-SPEC)
+  (RUN-STATE-MACHINE #'SEND-MISC
+		     NIL
+		     '()
+		     `(GET ,REMOTE-SPEC ,LOCAL-SPEC)))
+
+;;; Receive file: useless, but included for completeness.
+
+(DEFUN RECEIVE-FILE (&OPTIONAL LOCAL-SPEC)
+  (RUN-STATE-MACHINE #'RECEIVE-INIT
+		     NIL
+		     '()
+		     `(GET NIL ,LOCAL-SPEC)))
+
+;;; Tell remote server to go away:
+
+(DEFUN FINISH ()
+  (RUN-STATE-MACHINE #'SEND-MISC NIL '() '(FINISH)))
+
+(DEFUN BYE ()
+  (RUN-STATE-MACHINE #'SEND-MISC NIL '() '(BYE)))
+
+(DEFUN LOG (&OPTIONAL PATH)
+  (COND ((NULL PATH)
+	 (COND ((NULL *LOG*)
+		(FORMAT T "~&There is no log file to close."))
+	       (T
+		(FORMAT T "~&Closing log file ~s" (TRUENAME *LOG*))
+		(LISP:CLOSE *LOG*)
+		(SETQ *LOG* NIL))))
+	((NULL *LOG*)
+	 (SETQ *LOG* (LISP:OPEN PATH :DIRECTION :OUTPUT))
+	 (FORMAT T "~&Logging on ~s" (TRUENAME *LOG*)))))
+
+;;; The KERMIT state machine
+
+(DEFUN RUN-STATE-MACHINE (STATE *SERVER-MODE*
+				*FILES-TO-SEND*
+				*COMMAND*)
+  (IF (NULL *SERIAL-INPUT*) (INIT-SERIAL-I/O))
+  (LET ((TEMP (SERIAL-STATE)))
+    (UNWIND-PROTECT
+      (PROGN (DISABLE-ECHOING TEMP)
+	     (FLUSH-INPUT)
+	     (LISP:CATCH 'DONE
+	       (DO ()
+		   (NIL)
+		 (LISP:CATCH 'ABORT
+		   (UNWIND-PROTECT
+		     (LET ((*SEQUENCE-NUMBER* 0)
+			   (*RETRY-COUNT* 0)
+			   (*DISCARD* NIL)
+			   (*TIMEOUT* *TIMEOUT*))
+		       (DO ((STATE STATE (FUNCALL STATE)))
+			   (NIL)
+			 ;; (DEBUG-MESSAGE "~&State = ~S~&" STATE)
+			 ))
+		     (COND (*STREAM*
+			    (LISP:CLOSE *STREAM* :ABORT T)
+			    (SETQ *STREAM* NIL)))))
+		 (IF (NOT *SERVER-MODE*) (RETURN 'ABORTED)))))
+      (SET-SERIAL-STATE TEMP))))
+
+(DEFMACRO DEFSTATE (NAME &REST BODY)
+  `(DEFUN ,NAME () ,@BODY))
+
+;(DEFMACRO GOTO-STATE (STATE)
+;  `#',STATE)
+(defmacro goto-state (state)
+  `(%goto-state #',state))
+(defun %goto-state (state)
+  (if (null state) (error "null state") state))
+
+(DEFUN ABORT ()
+  (DEBUG-MESSAGE "~&Aborting.")
+  (LISP:THROW 'ABORT NIL))
+
+(DEFUN COMPLETE ()
+  (IF *SERVER-MODE*
+      (GOTO-STATE RECEIVE-SERVER-IDLE)
+      (LISP:THROW 'DONE 'COMPLETE)))
+
+(DEFSUBST NEXT-SEQUENCE-NUMBER ()
+  (LOGAND (1+ *SEQUENCE-NUMBER*) #o77))
+
+(DEFSUBST PREVIOUS-SEQUENCE-NUMBER ()
+  (LOGAND (+ *SEQUENCE-NUMBER* #o77) #o77))
+
+(DEFUN BUMP-SEQUENCE-NUMBER ()
+  (SETQ *SEQUENCE-NUMBER* (NEXT-SEQUENCE-NUMBER))
+  (SETQ *RETRY-COUNT* 0))
+
+(DEFUN BUMP-RETRY-COUNT ()
+  (INCF *RETRY-COUNT*)
+  (COND ((> *RETRY-COUNT* *MAX-RETRY-COUNT*)
+	 (SEND-ERROR-PACKET "aborting after ~D retries" *MAX-RETRY-COUNT*)
+	 (ABORT))))
+
+;;; Rec_Server_Idle -- Server idle, waiting for a message
+
+(DEFSTATE RECEIVE-SERVER-IDLE
+  (SETQ *SEQUENCE-NUMBER* 0)
+  (SETQ *TIMEOUT* *SERVER-TIMEOUT*)  ;will get reset later
+  (MULTIPLE-VALUE-BIND (TYPE NUM DATA)
+		       (RECEIVE-PACKET)
+    (COND ((FAILP TYPE)
+	   (SEND-NACK 0)
+	   (GOTO-STATE RECEIVE-SERVER-IDLE))
+	  ((ERRP TYPE)
+	   ;; Error has already been reported, so don't worry about it.
+	   (GOTO-STATE RECEIVE-SERVER-IDLE))
+	  ((NOT (= NUM 0))
+	   (SEND-ERROR-PACKET "bad sequence number - ~S" NUM)
+	   (GOTO-STATE RECEIVE-SERVER-IDLE))
+	  ((CHAR= TYPE #\I)
+	   ;; Initialize & send ACK
+	   (INITIALIZE-PARAMETERS DATA)
+	   (GOTO-STATE RECEIVE-SERVER-IDLE))
+	  ((CHAR= TYPE #\S)
+	   ;; Remote host wants to send a file; we should prepare to receive.
+	   (INITIALIZE-PARAMETERS DATA)
+	   (BUMP-SEQUENCE-NUMBER)
+	   (SETQ *COMMAND* '(GET NIL NIL))
+	   (GOTO-STATE RECEIVE-FILE-HEADER))
+	  ((CHAR= TYPE #\R)
+	   ;; Remote host wants to receive a file, i.e. we should send it.
+	   (SETQ *FILES-TO-SEND*
+		 (MAKE-TRANSFER-LIST (UNKLUDGIFY-STRING DATA) NIL))
+	   (COND ((NULL *FILES-TO-SEND*)
+		  (SEND-ERROR-PACKET "no files matching this specification")
+		  (GOTO-STATE RECEIVE-SERVER-IDLE))
+		 (T
+		  (DEBUG-MESSAGE "~&Files to send: ~S" *FILES-TO-SEND*)
+		  (GOTO-STATE SEND-INIT))))
+	  ((CHAR= TYPE #\G)
+	   (COND ((< (LISP:LENGTH DATA) 1)
+		  (SEND-ERROR-PACKET "ill-formed generic command packet")
+		  (GOTO-STATE RECEIVE-SERVER-IDLE))
+		 (T
+		  (PERFORM-GENERIC-COMMAND DATA))))
+	  (T
+	   (SEND-ERROR-PACKET "unimplemented server command - ~C" TYPE)
+	   (GOTO-STATE RECEIVE-SERVER-IDLE)))))
+
+(DEFUN PERFORM-GENERIC-COMMAND (DATA)
+  (CASE (STRING-ELT DATA 0)
+    ((#\F)				;Finished
+     (SEND-ACK *SEQUENCE-NUMBER*)
+     (LISP:THROW 'DONE 'FINISHED))
+    ((#\L)				;Logout
+     (SEND-ACK *SEQUENCE-NUMBER*)
+     (LISP:THROW 'DONE 'LOGOUT))
+    ((#\C)				;Change working directory
+     ;; Data looks something like
+     ;;   C$directory#password  (I think)
+     ;; where $ is the length of the directory name (! = 1, etc.)
+     ;; and # is the length of the password.
+     ;; This has only been tested with Kermit-32 (on VMS), and I haven't
+     ;; checked the protocol manual to see what's really supposed to
+     ;; happen.  -- JAR 3 March 1988
+     (IF (> (LISP:LENGTH DATA) 3)
+	 (LET ((END (MIN (LISP:LENGTH DATA)
+			 (+ 2 (GRAPHIC->INTEGER (AREF DATA 1))))))
+	   (DO ((I 2 (1+ I))
+		(L '() (CONS (AREF DATA I) L)))
+	       ((>= I END)
+		(LET ((DIR (COERCE (REVERSE L) 'STRING)))
+		  (MESSAGE "~&Directory ~S" DIR)
+		  (SETQ *DEFAULT-PATHNAME-DEFAULTS* (PATHNAME DIR))
+		  (SEND-ACK 0)))))
+	 (SEND-ERROR-PACKET "missing directory name or ill-formed packet - ~A"
+			    (UNKLUDGIFY-STRING DATA)))
+     (GOTO-STATE RECEIVE-SERVER-IDLE))
+    ;; Unimplemented: Directory, diskUsage,
+    ;; dEletefile, Type, Rename, Kopy, Whoisloggedin,
+    ;; sendMessage, runProgram, Journal, Variable
+    (T
+     (SEND-ERROR-PACKET "unimplemented generic command - ~A"
+			(UNKLUDGIFY-STRING DATA))
+     (GOTO-STATE RECEIVE-SERVER-IDLE))))
+
+;;; Rec_Init - entry point for non-server RECEIVE command (pretty useless)
+;;; *COMMAND* should be (GET remote local)
+
+(DEFSTATE RECEIVE-INIT
+  (SETQ *SEQUENCE-NUMBER* 0)
+  (MULTIPLE-VALUE-BIND (TYPE NUM DATA)
+		       (RECEIVE-PACKET)
+    (COND ((AND (CHAR= TYPE #\S) (= NUM 0))
+	   (INITIALIZE-PARAMETERS DATA)
+	   (BUMP-SEQUENCE-NUMBER)
+	   (GOTO-STATE RECEIVE-FILE-HEADER))
+	  ((FAILP TYPE)
+	   (SEND-NACK 0)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE RECEIVE-INIT))
+	  (T
+	   (SEND-NACK 0)
+	   (ABORT)))))
+
+;;; Rec_File -- look for a file header or EOT message
+;;; *COMMAND* should be (GET remote local)
+
+(DEFSTATE RECEIVE-FILE-HEADER
+  (MULTIPLE-VALUE-BIND (TYPE NUM PACKET)
+		       (RECEIVE-PACKET)
+    (COND ((AND (CHAR= TYPE #\F) (= NUM *SEQUENCE-NUMBER*))
+	   ;; File header; ignore it if a local name was specified.
+	   (LET* ((REMOTE (UNKLUDGIFY-STRING PACKET))
+		  (LOCAL (OR (CADDR *COMMAND*) (CADR *COMMAND*)))
+		  (LOCAL (IF LOCAL
+			     (MERGE-PATHNAMES (FLUSH-WILDCARDS LOCAL) REMOTE)
+			     REMOTE)))
+	     (COND ((SETQ *STREAM* (MAYBE-OPEN-FOR-OUTPUT LOCAL))
+		    (MESSAGE "~&Receiving ~A as ~A"
+			     REMOTE
+			     (LISP:NAMESTRING LOCAL))
+		    (SEND-ACK NUM)
+		    (BUMP-SEQUENCE-NUMBER)
+		    (GOTO-STATE RECEIVE-DATA))
+		   (T
+		    (MESSAGE "~&Can't create ~S" LOCAL)
+		    (SEND-ERROR-PACKET "Can't create ~S" LOCAL)
+		    (ABORT)))))
+	  ((AND (CHAR= TYPE #\B) (= NUM *SEQUENCE-NUMBER*))
+	   ;; End of transmission
+	   (SEND-ACK NUM)
+	   (COMPLETE))
+	  ((AND (CHAR= TYPE #\S) (= NUM (PREVIOUS-SEQUENCE-NUMBER)))
+	   ;; Send init
+	   (SEND-PARAMETERS #\Y NUM)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE RECEIVE-FILE-HEADER))
+	  ((AND (CHAR= TYPE #\Z) (= NUM (PREVIOUS-SEQUENCE-NUMBER)))
+	   ;; End of file
+	   (SEND-ACK NUM)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE RECEIVE-FILE-HEADER))
+	  ((FAILP TYPE)
+	   ;; Timeout
+	   (SEND-NACK *SEQUENCE-NUMBER*)
+	   (GOTO-STATE RECEIVE-FILE-HEADER))
+	  (T
+	   (SEND-ERROR-PACKET "error receiving file header")
+	   (ABORT)))))
+
+;;; Rec_Data - Receive data up to end of file
+
+(DEFSTATE RECEIVE-DATA
+  (MULTIPLE-VALUE-BIND (TYPE NUM DATA)
+		       (RECEIVE-PACKET)
+    (COND ((AND (CHAR= TYPE #\D) (= NUM *SEQUENCE-NUMBER*))
+	   (EMPTY-BUFFER DATA)
+	   (SEND-ACK NUM)
+	   (BUMP-SEQUENCE-NUMBER)
+	   (GOTO-STATE RECEIVE-DATA))
+	  ((AND (OR (CHAR= TYPE #\D) (CHAR= TYPE #\F))
+		(= NUM (PREVIOUS-SEQUENCE-NUMBER)))
+	   (SEND-ACK NUM)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE RECEIVE-DATA))
+	  ((AND (CHAR= TYPE #\Z) (= NUM *SEQUENCE-NUMBER*))
+	   (LET (#+Maclisp
+		 (IO-LOSSAGE #'(LAMBDA IGNORE
+				       (SEND-ERROR-PACKET "error closing file")
+				       (ABORT))))
+	     (COND ((OR (< (LISP:LENGTH DATA) 1)
+			(NOT (CHAR= (STRING-ELT DATA 0) #\D)))
+		    (MESSAGE "~&File received successfully: ~A"
+			     (LISP:NAMESTRING *STREAM*))
+		    (LISP:CLOSE *STREAM*))
+		   (T
+		    ;; Discard
+		    (MESSAGE "~&File discarded: ~A"
+			     (LISP:NAMESTRING *STREAM*))
+		    (LISP:CLOSE *STREAM* :ABORT T)))
+	     (SEND-ACK NUM)
+	     (SETQ *STREAM* NIL)
+	     (BUMP-SEQUENCE-NUMBER)
+	     (GOTO-STATE RECEIVE-FILE-HEADER)))
+	  ((FAILP TYPE)
+	   (SEND-NACK *SEQUENCE-NUMBER*)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE RECEIVE-DATA))
+	  (T
+	   (IF (NOT (ERRP TYPE))
+	       (SEND-ERROR-PACKET "error during data reception"))
+	   (ABORT)))))
+
+
+;;; Send_Init - entry for SEND command (or remote kermit's GET)
+
+(DEFSTATE SEND-INIT
+  (SETQ *SEQUENCE-NUMBER* 0)
+  (SEND-PARAMETERS #\S 0)
+  (MULTIPLE-VALUE-BIND (REPLY NUM PACKET)
+		       (RECEIVE-PACKET)
+    (COND ((AND (ACKP REPLY) (= *SEQUENCE-NUMBER* NUM))
+	   (DECODE-PARAMETERS PACKET)	      ;Check and set defaults
+	   (BUMP-SEQUENCE-NUMBER)
+	   (GOTO-STATE OPEN-FILE))
+	  ((ERRP REPLY)
+	   (ABORT))
+	  (T
+	   (GOTO-STATE SEND-INIT)))))
+
+;;; Open_File 
+
+(DEFSTATE OPEN-FILE
+  (COND ((NULL *FILES-TO-SEND*)
+	 (GOTO-STATE SEND-BREAK))
+	(T
+	 (LET ((LOCAL-FILENAME (CAAR *FILES-TO-SEND*)))
+	   (COND ((NOT (SETQ *STREAM* (MAYBE-OPEN-FOR-INPUT LOCAL-FILENAME)))
+		  ;; This ain't right, but what's to do for it??
+		  (MESSAGE "~&Can't open file ~A" LOCAL-FILENAME)
+		  (POP *FILES-TO-SEND*)
+		  (SETQ *DISCARD* T)
+		  (GOTO-STATE SEND-EOF))
+		 (T
+		  (GOTO-STATE SEND-FILE-HEADER)))))))
+
+;;; Send_File
+
+(DEFUN NORMAL-ACKP (TYPE NUM)
+  (OR (AND (ACKP TYPE) (= NUM *SEQUENCE-NUMBER*))
+      (AND (NACKP TYPE) (= NUM (NEXT-SEQUENCE-NUMBER)))))
+
+(DEFUN NORMAL-NACKP (TYPE)
+  (OR (FAILP TYPE)
+      (NACKP TYPE)))
+
+(DEFSTATE SEND-FILE-HEADER
+  (SEND-PACKET #\F *SEQUENCE-NUMBER*
+	       (KERMITIFY-PATHNAME (CDAR *FILES-TO-SEND*)
+				   *VERSION-NUMBERS?*))
+  (MULTIPLE-VALUE-BIND (REPLY NUM IGNORE)
+		       (RECEIVE-PACKET)
+    IGNORE
+    (COND ((NORMAL-ACKP REPLY NUM)
+	   (BUMP-SEQUENCE-NUMBER)
+	   (GOTO-STATE SEND-DATA))
+	  ((NORMAL-NACKP REPLY)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE SEND-FILE-HEADER))
+	  (T
+	   (IF (NOT (ERRP REPLY))
+	       (SEND-ERROR-PACKET "error sending file header"))
+	   (ABORT)))))
+
+;;; Send_Data -- Send contents of file
+
+(DEFSTATE SEND-DATA
+  (IF (= *RETRY-COUNT* 0)
+      (FILL-BUFFER *SEND-PACKET*))
+  (COND ((= (LISP:LENGTH *SEND-PACKET*) 0)
+	 (GOTO-STATE SEND-EOF))
+	(T
+	 (SEND-PACKET #\D *SEQUENCE-NUMBER* *SEND-PACKET*)
+	 (MULTIPLE-VALUE-BIND (REPLY NUM PACKET)
+			      (RECEIVE-PACKET)
+	   (COND ((NORMAL-ACKP REPLY NUM)
+		  (BUMP-SEQUENCE-NUMBER)
+		  (COND ((AND (> (LISP:LENGTH PACKET) 0)
+			      (OR (CHAR= (STRING-ELT PACKET 0) #\X)
+				  (CHAR= (STRING-ELT PACKET 0) #\Z)))
+			 (SETQ *DISCARD* T)
+			 (GOTO-STATE SEND-EOF))
+			(T
+			 (GOTO-STATE SEND-DATA))))
+		 ((NORMAL-NACKP REPLY)
+		  (BUMP-RETRY-COUNT)
+		  (GOTO-STATE SEND-DATA))
+		 (T
+		  (IF (NOT (ERRP REPLY))
+		      (SEND-ERROR-PACKET "error during data transmission"))
+		  (ABORT)))))))
+
+;;; Send_EOF -- Send end of file indicator
+
+(DEFSTATE SEND-EOF
+  (SEND-PACKET #\Z *SEQUENCE-NUMBER* (IF *DISCARD* "Z" NIL))
+  (MULTIPLE-VALUE-BIND (REPLY NUM IGNORE)
+		       (RECEIVE-PACKET)
+    IGNORE
+    (COND ((NORMAL-ACKP REPLY NUM)
+	   (MESSAGE "~&File sent successfully: ~A~%"
+		    (TRUENAME *STREAM*))
+	   (CLOSE *STREAM*)
+	   (SETQ *STREAM* NIL)
+	   (POP *FILES-TO-SEND*)
+	   (BUMP-SEQUENCE-NUMBER)
+	   (SETQ *DISCARD* NIL)
+	   (GOTO-STATE OPEN-FILE))
+	  ((NORMAL-NACKP REPLY)
+	   (GOTO-STATE SEND-EOF))
+	  (T
+	   (SETQ *DISCARD* NIL)
+	   (IF (NOT (ERRP REPLY))
+	       (SEND-ERROR-PACKET "error during EOF transmission"))
+	   (ABORT)))))
+
+;;; Send_Break - End of transaction
+
+(DEFSTATE SEND-BREAK
+  (SEND-PACKET #\B *SEQUENCE-NUMBER* NIL)
+  (MULTIPLE-VALUE-BIND (REPLY NUM IGNORE)
+		       (RECEIVE-PACKET)
+    IGNORE
+    (COND ((OR (AND (ACKP REPLY) (= NUM *SEQUENCE-NUMBER*))
+	       (AND (NACKP REPLY) (= NUM 0)))
+	   (COMPLETE))
+	  ((OR (AND (NACKP REPLY) (= NUM *SEQUENCE-NUMBER*))
+	       (FAILP REPLY))
+	   (GOTO-STATE SEND-BREAK))
+	  (T
+	   (IF (NOT (ERRP REPLY))
+	       (SEND-ERROR-PACKET "error during break transmission"))
+	   (ABORT)))))
+
+;;; Send_Gen_Cmd - Command to server
+
+(DEFSTATE SEND-MISC
+  (CASE (CAR *COMMAND*)
+    ((FINISH) (SEND-PACKET #\G 0 "F"))
+    ((LOGOUT) (SEND-PACKET #\G 0 "L"))
+    ((GET)
+     (SEND-PACKET #\R 0 (KERMITIFY-PATHNAME (CADR *COMMAND*)
+					    *VERSION-NUMBERS?*)))
+    (OTHERWISE (ERROR "weird command in SEND-MISC" *COMMAND* 'FAIL-ACT)))
+  (MULTIPLE-VALUE-BIND (TYPE NUM DATA)
+		       (RECEIVE-PACKET)
+    (COND ((AND (ACKP TYPE) (= NUM 0))
+	   (MESSAGE "~&OK")
+	   (COMPLETE))
+	  ((AND (CHAR= TYPE #\S) (= NUM 0) (>= (LISP:LENGTH DATA) 6))
+	   (DECODE-PARAMETERS DATA)
+	   (SEND-PARAMETERS #\Y 0)
+	   (BUMP-SEQUENCE-NUMBER)
+	   (GOTO-STATE RECEIVE-FILE-HEADER))
+	  ((NORMAL-NACKP TYPE)
+	   (BUMP-RETRY-COUNT)
+	   (GOTO-STATE SEND-MISC))
+	  (T
+	   (IF (NOT (ERRP TYPE))
+	       (SEND-ERROR-PACKET "error during command transmission"))
+	   (ABORT)))))
+
+;;; Packet sending and receiving
+
+(DEFUN SEND-ERROR-PACKET (&REST CRUFT)
+  (LET* ((FROB (LISP:APPLY #'FORMAT NIL CRUFT))
+	 (FROB (FORMAT NIL "Kermit/~A: ~A" *KERMIT-VERSION* FROB)))
+    (DEBUG-MESSAGE "~&Sending error packet: ~A" FROB)
+    (SEND-PACKET #\E *SEQUENCE-NUMBER* FROB)))
+
+(DEFUN SEND-ACK (NUM)
+  (SEND-PACKET #\Y NUM NIL))
+
+(DEFUN SEND-NACK (NUM)
+  (SEND-PACKET #\N NUM NIL))
+
+;;; Remember remote parameters and ackowledge with ours
+
+(DEFUN INITIALIZE-PARAMETERS (DATA)
+  (DECODE-PARAMETERS DATA)
+  (SEND-PARAMETERS #\Y *SEQUENCE-NUMBER*))
+
+(DEFUN DECODE-PARAMETERS (DATA)
+  (SETQ *SEND-PACKET-SIZE* (GRAPHIC->INTEGER (STRING-ELT DATA 0)))
+  (SETQ *TIMEOUT*          (GRAPHIC->INTEGER (STRING-ELT DATA 1)))
+  (SETQ *PAD*		   (GRAPHIC->INTEGER (STRING-ELT DATA 2)))
+  (SETQ *PAD-CHAR*	   (CTL (STRING-ELT DATA 3)))
+  (SETQ *EOL*		   (ASCII->CHAR (GRAPHIC->INTEGER (STRING-ELT DATA 4))))
+  (SETQ *QUOTE*		   (STRING-ELT DATA 5)))
+
+(DEFUN SEND-PARAMETERS (TYPE NUM)
+  (LET ((PACKET *SEND-PACKET*))
+    (SET-STRING-ELT PACKET 0 (INTEGER->GRAPHIC *RECEIVE-PACKET-SIZE*))
+    (SET-STRING-ELT PACKET 1 (INTEGER->GRAPHIC *MY-TIMEOUT*))
+    (SET-STRING-ELT PACKET 2 (INTEGER->GRAPHIC *MY-PAD*))
+    (SET-STRING-ELT PACKET 3 (CTL *MY-PAD-CHAR*))
+    (SET-STRING-ELT PACKET 4 (INTEGER->GRAPHIC (CHAR->ASCII *MY-EOL*)))
+    (SET-STRING-ELT PACKET 5 *MY-QUOTE*)
+    (SETF (FILL-POINTER PACKET) 6)
+    (SEND-PACKET TYPE NUM PACKET)))
+
+
+;;; SEND-PACKET
+;;;  TYPE -- a number, the type of packet this is.
+;;;  NUM  -- a number, the packet-number of this packet.
+;;;  DATA -- a string, i.e. an art-string type of array, the data of this pkt.
+
+(DEFUN SEND-PACKET (TYPE NUM DATA)
+  (LET ((CHKSUM 0)
+	(LEN (IF DATA (LISP:LENGTH DATA) 0)))
+    (DECLARE (FIXNUM CHKSUM LEN))
+    (DEBUG-MESSAGE "~&Sending packet:     ")
+    (DO ((I 0 (1+ I)))
+	((>= I *PAD*))
+      (SERIAL-WRITE-CHAR *PAD-CHAR*))
+    (SERIAL-WRITE-CHAR *SOH*)
+    (INCF CHKSUM (SERIAL-WRITE-CHAR (INTEGER->GRAPHIC (+ LEN 3))))
+    (INCF CHKSUM (SERIAL-WRITE-CHAR (INTEGER->GRAPHIC NUM)))
+    (INCF CHKSUM (SERIAL-WRITE-CHAR TYPE))
+    (IF DATA
+	(DO ((I 0 (1+ I)))
+	    ((>= I LEN))
+	  (DECLARE (FIXNUM I))
+	  (INCF CHKSUM (SERIAL-WRITE-CHAR (STRING-ELT DATA I)))))
+    (SERIAL-WRITE-CHAR (INTEGER->GRAPHIC (COMPUTE-FINAL-CHECKSUM CHKSUM)))
+    (SERIAL-WRITE-CHAR *EOL*)
+    (FORCE-OUTPUT *SERIAL-OUTPUT*)
+    (DEBUG-MESSAGE "~&type = ~3C, num = ~3D, len = ~3D~&  Data = ~A"
+		   TYPE NUM LEN (IF DATA (UNKLUDGIFY-STRING DATA) ""))))
+
+;;; RECEIVE-PACKET
+;;;  Values returned are, in order:
+;;;  TYPE -- a character (fixnum), in {#\A, #\S, ...}.  E.g. #\A means "abort".
+;;;  NUM  -- a number, the packet-number of this packet.
+;;;  DATA -- a string, the data of this packet, which is as many
+;;;             characters as appropriate/desired for this type of packet.
+;;; Many callers need only one (usually the type) value.
+
+(DEFUN RECEIVE-PACKET ()
+  (LISP:CATCH 'TIMEOUT
+    (LET ((ALARMCLOCK #'(LAMBDA (IGNORE) IGNORE
+			  (DEBUG-MESSAGE "~&RECEIVE-PACKET timed out")
+			  (LISP:THROW 'TIMEOUT *TIMED-OUT*))))
+      (DECLARE (SPECIAL ALARMCLOCK))
+      (UNWIND-PROTECT
+        (PROGN
+	  (ALARMCLOCK 'TIME (MAX *TIMEOUT* *MIN-TIMEOUT*))
+	  (REALLY-RECEIVE-PACKET))
+	(ALARMCLOCK 'TIME NIL)))))
+
+(DEFUN REALLY-RECEIVE-PACKET ()
+  (LET ((CH 0) (TYPE 0) (I 0) (CCHKSUM 0) (RCHKSUM 0) (LEN 0) (NUM 0)
+	(DATA *RECEIVE-PACKET*))
+    (DECLARE (FIXNUM TYPE I CCHKSUM RCHKSUM LEN NUM)
+	     #+Maclisp (FIXNUM CH))
+    (PROG ()
+     CONTINUE
+     
+      (SETQ CH (SERIAL-READ-CHAR))
+      (COND ((NOT (CHAR= CH *SOH*))
+	     (DEBUG-MESSAGE "~&Noise: ")
+	     (GO CONTINUE)))
+
+      (DEBUG-MESSAGE "~&Receiving packet: ")
+
+     (SETQ CH (SERIAL-READ-CHAR))
+     (IF (CHAR= CH *SOH*) (GO CONTINUE))
+     (SETQ CCHKSUM (CHAR->ASCII CH))		;OK, start checksum
+     (SETQ LEN (- (GRAPHIC->INTEGER CH) 3))	;Get character count
+     ;; (if *debug?* (format t "<~d>" len))
+
+     (COND ((OR (< LEN 0) (> LEN (- *MAX-PACKET-SIZE* 3)))
+	    (DEBUG-MESSAGE "~&RECEIVE-PACKET got illegal packet length: ~D"
+			   LEN)
+	    (RETURN (VALUES *LENGTH-ERROR* NUM DATA))))
+
+     (SETQ CH (SERIAL-READ-CHAR))
+     (IF (CHAR= CH *SOH*) (GO CONTINUE))
+     (INCF CCHKSUM (CHAR->ASCII CH))		;OK, update checksum
+     (SETQ NUM (GRAPHIC->INTEGER CH))		;Get packet number
+
+     (SETQ CH (SERIAL-READ-CHAR))
+     (IF (CHAR= CH *SOH*) (GO CONTINUE))
+     (INCF CCHKSUM (CHAR->ASCII CH))		;OK, update checksum
+     (SETQ TYPE CH)				;Get packet type
+
+     (DEBUG-MESSAGE "type = ~3C, num = ~3D, len = ~3D~%"
+		    TYPE NUM LEN)
+      (SETQ I 0)
+     READ-THE-PACKET
+      (COND ((< I LEN)
+	     (SETQ CH (SERIAL-READ-CHAR))
+	     (IF (CHAR= CH *SOH*) (GO CONTINUE))
+	     (INCF CCHKSUM (CHAR->ASCII CH))    ;OK, update checksum
+	     (SET-STRING-ELT DATA I CH)
+	     (INCF I)
+	     (GO READ-THE-PACKET)))
+      
+      ;; (SET-STRING-ELT DATA LEN 0)		;Mark end of data
+      ;; ^^ unnecessary!?
+      (SETF (FILL-POINTER DATA) LEN)
+
+      (DEBUG-MESSAGE "  Data = ~A" (UNKLUDGIFY-STRING DATA))
+
+     (SETQ CH (SERIAL-READ-CHAR))
+     (SETQ RCHKSUM (GRAPHIC->INTEGER CH))	;OK, get checksum
+
+     (SETQ CH (SERIAL-READ-CHAR))
+     (IF (CHAR= CH *SOH*) (GO CONTINUE))	;OK, get eol char and toss it
+							;Safe!
+     (SETQ CCHKSUM (COMPUTE-FINAL-CHECKSUM CCHKSUM))
+
+     (COND ((NOT (= CCHKSUM RCHKSUM))
+	    (DEBUG-MESSAGE "RECEIVE-PACKET received bad checksum (expected ~A, got ~A)"
+			   RCHKSUM CCHKSUM)
+	    ;; Corruption, oh no!
+	    (RETURN (VALUES *CHECKSUM-ERROR* NUM DATA)))
+	   (T
+	    ;; Else checksum ok, 'uncorrupted'.
+	    (IF (ERRP TYPE)
+		(MESSAGE "~&Aborting with following error from remote host:~%  ~S~%"
+			 (UNKLUDGIFY-STRING DATA)))
+	    (RETURN (VALUES TYPE NUM DATA)))))))
+
+
+;;; Serial I/O.  Everything here is pretty implementation-dependent, or at
+;;; least tunable for speed.
+
+#-Maclisp
+(DEFUN ALARMCLOCK (WHICH SECONDS) WHICH SECONDS
+  ;; Call the value of global variable ALARMCLOCK when SECONDS seconds
+  ;; have passed.  If SECONDS is NIL then disable the alarm.
+  'UNIMPLEMENTED)
+
+(DEFUN INIT-SERIAL-I/O (&OPTIONAL IN (OUT IN))
+  #-Maclisp
+  (PROGN (SETQ *SERIAL-INPUT*
+	       (OR (OPEN IN  :DIRECTION :INPUT)  *TERMINAL-IO*))
+	 (SETQ *SERIAL-OUTPUT*
+	       (OR (OPEN OUT :DIRECTION :OUTPUT) *TERMINAL-IO*)))
+  #+Maclisp
+  (PROGN (IF *SERIAL-INPUT* (TERMINATE-SERIAL-I/O))
+	 (SETQ *SERIAL-INPUT*
+	       (OPEN `((,(OR IN 'TTY))) '(TTY SINGLE IMAGE IN)))
+	 (SETQ *SERIAL-OUTPUT*
+	       (OPEN `((,(OR IN 'TTY))) '(TTY BLOCK IMAGE OUT)))))
+
+#+DEC   ;; For testing purposes
+(DEFUN MBX (&OPTIONAL IN (OUT IN))
+  (SETQ *EOL*    #\NEWLINE)
+  (SETQ *MY-EOL* #\NEWLINE)
+  (SETQ *SERIAL-INPUT*  (OPEN-MAILBOX IN))
+  (SETQ *SERIAL-OUTPUT*
+	(IF (EQUAL OUT IN)
+	    *SERIAL-INPUT*
+	    (OPEN-MAILBOX OUT)))
+  (VALUES (NAMESTRING *SERIAL-INPUT*) (NAMESTRING *SERIAL-OUTPUT*)))
+
+(DEFUN TERMINATE-SERIAL-I/O ()
+  (IF (NOT (EQ *SERIAL-INPUT* *TERMINAL-IO*))
+      (CLOSE *SERIAL-INPUT*))
+  (IF (NOT (EQ *SERIAL-OUTPUT* *TERMINAL-IO*))
+      (CLOSE *SERIAL-OUTPUT*))
+  (SETQ *SERIAL-INPUT* NIL *SERIAL-OUTPUT* NIL))
+
+(DEFUN SERIAL-STATE ()
+  #-Maclisp
+  NIL
+  #+Maclisp
+  (SYSCALL 3. 'TTYGET *SERIAL-INPUT*))
+
+(DEFUN SET-SERIAL-STATE (TEMP)
+  #-Maclisp
+  TEMP
+  #+Maclisp
+  (SYSCALL 0. 'TTYSET *SERIAL-INPUT* (CAR  TEMP) (CADR TEMP)))
+
+(DEFUN DISABLE-ECHOING (TEMP)
+  #-Maclisp
+  TEMP
+  #+Maclisp
+  (SYSCALL 0. 'TTYSET *SERIAL-INPUT*
+	   (LOGAND (CAR  TEMP) #o070707070707)
+	   (LOGAND (CADR TEMP) #o070707070707)))
+
+;(DEFUN ENABLE-ECHOING (TEMP)
+;  (SYSCALL 0. 'TTYSET *SERIAL-INPUT*
+;	   (LOGIOR (CAR  TEMP) #o202020202020)
+;	   (LOGIOR (CADR TEMP) #o202020200020)))
+
+(DEFUN SERIAL-READ-CHAR ()
+  #-(or Maclisp Symbolics)
+  ;; This is supposed to read without echoing.
+  (READ-CHAR *SERIAL-INPUT*)
+  #+Maclisp
+  (LET ((CH (+TYI *SERIAL-INPUT*)))
+    (IF *IMAGE?* CH (LOGAND CH #o177)))
+  #+Symbolics
+  (PROGN (ZL:SEND *SERIAL-INPUT* :INPUT-WAIT NIL
+		  #'ZL:TIME-ELAPSED-P
+		  (FLOOR (* (MAX *TIMEOUT* *MIN-TIMEOUT*) 60))
+		  (ZL:TIME))
+	 (IF (ZL:SEND *TERMINAL-IO* :LISTEN)
+	     (LET ((CH (ZL:SEND *TERMINAL-IO* :TYI)))
+	       (CODE-CHAR (ZL:CHAR-CODE CH) (ZL:CHAR-BITS CH)))
+	     (LISP:THROW 'TIMEOUT *TIMED-OUT*))))
+
+(DEFUN SERIAL-WRITE-CHAR (CH)
+  #-(or Maclisp Symbolics)
+  (WRITE-CHAR CH *SERIAL-OUTPUT*)
+  #+Maclisp
+  (+TYO CH *SERIAL-OUTPUT*)
+  #+Symbolics
+  (ZL:SEND *SERIAL-OUTPUT* :TYO (CHAR->ASCII CH))  ;?
+  (CHAR->ASCII CH))  ;for checksums
+
+(DEFUN FLUSH-INPUT ()
+  (CLEAR-INPUT *SERIAL-INPUT*))
+
+;;; Implementation-dependent fast character file I/O:
+
+#-Maclisp
+(PROGN 'COMPILE
+(DEFSUBST +TYI (STREAM)
+  (READ-CHAR STREAM NIL NIL))
+
+(DEFSUBST +TYO (CH STREAM)
+  (WRITE-CHAR CH STREAM))
+
+(DEFSUBST END-OF-FILE-P (C)     ;Called only on value of +TYI
+  (NULL C))
+)
+
+;;; File I/O
+
+;;; Put a pathname into Kermit standard form.
+
+(DEFUN KERMITIFY-PATHNAME (PATHNAME VERSIONP)
+  (LET* ((NAME    (STRINGIFY-COMPONENT (PATHNAME-NAME PATHNAME)))
+	 (TYPE    (STRINGIFY-COMPONENT (PATHNAME-TYPE PATHNAME)))
+	 (VERSION (STRINGIFY-COMPONENT (PATHNAME-VERSION PATHNAME))))
+    (COND ((AND VERSIONP VERSION)
+	   (STRING-APPEND NAME "." (OR TYPE "") "." VERSION))
+	  (TYPE
+	   (STRING-APPEND NAME "." TYPE))
+	  (T NAME))))
+
+(DEFUN STRINGIFY-COMPONENT (X)
+  (COND ((EQ X ':WILD) "*")
+	((EQ X ':NEWEST) "0")
+	((EQ X ':OLDEST) "-1")
+	((NUMBERP X) (FORMAT NIL "~d" X))
+	(T X)))
+
+;;; Use by SEND-FILE and by SERVE to service remote GET requests.
+;;; Returns a list of pairs (<local-pathname> . <remote-filespec>).
+
+(DEFUN MAKE-TRANSFER-LIST (LOCAL-FILESPEC REMOTE-FILESPEC)
+  #+Maclisp (DECLARE (SPECIAL REMOTE-FILESPEC))  ;No closures
+  (LET* ((PATH (PATHNAME LOCAL-FILESPEC))
+	 (PATH (IF (NULL (PATHNAME-VERSION PATH))
+		   (MAKE-PATHNAME :DEFAULTS PATH :VERSION :NEWEST)
+		   PATH))
+	 (PATHS (LISP:DIRECTORY PATH)))
+    (MAPCAR #'(LAMBDA (PATH)
+		(CONS PATH (IF REMOTE-FILESPEC
+			       (MERGE-PATHNAMES REMOTE-FILESPEC PATH
+						(PATHNAME-VERSION PATH))
+			       PATH)))
+	    PATHS)))
+
+;;; Opening files...
+
+(DEFUN MAYBE-OPEN-FOR-INPUT (FILESPEC)
+  (LISP:OPEN FILESPEC :DIRECTION :INPUT :IF-DOES-NOT-EXIST NIL))
+
+(DEFUN MAYBE-OPEN-FOR-OUTPUT (FILESPEC)
+  (LISP:OPEN FILESPEC :DIRECTION :OUTPUT :IF-EXISTS NIL))
+
+;;; Get around vagaries of file merging.
+
+(DEFUN FLUSH-WILDCARDS (PATHNAME)
+  (MAKE-PATHNAME :HOST      (PATHNAME-HOST PATHNAME)
+		 :DEVICE    (NOT-WILD (PATHNAME-DEVICE PATHNAME))
+		 :DIRECTORY (NOT-WILD (PATHNAME-DIRECTORY PATHNAME))
+		 :NAME      (NOT-WILD (PATHNAME-NAME PATHNAME))
+		 :TYPE	    (NOT-WILD (PATHNAME-TYPE PATHNAME))))
+
+(DEFUN NOT-WILD (COMPONENT)
+  (IF (OR (EQ COMPONENT :WILD)
+	  (EQUAL COMPONENT "*"))
+      NIL COMPONENT))
+
+;;; Write a packet buffer into the currently open local output file.
+
+(DEFUN EMPTY-BUFFER (BUFFER)
+  "Put data from an incoming packet into a local disk file."
+  (LET ((LEN (LISP:LENGTH BUFFER)))
+    (DO ((I 0 (1+ I)))
+	((>= I LEN) BUFFER)
+      (LET ((CH (STRING-ELT BUFFER I)))
+	(DECLARE (FIXNUM CH))
+	(COND ((CHAR= CH *MY-QUOTE*)
+	       (SETQ CH (STRING-ELT BUFFER (INCF I)))
+	       (IF (NOT (CHAR= CH #|(LOGAND CH #o177)|# *MY-QUOTE*))
+		   (SETQ CH (CTL CH)))))
+	;; (IF (NOT *IMAGE?*) (SETQ CH (LOGAND CH #o177)))
+	(+TYO CH *STREAM*)))))
+
+;;; Fill a packet buffer from the currently open local input file.
+;;; Returns the number of characters stored into the packet buffer.
+;;; A return value of zero means that the end of the file has been reached.
+
+;;; There are four ways to fill a buffer:
+;;; 1. kermit default: 7-bit, quote all control characters.
+;;; 3. image mode: send everything through with no conversion, except for
+;;;    quoting the quote character.
+;;; 2, 4: lose mode: excised by JAR.
+
+(DEFUN FILL-BUFFER (BUFFER)
+  "Fill buffer with the outgoing data from the file *STREAM* points to.
+Only control quoting is done; 8-bit and repeat count prefixes are not handled."
+  ;;1; Changed 6 to 7!! See lmbugs.doc file item #14.
+  (LET ((INDEX 0)
+	(LIMIT (- *SEND-PACKET-SIZE* 7)))
+    (DECLARE (FIXNUM LIMIT INDEX))
+    (DO ()
+	((>= INDEX LIMIT))
+      (LET ((C (+TYI *STREAM*)))
+	#+Maclisp (DECLARE (FIXNUM C))
+	(COND ((END-OF-FILE-P C)	;???
+	       (RETURN NIL))
+	      (T (LET ((N (CHAR->ASCII C)))
+		   (COND ((CHAR= C *QUOTE*)
+			  (SET-STRING-ELT BUFFER INDEX *QUOTE*)
+			  (INCF INDEX)
+			  (SET-STRING-ELT BUFFER INDEX C)
+			  (INCF INDEX))
+			 ((GRAPHIC-CHAR-P C)
+			  ;; Regular character
+			  (SET-STRING-ELT BUFFER INDEX C)
+			  (INCF INDEX))
+			 ((AND (NOT *IMAGE?*)
+			       (> N #o177))
+			  ;; Weird character.  Don't send anything for it.
+			  (MESSAGE "~&The character ~C [~N octal] couldn't be translated to ASCII."
+				   C N))
+			 ;; Deal with newline characters?
+			 (T (SET-STRING-ELT BUFFER INDEX *QUOTE*)
+			    (INCF INDEX)
+			    (SET-STRING-ELT BUFFER
+					    INDEX
+					    (IF (OR *IMAGE?* (>= N 32.))
+						C
+						(CTL C)))
+			    (INCF INDEX))))))))
+    (SETF (FILL-POINTER BUFFER) INDEX)
+    INDEX))
+
+
+#+Symbolics
+(defvar cl-readtable (copy-readtable nil))
+
+#+Symbolics
+(defun zl-user::setup ()
+  (zl:setq-standard-value *readtable* cl-readtable)
+  (zl:setq-standard-value *package* (find-package 'kermit)))
+
+
diff --git a/src/math/kermit.dumper b/src/math/kermit.dumper
new file mode 100755
index 00000000..c2f70e69
--- /dev/null
+++ b/src/math/kermit.dumper
@@ -0,0 +1,33 @@
+(COMMENT)					; -*- Mode: LISP -*-
+
+;;; To dump, say  :LISP MATH; KERMIT DUMPER
+
+(DO ((*PURE T))
+    (T
+     (DO ((S (OPEN '((DSK MATH) KERMIT UNFASL))))
+	 (T
+	  (SETQ *KERMIT-SOURCE* (CAR (LAST (CADR (READ S)))))
+	  (CLOSE S)))
+     (LOAD '((DSK MATH) KERMIT FASL))
+     (OR (GET 'MLSUB 'VERSION) (LOAD '((LISP) MLSUB FASL)))
+     (LOAD '((LIBLSP) TIME))))
+
+(DEFUN KERMIT-DUMP ()
+  (DO ((DD (TIME:PRINT-CURRENT-TIME NIL))
+       (U (STATUS UNAME)))
+      (T
+       (FORMAT T "~&Suspending... ")
+       (SUSPEND ":KILL " '((DSK MATH) TS KERMIT))
+       (FORMAT T "~&KERMIT ~A dumped in Lisp ~A by ~A on ~A~%"
+	       (CADDR *KERMIT-SOURCE*) (STATUS LISPV) U DD)
+       (DEFAULTF (LIST (LIST 'DSK (STATUS HSNAME)) '* '>))
+       (DO ((I (PROBEF (LIST (LIST 'DSK (STATUS HSNAME))
+			     (STATUS UNAME) 'KERMIT))))
+	   (T
+	    (COND (I
+		   (FORMAT T "Loading ~A" (NAMESTRING I))
+		   (LOAD I)))))
+       (SERVE)
+       (QUIT))))
+
+'|Do (KERMIT-DUMP) to dump.|