Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50073/lisp.lsp
There are 5 other files named lisp.lsp in the archive. Click here to see a list.
00010 (DEFPROP %DEFIN
00020 (LAMBDA (X V F P)
00030 (PROG (R)
00040 (SETQ R (COND ((GETL X
00050 (QUOTE (EXPR FEXPR
00060 SUBR
00070 FSUBR
00080 LSUBR
00090 MACRO)))
00100 (LIST X (QUOTE Redefined)))
00110 (T X)))
00120 (PUTPROP X (LIST (QUOTE LAMBDA) V F) P)
00130 (RETURN R)))
00140 EXPR)
00150
00160 (DEFPROP DE
00170 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE EXPR)))
00180 FEXPR)
00190
00200 (DEFPROP DF
00210 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE FEXPR)))
00220 FEXPR)
00230
00240 (DEFPROP DM
00250 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE MACRO)))
00260 FEXPR)
00270
00280 (DEFPROP PLUS (LAMBDA (L) (*EXPAND L (QUOTE *PLUS))) MACRO)
00290
00300 (DEFPROP DIFFERENCE (LAMBDA (L) (*EXPAND L (QUOTE *DIF))) MACRO)
00310
00320 (DEFPROP TIMES (LAMBDA (L) (*EXPAND L (QUOTE *TIMES))) MACRO)
00330
00340 (DEFPROP QUOTIENT (LAMBDA (L) (*EXPAND L (QUOTE *QUO))) MACRO)
00350
00360 (DEFPROP LESSP
00370 (LAMBDA (L)
00380 (LIST (QUOTE *LESS)
00390 (*EXPAND1 (CDR (REVERSE (CDR L)))
00400 (QUOTE (LAMBDA (X Y)
00410 (COND ((AND X (*LESS X Y)) Y)))))
00420 (CAR (LAST L))))
00430 MACRO)
00440
00450 (DEFPROP GREATERP
00460 (LAMBDA (L)
00470 (LIST (QUOTE *GREAT)
00480 (*EXPAND1 (CDR (REVERSE (CDR L)))
00490 (QUOTE (LAMBDA (X Y)
00500 (COND ((AND X (*GREAT X Y)) Y)))))
00510 (CAR (LAST L))))
00520 MACRO)
00530
00540 (DEFPROP %DEVP
00550 (LAMBDA (X)
00560 (OR (EQ (CAR (LAST (EXPLODE X))) (QUOTE :))
00570 (AND (NOT (ATOM X)) (NOT (ATOM (CDR X))))))
00580 EXPR)
00590
00600 (DE %READCHAN (%CHAN %TALK)
00610 (PROG (%OLDCHAN %SEXPR)
00620 (SETQ %OLDCHAN (INC %CHAN NIL))
00630 LOOP (SETQ %SEXPR (ERRSET (READ)))
00640 (COND ((EQ (CAR %SEXPR) (QUOTE COMMENT))
00650 (PROG (%XCH)
00660 A
00670 (SETQ %XCH (READCH))
00680 (AND (EQ %XCH (QUOTE /;))
00690 (RETURN))
00700 (GO A) )
00710 (GO LOOP)) )
00720 (COND ((ATOM %SEXPR) (GO END)))
00730 (SETQ %SEXPR (EVAL (CAR %SEXPR)))
00740 (COND (%TALK (PRINT %SEXPR)))
00750 (GO LOOP)
00760 END (INC %OLDCHAN T)
00770 (RETURN NIL)))
00780
00790 (DE %READAFILE (%DEV %FNAM %TALK)
00800 (%READCHAN (EVAL (LIST (QUOTE INPUT) (GENSYM) %DEV %FNAM)) %TALK))
00810
00820 (DE READIN (%DEV %FLIST %TALK)
00830 (PROG NIL
00840 LOOP (COND ((NULL %FLIST) (RETURN (QUOTE Finished-Loading)))
00850 ((%DEVP (CAR %FLIST)) (SETQ %DEV (CAR %FLIST))
00860 (SETQ %FLIST (CDR %FLIST))
00870 (GO LOOP)))
00880 (%READAFILE %DEV (CAR %FLIST) %TALK)
00890 (SETQ %FLIST (CDR %FLIST))
00900 (GO LOOP)))
00910
00920
00930 (DF DSKIN (%L) (READIN (QUOTE DSK:) %L T))
00940
00950 (DF SYSIN (%L) (READIN (QUOTE SYS:) %L NIL))
00960
00970 (DEFPROP PUTSYM
00980 (LAMBDA (L)
00990 (MAPCAR (FUNCTION (LAMBDA (X)
01000 (COND ((ATOM X) (*PUTSYM X X))
01010 (T (*PUTSYM (CAR X) (EVAL (CADR X)))))))
01020 L))
01030 FEXPR)
01040
01050 (DEFPROP GETSYM
01060 (LAMBDA (L)
01070 (MAPCAR
01080 (FUNCTION (LAMBDA (X)
01090 (PROG (V)
01100 (SETQ V (*GETSYM X))
01110 (COND (V (PUTPROP X (NUMVAL V) (CAR L)))
01120 (T (PRINT (CONS X
01130 (QUOTE (Not in
01140 Symbol
01150 Table))))))
01160 (RETURN V))))
01170 (CDR L)))
01180 FEXPR)
01190
01200
01210 (DF BREAK (%LL%)
01220 (PROG (%EX% %ICH% %OCH%)
01230 (SETQ %ICH% (INC NIL NIL))
01240 (SETQ %OCH% (OUTC NIL NIL))
01250 (PRINT (CONS (QUOTE *Break*) (CAR %LL%)))
01260 LOOP (TERPRI)
01270 (SETQ %EX% (ERRSET (READ)))
01280 (COND ((ATOM %EX%) (GO LOOP)))
01290 (COND ((EQ (CAR %EX%) *BPROCEED*) (GO END)))
01300 (ERRSET (PRIN1 (EVAL (CAR %EX%))))
01310 (GO LOOP)
01320 END (INC %ICH% NIL)
01330 (OUTC %OCH% NIL)
01340 (RETURN (EVAL (CADR %LL%)))))
01350
01360 (SETQ *BPROCEED* (QUOTE P))
01370
01380 (PROG (EX)
01390 (SETQ EX (QUOTE (LAMBDA (L)
01400 (PROG2 (SYSIN LAP)
01410 (LIST (QUOTE QUOTE) (EVAL L))))))
01420 (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
01430 (QUOTE (DEFSYM LAP OPS))))
01440
01450 (PROG (EX)
01460 (SETQ EX (QUOTE (LAMBDA (L)
01470 (PROG2 (SYSIN (LISP.SOS))
01480 (LIST (QUOTE QUOTE) (EVAL L))))))
01490 (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
01500 (QUOTE (EDFUN FILEIN))))
01510
01520 (PROG (EX)
01530 (SETQ EX (QUOTE (LAMBDA (L)
01540 (PROG2 (SYSIN TRACE)
01550 (LIST (QUOTE QUOTE) (EVAL L))))))
01560 (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
01570 (QUOTE (TRACE UNTRACE
01580 TRACET
01590 UNTRACET
01600 SLST
01610 UNSLST
01620 RESET))))
01630
01640 (DF COMMENT (L) NIL)
01650
01660 (DF DECLARE (L) (MAPC (FUNCTION EVAL) L))
01670
01680 (SETQ EIGHT (ADD1 7))
01690
01700 (SETQ TEN (PLUS 2 EIGHT))
01710
01720 (DE OCTAL NIL (SETQ BASE (SETQ IBASE EIGHT)))
01730
01740 (DE DECIMAL NIL (SETQ BASE (SETQ IBASE TEN)))
01750
01760 (DF DEFBLOCK (L) L= (BlockProg OutputFile DefiningFile)
01770 (PROG (A B)
01780 (SETQ A BPORG)
01790 (EVAL (CONS (QUOTE DSKIN) (CDDR L))) A Lap file.
01800 (WRBLK (CADR L) A (SETQ B (SUB1 BPORG))) Name A:B
01810 (PUTPROP (CAR L) (CADR L) (QUOTE FILEN))
01820 (SETQ BLKIN (CAR L))
01830 (SETQ BPORG A)
01840 (RETURN (ADD1 B))))
01850
01860 (DF EXECBLOCK (P) P= (BlockProg ...Args...)
01870 (PROG (FILEN)
01880 (COND ((EQ (CAR P) BLKIN) (GO L))
01890 ((SETQ FILEN (GET (SETQ BLKIN (CAR P))
01900 (QUOTE FILEN))))
01910 (T (PRINT (QUOTE Block-Not-Def)) (ERR)))
01920 (RDBLK FILEN NIL) NIL- DSK:, T- SYS:
01930 L (RETURN (EVAL P))))
01940
01950
01960
01970
01980 (PROG NIL (INC NIL T)
01990 (OUTC NIL T)
02000 (PRINC (QUOTE "
02010 Stanford Lisp 1.6 (Utah version) 1-May-73"))
02020 (COND ((ERRSET (INPUT INITCHAN DSK: (LISP . INI)) NIL)
02030 (%READCHAN (QUOTE INITCHAN) NIL)))
02040 (INC NIL T)
02050 (OUTC NIL T)
02060 (EXCISE)
02070 (CSYM G0000)
02080 (BAKGAG T)
02090 (NOUUO T)
02100 (ERR))