diff options
Diffstat (limited to 'src/interp/spad.lisp.pamphlet')
| -rw-r--r-- | src/interp/spad.lisp.pamphlet | 170 |
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)) |