File r30/lisp.sl artifact 1fd36c4432 part of check-in 46c747b52c

 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))