Artifact 1fd36c4432d9e52b9ca4dd225b5031f3fe2a4e29f85f62955f2e2bd637e2a825:

• File r30/lisp.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2495) [annotate] [blame] [check-ins using] [more...]

 This file is loaded automatically by Lisp, just after its initial
   allocation of storage spaces, and supplies system extensions.

(SETQ IBASE (SETQ BASE 8.)))

(SETQ !$EOL!$ (INTERN (ASCII 37)))

 (COND ((NOT (GETD 'EXCORE))
	(PROG (X)
	      (PUTD '!%TSTFISL 'EXPR '(LAMBDA NIL NIL))
	      (PUTD '!%ENDFISL 'EXPR '(LAMBDA NIL NIL))
	      (COND ((GREATERP (SETQ X BPORG) 673000)
                     (ERROR 0 "NO FISLTABLE ROOM")))
	      (SETQ BPORG 673000)
	      (SETQ FISLSIZE (DIFFERENCE (DIFFERENCE BPEND BPORG) 2))
	      (SETQ FISLTABLE (MKVECT(DIFFERENCE (TIMES2 2 FISLSIZE) 1)))
	      (SETQ BPORG X)))
       (T (SETQ FISLSIZE 1000)
	  (PUTD '!%TSTFISL 'EXPR '(LAMBDA NIL
	    (PROG (X)
		  (COND
		   ((GREATERP (SETQ X BPORG) (DIFFERENCE BPEND FISLSIZE))
		    (ERROR 0 "NO FISLTABLE ROOM")))
		  (SETQ BPORG (DIFFERENCE (DIFFERENCE BPEND FISLSIZE) 1))
		  (SETQ FISLTABLE (MKVECT (DIFFERENCE (TIMES2 2 FISLSIZE) 5)))
		  (SETQ BPORG X))))
	  (PUTD '!%ENDFISL 'EXPR
	     '(LAMBDA NIL (PROGN (DLVECT FISLTABLE) (SETQ FISLTABLE NIL))))))

(PUTD '!%DEVP 'EXPR
	 '(LAMBDA (X)
		 (OR (EQ (CAR (REVERSE (EXPLODE X))) (QUOTE !:))
		     (AND (NOT (ATOM X)) (NOT (ATOM (CDR X)))))))

(PUTD 'FISLF 'EXPR
 '(LAMBDA(FILES !*PREDEF !*PURIFY)
  (PROG (X)
	(COND ((AND (NULL (FILEP FILES)) (NULL (!%DEVP (CAR FILES))))
	      (SETQ FILES (CONS (QUOTE SYS:) FILES))))
	(SETQ X (RDS (OPEN FILES 'INBIN)))
	(!%TSTFISL)
	(ERRORSET '(FASLOD FISLTABLE !*PREDEF !*PURIFY) T !*BAKGAG)
	(CLOSE (RDS X))
	(!%ENDFISL)
	(LDFERR))))

(MAPC '(!%TSTFISL !%ENDFISL) (FUNCTION REMOB))

(PUTD 'DCONSA 'EXPR (MKCODE (PLUS2 (!*BOX (CDDR (GETD 'XCONS))) 1) 1))


 Do various setups, then ERR() back to main EVAL loop.

(FISLF '((FEND . FAP)) NIL T)
(FISLF '((FISL . FAP)) NIL T)))

%(RDS (OPEN '(DSK!: (FEND . SL)) 'INPUT))
%(RDS (OPEN '(DSK!: (FISL . SL)) 'INPUT))

(SETQ BASE (SETQ IBASE (PLUS2 7 3)))

(LINELENGTH 69)

(DM COMPILE (X) (PROGN (LOAD COMPLR CMACRO LAP) X))

(DE COMPD (X Y Z) (PROGN (COMPILE) (COMPD X Y Z)))

(DM TR (X) (PROGN (LOAD DEBUG) X))

(DM TRST (X) (PROGN (LOAD DEBUG) X))

(MAPC '(SUBRLOC SYMLOC !%FLIST !%FNAM !*AMAKE !%TALK !%SWAP)
	(FUNCTION REMOB))

(REMOB (QUOTE LAST))

(PUTD '!%SCAN 'EXPR (CDR (GETD 'SCAN 'EXPR)))

(REMOB 'SCAN)


(PROG NIL (CLOSE (RDS NIL))
	  (CLOSE (WRS NIL))
	  (PRIN2 "
Standard Lisp (April 1983)")
	  (EXCISE)
	  (SETQ !*BAKGAG T)
	  (SETQ !*DDTIN NIL)
	  (SETQ !*NOPOINT T)
	  (SETQ !*NOUUO T)
	  (SETQ !*RAISE T)
	  (SETQ DFPRINT!* NIL)
	  (ERR))