Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
00100
00200 (SETQ IBASE (ADD1 7))
00300
00400
00500 (DEFPROP SMILEFNS
00600 (NIL !X
00700 *NOPOINT
00800 BASE
00900 %DEFIN
01000 DV
01100 ENTER
01200 SPECIAL
01300 LPTOUT
01400 LPT
01500 OFF
01600 DSKOUT
01700 DSKIN
01800 GETDEF
01900 GRINL
02000 TIMER
02100 DPRINT
02200 OUTTIME
02300 UUO
02400 EDIT
02500 DEVP
02600 ALLFNS
02700 ALLVALUES
02800 LPTLENGTH)
02900 VALUE)
03000
03100 (DEFPROP !X
03200 T
03300 SPECIAL)
03400
03500 (DEFPROP *NOPOINT
03600 (NIL)
03700 VALUE)
03800
03900 (DEFPROP *NOPOINT
04000 T
04100 SPECIAL)
04200
04300 (DEFPROP BASE
04400 (NIL . 10)
04500 VALUE)
04600
04700 (DEFPROP BASE
04800 T
04900 SPECIAL)
05000
05100 (DEFPROP %DEFIN
05200 (LAMBDA(X V F P)
05300 (PROG (R)
05400 (SETQ R (COND ((GETL X (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO))) (LIST X (QUOTE REDEFINED))) (T X)))
05500 (SETQ ALLFNS (ENTER X ALLFNS))
05600 (PUTPROP X (LIST (QUOTE LAMBDA) V F) P)
05700 (RETURN R)))
05800 EXPR)
05900
06000 (DEFPROP DV
06100 (LAMBDA (%%L) (PROG2 (SETQ ALLVALUES (ENTER (CAR %%L) ALLVALUES)) (SET (CAR %%L) (CADR %%L))))
06200 FEXPR)
06300
06400 (DEFPROP ENTER
06500 (LAMBDA (X L) (COND ((MEMBER X L) L) (T (CONS X L))))
06600 EXPR)
06700
06800 (DEFPROP SPECIAL
06900 (LAMBDA(L)
07000 (MAPC (FUNCTION (LAMBDA (!X) (PROG2 (SET (CAR L) (ENTER !X (EVAL (CAR L)))) (PUTPROP !X T (QUOTE SPECIAL)))))
07100 (CDR L)))
07200 FEXPR)
07300
07400 (DEFPROP LPTOUT
07500 (LAMBDA (L) (PROG NIL (LPT) (MAPC (FUNCTION EVAL) L) (OFF)))
07600 FEXPR)
07700
07800 (DEFPROP LPT
07900 (LAMBDA NIL
08000 (PROG NIL
08100 L (COND
08200 ((NULL (ERRSET (OUTC (OUTPUT LPT:) T) NIL)) (TERPRI)
08300 (PRINC
08400 (QUOTE
08500 "LPT IN USE, TYPE ALTMODE TO TRY AGAIN, BELL TO GIVE UP")
08600 ) (READCH)
08700 (GO L)))
08800 (OUTTIME)
08900 (LINELENGTH LPTLENGTH)))
09000 EXPR)
09100
09200 (DEFPROP OFF
09300 (LAMBDA NIL (OUTC NIL T))
09400 EXPR)
09500
09600 (DEFPROP DSKOUT
09700 (LAMBDA(%%L)
09800 (PROG (%%D)
09900 (COND ((DEVP (SETQ %%D (CAR %%L))) (SETQ %%L (CDR %%L))) (T (SETQ %%D (QUOTE DSK:))))
10000 (EVAL (LIST (QUOTE OUTPUT) %%D (CAR %%L)))
10100 (OUTC T T)
10200 (LINELENGTH LPTLENGTH)
10300 (MAPC (FUNCTION EVAL) (CDR %%L))
10400 (OFF)))
10500 FEXPR)
10600
10700 (DEFPROP DSKIN
10800 (LAMBDA(%L)
10900 (PROG (%X %%D)
11000 (SETQ %%D (QUOTE DSK:))
11100 L1 (COND ((NULL %L) (RETURN (QUOTE ***)))
11200 ((DEVP (CAR %L)) (SETQ %%D (CAR %L)) (SETQ %L (CDR %L)) (GO L1)))
11300 (EVAL (LIST (QUOTE INPUT) %%D (CAR %L)))
11400 (INC T)
11500 L2 (SETQ %X (ERRSET (READ) T))
11600 (COND ((ATOM (SETQ %X (CAR %X))) (SETQ %L (CDR %L)) (GO L1))
11700 ((AND (NOT (ATOM %X))
11800 (EQ (CAR %X) (QUOTE DEFPROP))
11900 (MEMQ (CADDDR %X) (QUOTE (EXPR FEXPR MACRO)))
12000 (GETL (CADR %X) (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO))))
12100 (PRINT (LIST (CADR %X) (QUOTE REDEFINED)))))
12200 (EVAL %X)
12300 (GO L2)))
12400 FEXPR)
12500
12600 (DEFPROP GETDEF
12700 (LAMBDA(%L)
12800 (PROG (%X %%D)
12900 (COND ((DEVP (CAR %L)) (SETQ %%D (CAR %L)) (SETQ %L (CDR %L))) (T (SETQ %%D (QUOTE DSK:))))
13000 (EVAL (LIST (QUOTE INPUT) %%D (CAR %L)))
13100 (INC T)
13200 %L (SETQ %X (ERRSET (READ) T))
13300 (COND ((ATOM (SETQ %X (CAR %X))) (RETURN (QUOTE ***)))
13400 ((AND (NOT (ATOM %X)) (EQ (CAR %X) (QUOTE DEFPROP)) (MEMQ (CADR %X) (CDR %L)))
13500 (PRINT (EVAL %X))))
13600 (GO %L)))
13700 FEXPR)
13800
13900 (DEFPROP GRINL
14000 (LAMBDA(%L)
14100 (PROG NIL
14200 (PRINT (LIST (QUOTE SETQ) (QUOTE IBASE) (LIST (QUOTE ADD1) (SUB1 BASE))))
14300 (TERPRI)
14400 (EVAL (CONS (QUOTE GRINDEF) (CONS (CAR %L) (EVAL (CAR %L)))))))
14500 FEXPR)
14600
14700 (DEFPROP TIMER
14800 (LAMBDA(%L)
14900 (PROG (%TIME %CONS %GC)
15000 (GC)
15100 (SETQ %TIME (TIME NIL))
15200 (SETQ %CONS (SPEAK))
15300 (SETQ %GC (GCTIME))
15400 (MAPC (FUNCTION EVAL) %L)
15500 (DPRINT
15600 (LIST (*DIF (TIME NIL) %TIME)
15700 (QUOTE MSEC)
15800 (*DIF (SPEAK) %CONS)
15900 (QUOTE CONSES)
16000 (*DIF (GCTIME) %GC)
16100 (QUOTE GCTIME)))))
16200 FEXPR)
16300
16400 (DEFPROP DPRINT
16500 (LAMBDA (X) (PROG (BASE) (SETQ BASE 12) (RETURN (PRINT X))))
16600 EXPR)
16700
16800 (DEFPROP OUTTIME
16900 (LAMBDA NIL
17000 (PROG (X BASE *NOPOINT)
17100 (SETQ *NOPOINT T)
17200 (SETQ BASE 12)
17300 (TERPRI)
17400 (PRINC (QUOTE LISP-OUTPUT/ / ))
17500 (SETQ X (*QUO (UUO 23) 165140))
17600 (PRIN1 (*QUO X 74))
17700 (PRIN1 (QUOTE :))
17800 (PRIN1 (REMAINDER X 74))
17900 (PRINC (QUOTE / / ))
18000 (SETQ X (UUO 14))
18100 (PRIN1 (ADD1 (REMAINDER X 37)))
18200 (PRINC (QUOTE /-))
18300 (SETQ X (*QUO X 37))
18400 (PRIN1
18500 (CDR
18600 (ASSOC (REMAINDER X 14)
18700 (QUOTE
18800 ((0 . JAN) (1 . FEB)
18900 (2 . MAR)
19000 (3 . APR)
19100 (4 . MAY)
19200 (5 . JUN)
19300 (6 . JUL)
19400 (7 . AUG)
19500 (10 . SEP)
19600 (11 . OCT)
19700 (12 . NOV)
19800 (13 . DEC))))))
19900 (PRINC (QUOTE /-))
20000 (SETQ X (*QUO X 14))
20100 (PRIN1 (PLUS X 100))
20200 (TERPRI)
20300 (TERPRI)))
20400 EXPR)
20500
20600 (DEFPROP UUO
20700 (LAMBDA(N)
20800 (PROG NIL
20900 (PUTPROP (QUOTE UUO) (NUMVAL BPORG) (QUOTE SUBR))
21000 (DEPOSIT BPORG (PLUS 260600000000 (GET (QUOTE NUMVAL) (QUOTE SYM))))
21100 (DEPOSIT (ADD1 BPORG) 47041000000)
21200 (SETQ BPORG (PLUS BPORG 3))
21300 (DEPOSIT (SUB1 BPORG) (PLUS 254000000000 (GET (QUOTE FIX1A) (QUOTE SYM))))
21400 (RETURN (UUO N))))
21500 EXPR)
21600
21700 (DEFPROP EDIT
21800 (LAMBDA(%%L)
21900 (PROG (%%A %%X %%P)
22000 (SETQ %%A (CAR %%L))
22100 (COND ((SETQ %%X (GET %%A (QUOTE EXPR))) (SETQ %%P (QUOTE EXPR)) (GO L1))
22200 ((SETQ %%X (GET %%A (QUOTE FEXPR))) (SETQ %%P (QUOTE FEXPR)) (GO L1))
22300 (T (SETQ %%X (SUBST 0 0 (CADDR %%A))) (SETQ %%P (CADR %%A))))
22400 L1 (SETQ %%P (PUTPROP %%A (SUBST (CADDR %%L) (CADR %%L) %%X) %%P))
22500 (RETURN (NOT (EQUAL %%P %%X)))))
22600 FEXPR)
22700
22800 (DEFPROP DEVP
22900 (LAMBDA (X) (OR (EQ (CAR (LAST (EXPLODE X))) (QUOTE :)) (AND (NOT (ATOM X)) (NOT (ATOM (CDR X))))))
23000 EXPR)
23100
23200 (DEFPROP ALLFNS
23300 (NIL)
23400 VALUE)
23500
23600 (DEFPROP ALLVALUES
23700 (NIL)
23800 VALUE)
23900
24000 (DEFPROP LPTLENGTH
24100 (NIL . 160)
24200 VALUE)