00100	(DEFPROP %DEFIN
00200	(LAMBDA (X V F P)
00300	(PROG (R)
00400	  (SETQ R (COND ((GETL X
00500	    (QUOTE (EXPR FEXPR SAIBR SUBR FSUBR LSUBR MACRO)))
00600		(LIST X (QUOTE REDEFINED)))
00700		(T X)))
00800		(PUTPROP X (LIST (QUOTE LAMBDA) V F) P)
00900		(RETURN R)))
01000	EXPR)
01100	
01200	(DEFPROP DE
01300	 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE EXPR)))
01400	 FEXPR)
01500	
01600	(DEFPROP DF
01700	 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE FEXPR)))
01800	 FEXPR)
01900	
02000	(DEFPROP DM
02100	 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE MACRO)))
02200	 FEXPR)
02300	
02400	(DEFPROP DS
02500	 (LAMBDA (L) (PUTPROP(CAR L)(NUMVAL(*GETSYM(CAR L)))(QUOTE SAIBR)))
02600	FEXPR)
02700	
02800	(DEFPROP PLUS (LAMBDA (L) (*EXPAND L (QUOTE *PLUS))) MACRO)
02900	
03000	(DEFPROP DIFFERENCE (LAMBDA (L) (*EXPAND L (QUOTE *DIF))) MACRO)
03100	
03200	(DEFPROP TIMES (LAMBDA (L) (*EXPAND L (QUOTE *TIMES))) MACRO)
03300	
03400	(DEFPROP QUOTIENT (LAMBDA (L) (*EXPAND L (QUOTE *QUO))) MACRO)
03500	
03600	(DEFPROP LESSP
03700	 (LAMBDA (L)
03800	  (LIST	(QUOTE *LESS)
03900		(*EXPAND1 (CDR (REVERSE (CDR L)))
04000			  (QUOTE (LAMBDA (X Y)
04100					 (COND ((AND X (*LESS X Y)) Y)))))
04200		(CAR (LAST L))))
04300	 MACRO)
04400	
     

00100	(DEFPROP GREATERP
00200	 (LAMBDA (L)
00300	  (LIST	(QUOTE *GREAT)
00400		(*EXPAND1 (CDR (REVERSE (CDR L)))
00500			  (QUOTE (LAMBDA (X Y)
00600					 (COND ((AND X (*GREAT X Y)) Y)))))
00700		(CAR (LAST L))))
00800	 MACRO)
00900	
01000	(DEFPROP %DEVP
01100		 (LAMBDA (X)
01200			 (OR (EQ (CAR (LAST (EXPLODE X))) (QUOTE :))
01300			     (AND (NOT (ATOM X)) (NOT (ATOM (CDR X))))))
01400		 EXPR)
01500	
     

01600	(DE %READCHAN (%CHAN %TALK)
01700		      (PROG (%OLDCHAN %SEXPR)
01800			    (SETQ %OLDCHAN (INC %CHAN NIL))
01900		       LOOP (SETQ %SEXPR (ERRSET (READ)))
02000			    (COND ((EQ (CAR %SEXPR) (QUOTE COMMENT))
02100				   (PROG (%XCH)
02200					A
02300					(SETQ %XCH (READCH))
02400					(AND (EQ %XCH (QUOTE /;))
02500					     (RETURN))
02600					(GO A) )
02700				   (GO LOOP)) )
02800			    (COND ((ATOM %SEXPR) (GO END)))
02900			    (SETQ %SEXPR (EVAL (CAR %SEXPR)))
03000			    (COND (%TALK (PRINT %SEXPR)))
03100			    (GO LOOP)
03200		       END  (INC %OLDCHAN T)
03300			    (RETURN NIL)))
03400	
03500	(DE %READAFILE (%DEV %FNAM %TALK)
03600	 (%READCHAN (EVAL (LIST (QUOTE INPUT) (GENSYM) %DEV %FNAM)) %TALK))
03700	
03800	(DE READIN (%DEV %FLIST %TALK)
03900	    (PROG NIL
04000	     LOOP (COND	((NULL %FLIST) (RETURN (QUOTE FINISHED-LOADING)))
04100			((%DEVP (CAR %FLIST)) (SETQ %DEV (CAR %FLIST))
04200					      (SETQ %FLIST (CDR %FLIST))
04300					      (GO LOOP)))
04400		  (%READAFILE %DEV (CAR %FLIST) %TALK)
04500		  (SETQ %FLIST (CDR %FLIST))
04600		  (GO LOOP)))
04700	
04800	(DF DSKIN (%L) (READIN (QUOTE DSK:) %L T))
04900	
05000	(DF SYSIN (%L) (READIN (QUOTE SYS:) %L NIL))
05100	
05200	(DEFPROP PUTSYM
05300	 (LAMBDA (L)
05400	  (MAPCAR (FUNCTION (LAMBDA (X)
05500			     (COND ((ATOM X) (*PUTSYM X X))
05600				   (T (*PUTSYM (CAR X) (EVAL (CADR X)))))))
05700		  L))
05800	 FEXPR)
05900	
     

