aboutsummaryrefslogtreecommitdiff
path: root/src/interp/spad.lisp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-25 02:29:19 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-25 02:29:19 +0000
commit20ce2990a91a76c43ef0d255baf7a773291d6779 (patch)
treeeea46c5e757916d7551646fdc964114052b8cb7a /src/interp/spad.lisp
parent24b9bd5e93048c335fa21ff5a17dc33d4a6a57ae (diff)
downloadopen-axiom-20ce2990a91a76c43ef0d255baf7a773291d6779.tar.gz
* 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.
Diffstat (limited to 'src/interp/spad.lisp')
-rw-r--r--src/interp/spad.lisp175
1 files changed, 0 insertions, 175 deletions
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