00100	SUBTTL ATOMS
00200	;LISP ATOMS AND OBLIST.
00300	
00400	ATOMS:
00500	
00600	;Make an Atom.
00700	
00800		DEFINE MKAT '(name,type,C,D){
00900		D	XWD -1,.+1
01000			XWD type,.+1
01100			XWD C'name,0
01200			ASCII/name/
01300		}
01400		DEFINE MKAT1 '(iname,type,oname,C){
01600			XWD -1,.+1
01700			XWD type,.+1
01800			XWD C'iname,0
01900			ASCII/oname/
02000		}
02100	
02200	;Make Labels.
02300	
02400		DEFINE ML(name){
02500		name:	XWD -1,0
02600			ASCII/name/
02700		}
02800	
02900	
     

00100	;All the Value Cells.
00200		VNIL:	NIL
00300		%NOPOINT: NIL
00400		VTRUTH:	TRUTH
00500	FOO	VOBLIST: ATOMS-bckets
00600		VBASE:	8+INUM0
00700		VIBASE:	8+INUM0
00800		VBPORG:	INUM0
00900		VBPEND:	INUM0
01000		
01100	;The atom prototype of NIL.
01200	;0:	-1,.+1			;Atom Head in Accumulator 0.
01300	CNIL2:	XWD VALUE,.+1
01400		XWD VNIL,0
01500		ASCII/NIL/
01600	
01700	;The atom prototype of T.
01800	TRUTH:	XWD -1,.+1
01900		XWD VALUE,.+1
02000		XWD VTRUTH,0
02100		ASCII/T/
     

00100		MKAT RPLACA,SUBR
00200		MKAT RPLACD,SUBR
00300		MKAT MINUS,SUBR
00400		MKAT TERPRI,SUBR
00500		MKAT READ,SUBR
00600	
00700		MKAT1 CAR.,SUBR,CAR
00800		MKAT1 CDR.,SUBR,CDR
00900		MKAT1 DIP.,SUBR,DIP
01000		MKAT1 DAP.,SUBR,DAP
01100	
01200		MKAT CAAR,SUBR
01300		MKAT CADR,SUBR
01400		MKAT CDAR,SUBR
01500		MKAT CDDR,SUBR
01600	
01700		MKAT CAAAR,SUBR
01800		MKAT CAADR,SUBR
01900		MKAT CADAR,SUBR
02000		MKAT CADDR,SUBR
02100		MKAT CDAAR,SUBR
02200		MKAT CDADR,SUBR
02300		MKAT CDDAR,SUBR
02400		MKAT CDDDR,SUBR
02500	
02600		MKAT CAAAAR,SUBR
02700		MKAT CAAADR,SUBR
02800		MKAT CAADAR,SUBR
02900		MKAT CAADDR,SUBR
03000		MKAT CADAAR,SUBR
03100		MKAT CADADR,SUBR
03200		MKAT CADDAR,SUBR
03300		MKAT CADDDR,SUBR
03400		MKAT CDAAAR,SUBR
03500		MKAT CDAADR,SUBR
03600		MKAT CDADAR,SUBR
03700		MKAT CDADDR,SUBR
03800		MKAT CDDAAR,SUBR
03900		MKAT CDDADR,SUBR
04000		MKAT CDDDAR,SUBR
04100		MKAT CDDDDR,SUBR
04200	
04300		MKAT MAKNUM,SUBR
04400		MKAT CONS,SUBR
04500		MKAT1 FIX1A,SUBR,ADDR
     

