* interp/sys-globals.boot ($compCount): Remove.

	* interp/spad.lisp (knownEqualPred): Move to buildom.boot
	(hashable): Likewise.
	Remove junk.
	* interp/debug.lisp: Remove junk.
	* interp/vmlisp.lisp: Likewise.

5 files changed, 9 insertions, 189 deletions

diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index d6437cd5..9856c5e6 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -308,6 +308,15 @@ lookupInTable(op,sig,dollar,[domain,table]) ==
   someMatch => lookupInAddChain(op,sig,domain,dollar)
   nil
 
+knownEqualPred dom ==
+  fun := compiledLookup("=",[$Boolean,"$","$"],dom) =>
+    getFunctionReplacement BPINAME first fun
+  nil
+
+hashable dom ==
+  -- FIXME: there should test for OIL opcodes.
+  symbolMember?(knownEqualPred dom,'(EQ EQL EQUAL)) 
+
 --% Record
 --  Want to eventually have the elts and setelts.
 --  Record is a macro in BUILDOM LISP. It takes out the colons.
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 917c91ff..18b3d2f6 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -62,13 +62,6 @@
 (MAKEPROP 'INPUT '/TERMCHR '(#\:  #\<  #\  #\())
 (MAKEPROP 'SPAD '/TERMCHR '(#\:  #\<  #\  #\())
 (MAKEPROP 'BOOT '/TERMCHR '(#\:  #\<  #\  #\())
-(MAKEPROP 'META '/READFUN 'META\,RULE)
-(MAKEPROP 'INPUT '/READFUN '|New,LEXPR,Interactive|)
-(MAKEPROP 'INPUT '/TRAN '/TRANSPAD)
-(MAKEPROP 'BOOT '/READFUN '|New,LEXPR1|)
-(MAKEPROP 'BOOT '/TRAN '/TRANSNBOOT)
-(MAKEPROP 'SPAD '/READFUN '|New,LEXPR|)
-(MAKEPROP 'SPAD '/TRAN '/TRANSPAD)
  
 (defmacro |/C,LIB| (&rest L &aux optionlist /editfile
                           ($prettyprint 't) ($reportCompilation 't))
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index fd2cedd6..4b203e9b 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -54,24 +54,8 @@
 (defvar |$HiFiAccess| nil "if true maintain history file")
 
 (DEFVAR _ '&)
-(defvar /EDIT-FM 'A1)
-(defvar /EDIT-FT 'SPAD)
-(defvar /RELEASE '"UNKNOWN")
 (defvar error-print)
-(defvar ind)
-(defvar INITCOLUMN 0)
-(defvar JUNKTOKLIST '(FOR IN AS INTO OF TO))
-(defvar m-chrbuffer)
-(defvar m-chrindex)
 (defvar MARG 0 "Margin for testing by ?OP")
-(defvar RLGENSYMFG NIL)
-(defvar RLGENSYMLST NIL)
-(defvar S-SPADTOK 'SPADSYSTOK)
-(defvar sortpred)
-(defvar SPADSYSKEY '(EOI EOL))
-(defvar STAKCOLUMN -1)
-(defvar |$IOAlist| '((|%i| . (|gauss| 0 1))))
-(defvar |InteractiveMode|)
 (defvar |uc| 'UC)
 
 (defun init-boot/spad-reader ()
@@ -139,70 +123,10 @@
 
 (DEFUN INTEGER-BIT (N I) (LOGBITP I N))
 
-(DEFUN /TRANSPAD (X)
-  (PROG (proplist)
-        (setq proplist (LIST '(FLUID . |true|)
-                             (CONS '|special|
-                                   (COPY-TREE |$InitialDomainsInScope|))))
-        (SETQ |$InteractiveFrame|
-              (|addBinding| '|$DomainsInScope| proplist
-                          (|addBinding| '|$Information| NIL
-                                      (COPY-TREE |$InitialModemapFrame|))))
-        (RETURN (PROGN (|translateSpad| X) NIL))))
-
- ;; NIL needed below since END\_UNIT is not generated by current parser
-
-(defun |traceComp| ()
-  (SETQ |$compCount| 0)
-  (EMBED '|comp|
-     '(LAMBDA (X Y Z)
-         (PROG (U)
-               (SETQ |$compCount| (1+ |$compCount|))
-               (SETQ |yesOrNo| (if (SETQ U (|comp| X Y Z))
-                                   (if (EQUAL (SECOND U) Y) '|yes| (SECOND U))
-                                 ('T '|no|)))
-               (|sayBrightly| (CONS (MAKE-FULL-CVEC |$compCount| " ")
-                                    (LIST X " --> " Y '|%b| |yesOrNo| '|%d|)))
-               (SETQ |$compCount| (1- |$compCount|))
-               (RETURN U)  )))
-  (|comp| |$x| |$m| |$f|)
-  (UNEMBED '|comp|))
-
-(defun UNCONS (X)
-  (COND ((ATOM X) X)
-        ((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X))))
-        (T (ERROR "UNCONS"))))
-
-(defun OPTIMIZE\&PRINT (X) (PRETTYPRINT (/MDEF X)))
-
-(defun SPAD-PRINTTIME (A B)
-  (let (c msg)
-    (setq C (+ A B))
-    (setq MSG (STRCONC "(" (STRINGIMAGE A) " + " (STRINGIMAGE B)
-                       " = " (STRINGIMAGE C) " MS.)"))
-    (PRINT (STRCONC (STRINGPAD "" (DIFFERENCE 80 (SIZE MSG))) MSG))))
-
-(defun SPAD-MODETRAN (X) (D-TRAN X))
-
-(defun SPAD-EVAL (X)
-  (COND ((ATOM X) (EVAL X))
-        ((CONS (FIRST X) (MAPCAR #'SPAD-EVAL (CDR X))))))
-
 ;************************************************************************
 ;         SYSTEM COMMANDS
 ;************************************************************************
 
-(defun READLISP (UPPER_CASE_FG)
-  (let (v expr val )
-    (setq EXPR (READ-FROM-STRING
-                  (IF UPPER_CASE_FG (string-upcase (line-buffer |$spadLine|))
-                      (line-buffer |$spadLine|))
-                  t nil :start (Line-CURRENT-INDEX |$spadLine|)))
-    (VMPRINT EXPR)
-    (setq VAL ((LAMBDA (|$InteractiveMode|)  (EVAL EXPR)) NIL))
-    (FORMAT t "~&VALUE = ~S" VAL)
-    (TERSYSCOMMAND)))
-
 (defun TERSYSCOMMAND ()
   (FRESH-LINE)
   (SETQ CHR 'ENDOFLINECHR)
@@ -210,52 +134,16 @@
   (|spadThrow|))
 
 (defun /READ (L Q)
-;  (SETQ /EDIT-FN (OR (KAR L) /EDIT-FN))
-;  (SETQ /EDIT-FT (OR (KAR (KDR L)) 'INPUT))
-;  (SETQ /EDIT-FM (OR (KAR (KDR (KDR L))) '*))
-;  (SETQ /EDITFILE (LIST /EDIT-FN /EDIT-FT /EDIT-FM))
   (SETQ /EDITFILE L)
   (COND
     (Q  (/RQ))
     ('T (/RF)) )
   (|terminateSystemCommand|))
 
-(defun /EF (&rest foo)
-  (|runCommand| (concat "vi " (namestring (make-input-filename /EDITFILE)))))
-
-(defun /EDIT (L)
-  (SETQ /EDITFILE L)
-  (/EF)
-  (|terminateSystemCommand|))
-
-(defun /COMPINTERP (L OPTS)
-  (SETQ /EDITFILE (/MKINFILENAM L))
-  (COND ((EQUAL OPTS "rf") (/RF))
-        ((EQUAL OPTS "rq") (/RQ))
-        ('T (/RQ-LIB)))
-  (|terminateSystemCommand|))
-
 (defun |fin| ()
   (SETQ *EOF* 'T)
   (THROW 'SPAD_READER NIL))
 
-
-(defun STRINGREST (X) (if (EQ (SIZE X) 1) (make-string 0) (SUBSTRING X 1 NIL)))
-
-(defun STREAM2UC (STRM)
-  (LET ((X (ELT (LASTATOM STRM) 1))) (SETF (ELT X 0) (LC2UC (ELT X 0)))))
-
-(defun GP2COND (L)
-  (COND ((NOT L) (ERROR "GP2COND"))
-        ((NOT (CDR L))
-         (COND ((EQCAR (FIRST L) 'COLON)
-                (CONS (SECOND L) (LIST (LIST T 'FAIL))))
-               (T (LIST (LIST T (FIRST L)))) ))
-        ((EQCAR (FIRST L) 'COLON) (CONS (CDAR L) (GP2COND (CDR L))))
-        (T (ERROR "GP2COND"))))
-
-(FLAG JUNKTOKLIST 'KEY)
-
 (defmacro |DomainSubstitutionMacro| (&rest L)
   (|DomainSubstitutionFunction| (first L) (second L)))
 
@@ -291,76 +179,22 @@
         (declare (special |$autoLine|))
         (|tryToFit| (|saveState|) ,X)))
 
-(defun SETELTFIRST (A B C) (declare (ignore b)) (RPLACA A C))
-
-(defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
-
 (DEFUN ASSOCIATER (FN LST)
   (COND ((NULL LST) NIL)
         ((NULL (CDR LST)) (CAR LST))
         ((LIST FN (CAR LST) (ASSOCIATER FN (CDR LST))))))
 
-(defun ISLOCALOP-1 (IND)
-  "Curindex points at character after '.'"
-  (prog (selector buf termtok (NEWCHR (NEXTCHARACTER)))
-    (if (TERMINATOR NEWCHR) (RETURN NIL))
-    (setq SELECTOR
-          (do ((x nil))
-              (nil)
-            (if (terminator newchr)
-                (reverse x)
-                (push (setq newchr (nextcharacter)) x))))
-    (if (EQUAL NEWCHR '\.) (RETURN (ISLOCALOP-1 IND)))
-    (setq BUF (|makeString| (LENGTH SELECTOR)))
-    (mapc #'(lambda (x) (suffix x buf)) selector)
-    (setq buf (copy-seq selector))
-    (setq TERMTOK (INTERN BUF))
-    (if (NOT (GET TERMTOK 'GENERIC)) (RETURN NIL))
-    (if (OR (GET TERMTOK '|Led|) (GET TERMTOK '|Nud|))
-        (GET TERMTOK IND))
-    (return TERMTOK)))
 ; **** X. Random tables
 
 (defvar $MARGIN 3)
-(defvar TEMPGENSYMLIST '(|s| |r| |q| |p|))
-(defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|))
-(defvar LITTLEIN " in ")
-(defvar INITALPHLIST ALPHLIST)
-(defvar INITXPARLST '(|i| |j| |k| |l| |m| |n| |p| |q|))
-(defvar PORDLST (COPY-tree INITXPARLST))
-(defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|))
-(defvar LITTLEA '|a|)
-(defvar LITTLEI '|i|)
-(defvar ALLSTAR NIL)
 (defvar PLUSS "+")
-(defvar PERIOD ".")
 (defvar SLASH "/")
 (defvar COMMA ",")
-(defvar LPAR "(")
-(defvar RPAR ")")
-(defvar EQSIGN "=")
 (defvar DASH "-")
 (defvar STAR "*")
 (defvar DOLLAR "$")
 (defvar COLON ":")
 
-(FLAG TEMPGENSYMLIST 'IS-GENSYM)
-
-
-;; NAME:    DECIMAL-LENGTH
-;; PURPOSE: Computes number of decimal digits in print representation of x
-;;  This should made as efficient as possible.
-
-(DEFUN DECIMAL-LENGTH (X)
-   (LET* ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X))))
-          (X (TRUNCATE (ABS X) (EXPT 10 (1- K)))))
-     (IF (< X 10) K (1+ K))))
-
-;(DEFUN DECIMAL-LENGTH2 (X)
-;   (LET ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X)))))
-;     (IF (< (ABS X) (EXPT 10 K)) K (1+ K))))
-
-
 ;; function to create byte and half-word vectors in new runtime system 8/90
 
 (defun |makeByteWordVec| (initialvalue)
@@ -375,15 +209,6 @@
       :element-type (list 'mod (1+ n))
       :initial-contents initialvalue)))
 
-(defun |knownEqualPred| (dom)
-  (let ((fun (|compiledLookup| '= '((|Boolean|) $ $) dom)))
-    (if fun (|getFunctionReplacement| (bpiname (car fun)))
-      nil)))
-
-(defun |hashable| (dom)
-  (|symbolMember?| (|knownEqualPred| dom)
-        '(EQ EQL EQUAL)))
-
 ;; simpler interpface to RDEFIOSTREAM
 (defun RDEFINSTREAM (&rest fn)
   ;; following line prevents rdefiostream from adding a default filetype
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 397bd16e..f28f5f8d 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -61,9 +61,6 @@ $cacheAlist := nil
 $cacheCount := 0
 
 ++
-$compCount := 0
-
-++
 $createUpdateFiles := false
 
 ++
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 002a8812..a6a0aa3a 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -342,7 +342,6 @@
         (t (mapcar #'upcase l))))
 
 (define-function 'U-CASE #'upcase)
-(define-function 'LC2UC #'upcase)
 
 (defun downcase (l)
   (cond ((stringp l) (string-downcase l))
@@ -914,9 +913,6 @@
   (let ((*print-pretty* t) (*print-array* t))
     (prin1 x stream)))
 
-(defun vmprint (x &optional (stream |$OutputStream|))
-  (prin1 x stream) (terpri stream))
-
 (defun tab (sint &optional (stream t))
   (format stream "~vT" sint))