aboutsummaryrefslogtreecommitdiff
path: root/src/interp/spad.lisp.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/spad.lisp.pamphlet')
-rw-r--r--src/interp/spad.lisp.pamphlet170
1 files changed, 0 insertions, 170 deletions
diff --git a/src/interp/spad.lisp.pamphlet b/src/interp/spad.lisp.pamphlet
index 382ffc6a..6a9fa709 100644
--- a/src/interp/spad.lisp.pamphlet
+++ b/src/interp/spad.lisp.pamphlet
@@ -132,32 +132,8 @@
(defvar |$IOAlist| '((|%i| . (|gauss| 0 1))))
(setq |$useBFasDefault| T)
(defvar |InteractiveMode|)
-(defvar |New-LEXPR|)
(defvar |NewFLAG| t)
(defvar |uc| 'UC)
-(setq |$lisp2lispRenameAssoc| '((RETURN . |return|)
- (EXIT . |exit|)
- (AND . |and|)
- (OR . |or|)
- (NOT . |not|)
- (IS . |is|)
- (CAR . |first|)
- (CDR . |rest|)
- (EQUAL . =)
- (NEQUAL . ^=)
- (PLUS . +)
- (TIMES . *)
- (QUOTIENT . /)
- (EXPT . **)
- (SUBST . |substitute|)
- (NULL . ^)
- (ATOM . |atom|)
- (NULL . |null|)
- ))
-
-(setq |$spadOpList|
- '(\.\. - = * / ** + - \< \> \<= \>= ^= \# \' ^
- \: \:\: \. =\> == ==\> \| \:=))
(DEFUN INTEGER-BIT (N I) (LOGBITP I N))
@@ -173,19 +149,6 @@
(COPY-TREE |$InitialModemapFrame|))))
(RETURN (PROGN (S-PROCESS X) NIL))))
-(DEFUN /TRANSBOOT (X) (S-PROCESS X) NIL)
-
-(DEFUN /TRANSNBOOT (X) (S-PROCESS X) NIL)
-
-(DEFUN /TRANSMETA (X)
- (PROG (KEYNAM ROOTFN U)
- (SETQ ROOTFN (/MFINDROOT (CAR /SOURCEFILES)))
- (SETQ $LASTPREFIX (GET ROOTFN 'METAPFX))
- (SETQ KEYNAM (INTERNL $LASTPREFIX (PNAME ROOTFN) "KEY"))
- (SET KEYNAM (REMDUP (APPEND METAKEYLST (EVAL KEYNAM))))
- (SETQ U (GETRULEFUNLISTS ROOTFN (LIST X)))
- (SUBLISNQ (PAIR (CADR U) (CAR U)) X)))
-
;; NIL needed below since END\_UNIT is not generated by current parser
(defun |isTokenDelimiter| () (MEMBER (CURRENT-SYMBOL) '(\) END\_UNIT NIL)))
@@ -222,10 +185,6 @@
(defun READ-SPAD-1 () (|New,ENTRY,1|))
-(defun BOOT-LEXPR () (SETQ $BOOT 'T) (SPAD-LEXPR1))
-
-(defun NBOOT-LEXPR () (SETQ $NBOOT 'T) (SPAD-LEXPR1))
-
(defun UNCONS (X)
(COND ((ATOM X) X)
((EQCAR X 'CONS) (CONS (SECOND X) (UNCONS (THIRD X))))
@@ -242,21 +201,6 @@
(defun SPAD-MODETRAN (X) (D-TRAN X))
-(defun SPAD-MDTR-1 (X)
- (COND
- ((ATOM X) (LIST (LIST X)))
- ((EQCAR X 'LIST) (SPAD-MDTR-2 (CDR X)))
- (T (CROAK "MODE TRANSFORM ERROR"))))
-
-(defun SPAD-MDTR-2 (L)
- (COND
- ((NOT L) L)
- ((ATOM (FIRST L))
- (COND
- ((MEMBER (FIRST L) $DOMVAR) (FIRST L))
- (T (CONS (LIST (LIST (FIRST L))) (SPAD-MDTR-2 (CDR L)))) ))
- (T (CONS (FIRST L) (SPAD-MDTR-2 (CDR L))))))
-
(defun SPAD-EVAL (X)
(COND ((ATOM X) (EVAL X))
((CONS (FIRST X) (MAPCAR #'SPAD-EVAL (CDR X))))))
@@ -461,27 +405,6 @@
(defun |evalSharpOne| (x \#1) (declare (special \#1)) (EVAL x))
-(defun new () (|New,ENTRY|))
-
-(defun newpo () (let ((|$PrintOnly| t)) (new)))
-
-(defun |New,ENTRY| ()
- (let ((|$InteractiveMode| t)(inputstream in-stream) )
- (declare (special inputstream))
- (spad)))
-
-(defun |New,ENTRY,SYS| ()
- (let (|$InteractiveMode|)
- (|New,ENTRY1|)))
-
-(defun |New,ENTRY1| ()
- (let ((spaderrorstream curoutstream) $boot (curinstream curinstream)
- (strm curinstream))
- (SETQ CURINSTREAM *terminal-io*)
- (|New,ENTRY,1|)
- (SETQ CURINSTREAM STRM)
- 'END_OF_New))
-
(setq *PROMPT* 'LISP)
(defun |New,ENTRY,1| ()
@@ -517,20 +440,8 @@
(defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse INPUTSTREAM))
-(defun New-LEXPR () (New-LEXPR1))
-
-(defun New-LEXPR-Interactive () (setq |$InteractiveMode| t) (New-LEXPR1))
-
(setq *prompt* 'new)
-(defun New-LEXPR1 ()
- (FLAG |boot-NewKEY| 'KEY)
- (SETLINE (SUB1 (file-position INPUTSTREAM)) INPUTSTREAM)
- (SETQ CHR 'ENDOFLINECHR)
- (NXTTOK)
- (|boot-Statement|)
- (CAR STACK))
-
(defun parserState ()
(PRINT (LIST 'CHR= CHR 'NBLNK= NBLNK 'TOK= TOK 'ISID= ISID
'COUNT= COUNT 'COLUMN= COLUMN))
@@ -560,85 +471,6 @@
(COLLECT |formatCOLLECT|)
(REDUCE |formatREDUCE|)))
-(defun |boot2Lisp| (LINESET)
- (let* (($TOP_STACK T) (*PROMPT* 'New) ($MAXLINENUMBER 0)
- (NewFLAG T) (XTRANS '|boot-New|) (XCAPE '!)
- (COMMENTCHR 'NOTHING) (XTOKENREADER 'NewSYSTOK)
- ($NBOOT T) (ERRCOL 0) (COUNT 0) (COLUMN 0)
- (TRAPFLAG NIL) (OK T) (SPADERRORSTREAM CUROUTSTREAM)
- ($LINESTACK 'BEGIN_UNIT)
- (INPUTSTREAM LINESET)
- (CHR 'ENDOFLINECHR))
- (REMFLAG S-SPADKEY 'KEY)
- (FLAG |boot-NewKEY| 'KEY)
- (NXTTOK) ; causes PREPARSE to be called
- (|boot-Statement|)
- (REMFLAG |boot-NewKEY| 'KEY)
- (FLAG S-SPADKEY 'KEY)
- (if (NULL OK) (|boot2LispError|))
- (|new2OldLisp| (CAR STACK))))
-
-(defun /cx (L)
- "CAUTION: will not work if function in L has DEFLOC with ft=NBOOT"
- (if (not L) (SETQ L |$LastCxArg|))
- (SETQ |$LastCxArg| L)
- (/D-1 L '|lisp2BootAndCompare| NIL NIL))
-
-(defun /foobar (L)
- (let (($xCount 0))
- (if (not L) (SETQ L $LastCxArg))
- (SETQ $LastCxArg L)
- (/D-1 L 'foobar NIL NIL)))
-
-(defun foobar (X) |$xCount|)
-
-(defun |/cxd| (L)
- (if (NULL L) (SETQ L $|LastCxArg|))
- (SETQ |$LastCxArg| L)
- (/D-1 L '|lispOfBoot2NBootAndCompare| NIL NIL))
-
-(defun |/rx| (L)
- (let ((DEF-RENAME 'IDENTITY)
- (DEF-PROCESS '|lispOfBoot2NBootAndCompare|) )
- (declare (SPECIAL DEF-RENAME DEF-PROCESS))
- (if (OR (NULL L) (NULL (ATOM (CAR L))))
- (EVAL (APPEND (CONS '/RF /EDITFILE) L))
- (CATCH 'FILENAM (/RF-1 L)))))
-
-(defun |/ry| (L)
- (let ((DEF-RENAME 'IDENTITY)
- (DEF-PROCESS '|pp|) )
- (declare (SPECIAL DEF-RENAME DEF-PROCESS))
- (if (OR (NULL L) (NULL (ATOM (CAR L))))
- (EVAL (APPEND (CONS '/RF /EDITFILE) L))
- (CATCH 'FILENAM (/RF-1 L)))))
-
-(defun |/tb| (L)
- (let ((DEF-RENAME 'IDENTITY) (DEF-PROCESS 'lispOfBoot2NBAC1))
- (declare (special DEF-RENAME DEF-PROCESS))
- (if (NULL L)
- (EVAL (CONS '/RQ /EDITFILE))
- (CATCH 'FILENAM
- (PROG (OUTFILE ($PRETTYPRINT T))
- (SETQ /EDITFILE (LIST (CAR L) 'BOOT '*))
- (OBEY (STRCONC "ERASE " (PNAME (CAR /EDITFILE)) " NBOOT E1"))
- (SETQ OUTFILE (LIST (CAR /EDITFILE) 'NBOOT 'E1))
- (RETURN (/RF-1 (APPEND /EDITFILE
- (LIST (CONS 'TO= OUTFILE))))))))))
-
-(defun |boot2LispError| ()
- "Print syntax error indication, underline character, scrub line."
- (COND ((OR (EQ DEBUGMODE 'YES) (NULL (CONSOLEINPUTP INPUTSTREAM)))
- (SPAD_LONG_ERROR))
- (T (SPAD_SHORT_ERROR)))
- (SETQ OK T))
-
-(defun |getTranslation| (|function| |fn| |ft| |rdr|)
- (let ((|New-LEXPR| |rdr|) (|$TranslateOnly| T))
- (declare (special |New-LEXPR| |$TranslateOnly|))
- (/D-1 (LIST |function| (LIST 'FROM= |fn| |ft|)) 'IDENTITY NIL NIL)
- |$Translation|))
-
(defmacro |incTimeSum| (a b)
(if (not |$InteractiveTimingStatsIfTrue|) a
(let ((key b) (oldkey (gensym)) (val (gensym)))
@@ -727,8 +559,6 @@
(defvar DOLLAR "$")
(defvar COLON ":")
-; (SETQ |boot-NewKEY| (S- |boot-NewKEY| '(|cp| |cms| |lisp| |boot|)))
-
(FLAG TEMPGENSYMLIST 'IS-GENSYM)
(MAKEPROP 'COND '|Nud| '(|if| |if| 130 0))