00100	(DEFPROP GETSYM
00200	 (LAMBDA (L)
00300	  (MAPCAR
00400	   (FUNCTION (LAMBDA (X)
00500		      (PROG (V)
00600			    (SETQ V (*GETSYM X))
00700			    (COND (V (PUTPROP X (NUMVAL V) (CAR L)))
00800				  (T (PRINT (CONS X
00900						  (QUOTE (NOT IN
01000							      SYMBOL
01100							      TABLE))))))
01200			    (RETURN V))))
01300	   (CDR L)))
01400	 FEXPR)
01500	
01600	(DF BREAK (%LL%)
01700		  (PROG (%EX% %ICH% %OCH%)
01800			(SETQ %ICH% (INC NIL NIL))
01900			(SETQ %OCH% (OUTC NIL NIL))
02000			(PRINT (CONS (QUOTE *BREAK*) (CAR %LL%)))
02100		   LOOP	(TERPRI)
02200			(SETQ %EX% (ERRSET (READ)))
02300			(COND ((ATOM %EX%) (GO LOOP)))
02400			(COND ((EQ (CAR %EX%) *BPROCEED*) (GO END)))
02500			(ERRSET (PRIN1 (EVAL (CAR %EX%))))
02600			(GO LOOP)
02700		   END	(INC %ICH% NIL)
02800			(OUTC %OCH% NIL)
02900			(RETURN (EVAL (CADR %LL%)))))
03000	
03100	(SETQ *BPROCEED* (QUOTE P))
03200	
03300	(PROG (EX)
03400	      (SETQ EX (QUOTE (LAMBDA (L)
03500			       (PROG2 (SYSIN LAP)
03600				      (LIST (QUOTE QUOTE) (EVAL L))))))
03700	      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
03800		    (QUOTE (DEFSYM LAP OPS))))
03900	
04000	(PROG (EX)
04100	      (SETQ EX (QUOTE (LAMBDA (L)
04200			       (PROG2 (SYSIN (SOSLNK.LAP))
04300				      (LIST (QUOTE QUOTE) (EVAL L))))))
04400	      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
04500		    (QUOTE (EDFUN FILEIN))))
04600	
     

00100	(PROG (EX)
00200	      (SETQ EX (QUOTE (LAMBDA (L)
00300			       (PROG2 (SYSIN TRACE)
00400				      (LIST (QUOTE QUOTE) (EVAL L))))))
00500	      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
00600		    (QUOTE (TRACE UNTRACE
00700				  TRACET
00800				  UNTRACET
00900				  SLST
01000				  UNSLST
01100				  RESET))))
01200	
01300	(DF COMMENT (L) NIL)
01400	
01500	(DF DECLARE (L) NIL)
01600	
01700	(SETQ EIGHT (ADD1 7))
01800	
01900	(SETQ TEN (PLUS 2 EIGHT))
02000	
02100	(DE OCTAL NIL (SETQ BASE (SETQ IBASE EIGHT)))
02200	
02300	(DE DECIMAL NIL (SETQ BASE (SETQ IBASE TEN)))
02400	
02500	(COND ((NULL (ERRSET (INPUT INITCHAN DSK: (LISP . INI)) NIL)))
02600	      (T (%READCHAN (QUOTE INITCHAN) NIL)))
02700	
02800	(PROG NIL (INC NIL T) (OUTC NIL T) (EXCISE) (CSYM G0000) (ERR))