00100		MKAT ATOM,SUBR
00200		MKAT EQ,SUBR
00300		MKAT PRIN1,SUBR
00400		MKAT PRINT,SUBR
00500		MKAT RETURN,SUBR
00600	
00700		MKAT EXPLODE,SUBR
00800		MKAT SASSOC,SUBR
00900		MKAT ASSOC,SUBR
01000		MKAT GCGAG,SUBR
01100		MKAT CHRCT,SUBR
01200	
01300		MKAT LINELENGTH,SUBR
01400		MKAT NUMBERP,SUBR
01500		MKAT EQUAL,SUBR
01600		MKAT GET,SUBR
01700		MKAT INTERN,SUBR
01800	
01900		MKAT MEMBER,SUBR
02000		MKAT ED,SUBR
02100		MKAT MAKNAM,SUBR
02200		MKAT READCH,SUBR
02300		MKAT NOT,SUBR
02400	
02500		MKAT NULL,SUBR
02600		MKAT GENSYM,SUBR
02700		MKAT ZEROP,SUBR
02800		MKAT DIVIDE,SUBR
02900		MKAT GCD,SUBR
03000	
03100		MKAT TIME,SUBR
03200		MKAT FIX,SUBR
03300		MKAT SET,SUBR
03400		MKAT PROG2,SUBR
03500		MKAT LENGTH,SUBR
03600	
03700		MKAT READLIST,SUBR
03800		MKAT LAST,SUBR
03900		MKAT ADD1,SUBR
04000		MKAT SUB1,SUBR
04100		MKAT GCTIME,SUBR
04200	
04300		MKAT REVERSE,SUBR
04400		MKAT SPEAK,SUBR
04500		MKAT MAPLIST,SUBR
     

00100		MKAT GC,SUBR
00200		MKAT GETL,SUBR
00300		MKAT BAKGAG,SUBR
00400		MKAT MEMQ,SUBR
00500		MKAT PUTPROP,SUBR
00600	
00700		MKAT PRINC,SUBR
00800		MKAT FLATSIZE,SUBR
00900		MKAT ERR,SUBR
01000		MKAT MAPCAR,SUBR
01100		MKAT EXAMINE,SUBR
01200	
01300		MKAT DEPOSIT,SUBR
01400		MKAT LSH,SUBR
01500		MKAT NCONS,SUBR
01600		MKAT XCONS,SUBR
01700		MKAT REMPROP,SUBR
01800	
01900		MKAT ARG,SUBR
02000		MKAT SETARG,SUBR
02100		MKAT NOUUO,SUBR
02200		MKAT MINUSP,SUBR
02300	 	MKAT MAP,SUBR
02400	
02500		MKAT MAPC,SUBR
02600		MKAT OUTC,SUBR
02700		MKAT INC,SUBR
02800		MKAT DDTIN,SUBR
02900		MKAT INITFN,SUBR
03000	
03100		MKAT EXCISE,SUBR
03200		MKAT REMAINDER,SUBR
03300		MKAT ABS,SUBR
03400		MKAT PGLINE,SUBR
03500		MKAT SAIL,SUBR
     

00100		MKAT EXPLODEC,SUBR,%
00200		MKAT TYO,SUBR,I
00300		MKAT TYI,SUBR,I
00400	CEVAL:	MKAT1 EVAL,SUBR,*EVAL
00600	
00700		MKAT LIST,FSUBR
00800		MKAT COND,FSUBR
00900		MKAT PROG,FSUBR
01000		MKAT SETQ,FSUBR
01100		MKAT OUTPUT,FSUBR
01200		MKAT GRINDEF,FSUBR
01300	
01400		MKAT ERRSET,FSUBR
01500		MKAT REMOB,FSUBR
01600		MKAT OR,FSUBR
01700		MKAT GO,FSUBR
01800		MKAT ARRAY,FSUBR
01900		MKAT STORE,FSUBR
02000	
02100		MKAT AND,FSUBR
02200		MKAT DEFPROP,FSUBR
02300		MKAT CSYM,FSUBR
02400		MKAT EXARRAY,FSUBR
02500	
02600		MKAT1 QUOTE,FSUBR,FUNCTION
02700		mkat1 INPUT,FSUBR,INPUT
02800		MKAT1 SUBST,SUBR,SUBST
02900		MKAT1 FUNCT,FSUBR,*FUNCTION
03000	
03100		MKAT APPEND,LSUBR
03200		MKAT NCONC,LSUBR
03300		MKAT BOOLE,LSUBR
03400		MKAT APPLY,LSUBR
03500	
03600		MKAT EVAL,LSUBR,O
03700		MKAT ASCII,SUBR,A
03800		MKAT QUOTE,FSUBR,,CQUOTE:
03900		MKAT INUM0,SYM
     

