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