00100		MKAT1 LCALL,SYM,*LCALL,INUM0+%
00200		MKAT1 AMAKE,SYM,*AMAKE,INUM0+%
00300		MKAT1 UDT,SYM,*UDT,INUM0+%
00400		MKAT1 %NOPOINT,VALUE,*NOPOINT
00500	UNBOUND: XWD -1,0↔ASCII/UNBOUND/
00600	
00700		MKAT1 EXPN1,SUBR,*EXPAND1
00800		MKAT1 EXPAND,SUBR,*EXPAND
00900	
01000		MKAT1 PLUS,SUBR,*PLUS,.
01100		MKAT1 DIF,SUBR,*DIF,.
01200		MKAT1 QUO,SUBR,*QUO,.
01300		MKAT1 TIMES,SUBR,*TIMES,.
01400	
01500		MKAT1 APPEND,SUBR,*APPEND,.
01600		MKAT1 RSET,SUBR,*RSET,.
01700		MKAT1 GREAT,SUBR,*GREAT,.
01800		MKAT1 LESS,SUBR,*LESS,.
01900	
02000		MKAT1 PUTSYM,SUBR,*PUTSYM
02100		MKAT1 GETSYM,SUBR,*GETSYM
02150		mkat XSYM,SUBR
02175		mkat XHALF,SUBR
02200	
02300		VSPECBIND←INUM0+SPECBIND
02400		MKAT SPECBIND,SYM,V
02500	
02600		VSPECSTR←INUM0+SPECSTR
02700		MKAT SPECSTR,SYM,V
02800	
02900		VFIX1A←INUM0+FIX1A
03000		MKAT FIX1A,SYM,V
03100	
03200		VNSTR←INUM0+NSTR
03300		MKAT NSTR,SYM,V
     

00100		XWD -1,.+1
00200		XWD SUBR,.+1
00300		XWD NUMVAL,.+1
00400		XWD SYM,.+1
00500		XWD NUMVAL+INUM0,0
00600		ASCII/NUMVAL/
00700	
00800		MKAT OBLIST,VALUE,V
00900		MKAT BASE,VALUE,V
01000		MKAT IBASE,VALUE,V
01100		MKAT BPEND,VALUE,V
01200		MKAT BPORG,VALUE,V
01300	
01400		ML PNAME
01500		ML FIXNUM
01600		ML FLONUM
01700		ML VALUE
01800		ML LAMBDA
01900		ML SUBR
02000		ML SAIBR
02100		ML FSUBR
02200		ML EXPR
02300		ML FEXPR
02400		ML SYM
02500		ML $EOF$
02600		ML LABEL
02700		ML FUNARG
02800		ML LSUBR
02900		ML MACRO
03000	
03100	LAMBD.: XWD -1,0↔ASCII/λ/
03200	QST:	XWD -1,0↔ASCII/?/
03300	
03400	ATOME:	-1 ;End of the atoms.
     

00100	;The FOO list is for fixing up references to HWS.
00200	
00300		DEFINE GARP $(A,B)
00400		<XWD FOO$A,FOO$B>
00500	
00600	FOO	0
00700	FOO	0
00800	FOOLST:
00900		XLIST
01000		FOR I←0,(FOOCNT-2),2{
01100		GARP (→I,→(I+1))
01200		}
01300	LIST
01400	
01500	EFOLST:
01600	
01700	END