perm filename ATOMS.FAI[LSP,BGB]1 blob
sn#001395 filedate 1972-11-05 generic text, type T, neo UTF8
00100 SUBTTL ATOMS
00200 ;LISP ATOMS AND OBLIST.
00400
00500 FS:
00600 OBTBL:
00700 OBLIST:
00800
00900 ;Make a list of hash buckets.
01000
01100 For @' i←0,<Bckets-2>{
01200 DEFINE OBT'i <..'i←.>
01300 XWD ..'i,.+1
01400 }
01500 For @' i←<Bckets-1>,<Bckets-1>{
01600 DEFINE OBT'i <..'i←.>
01700 XWD ..'i,0
01800 }
01900
02000 ;Place an atom name and address into its hash bucket.
02100
02200 QQ←←Bckets
02300 DEFINE PUTOB(name,addr){
02400 YY ←← ZZ ←← <ASCII/name/>⊗-1
02500 ZZ ←← ZZ-((ZZ/Bckets)*Bckets)
02600 QQ ←← QQ+1
02700 FOR @$ i←ZZ,ZZ{
02800 OBT$i
02900 FOR @' j←QQ,QQ{
03000 DEFINE OBT$i <..'j←.>
03100 XWD addr,..'j
03200 }}}
03300
00100 ;Make PNAME list of Full Words of ASCII.
00200
00300 DEFINE PNWORD(word,ptr) {XWD[word],ptr}
00400 DEFINE PNLIST(name){
00500 cnt ←← 0
00600 For dummyε{name}<cnt←cnt+1↔>
00700 cnt ← (cnt-1)/5
00800 j←←0
00900 For @' a,bε{name}{
01000 IFE j,{
01100 IFN cnt,{PNWORD(ASCII/a'b/,.+1)}
01200 IFE cnt,{PNWORD(ASCII/a'b/,0)}
01300 cnt←←cnt-1↔j←←5}
01400 j←←j-1
01500 }}
01600
01700 ;Make an Atom.
01800
01900 DEFINE MKAT '(name,type,C,D){
02000 PUTOB name,.+1
02100 D XWD -1,.+1
02200 XWD type,.+1
02300 XWD C'name,.+1
02400 XWD PNAME,.+1
02500 XWD .+1,0
02600 PNLIST(name)
02700 }
02800 DEFINE MKAT1 '(iname,type,oname,C){
02900 PUTOB oname,.+1
03000 XWD -1,.+1
03100 XWD type,.+1
03200 XWD C'iname,.+1
03300 XWD PNAME,.+1
03400 XWD .+1,0
03500 PNLIST(oname)
03600 }
03700
03800 ;Make Labels.
03900
04000 DEFINE ML(name){
04100 PUTOB name,.+1
04200 name: XWD -1,.+1
04300 XWD PNAME,.+1
04400 XWD .+1,0
04500 PNLIST(name)
04600 }
00100 MKAT RPLACA,SUBR
00200 MKAT RPLACD,SUBR
00300 MKAT MINUS,SUBR
00400 MKAT TERPRI,SUBR
00500 MKAT READ,SUBR
00600 MKAT CAR,SUBR
00700 MKAT CDR,SUBR
00800 MKAT CAAR,SUBR
00900 MKAT CADR,SUBR
01000 MKAT CDAR,SUBR
01100 MKAT CDDR,SUBR
01200 MKAT CAAAR,SUBR
01300 MKAT CAADR,SUBR
01400 MKAT CADAR,SUBR
01500 MKAT CADDR,SUBR
01600 MKAT CDAAR,SUBR
01700 MKAT CDADR,SUBR
01800 MKAT CDDAR,SUBR
01900 MKAT CDDDR,SUBR
02000 MKAT CAAAAR,SUBR
02100 MKAT CAAADR,SUBR
02200 MKAT CAADAR,SUBR
02300 MKAT CAADDR,SUBR
02400 MKAT CADAAR,SUBR
02500 MKAT CADADR,SUBR
02600 MKAT CADDAR,SUBR
02700 MKAT CADDDR,SUBR
02800 MKAT CDAAAR,SUBR
02900 MKAT CDAADR,SUBR
03000 MKAT CDADAR,SUBR
03100 MKAT CDADDR,SUBR
03200 MKAT CDDAAR,SUBR
03300 MKAT CDDADR,SUBR
03400 MKAT CDDDAR,SUBR
03500 MKAT CDDDDR,SUBR
03600 MKAT MAKNUM,SUBR
03700 MKAT CONS,SUBR
00100 MKAT ATOM,SUBR
00200 MKAT EQ,SUBR
00300 MKAT PRIN1,SUBR
00400 MKAT PRINT,SUBR
00500 MKAT RETURN,SUBR
00600 MKAT EXPLODE,SUBR
00700 MKAT SASSOC,SUBR
00800 MKAT ASSOC,SUBR
00900 MKAT GCGAG,SUBR
01000 MKAT CHRCT,SUBR
01100 MKAT LINELENGTH,SUBR
01200 MKAT NUMBERP,SUBR
01300 MKAT EQUAL,SUBR
01400 MKAT GET,SUBR
01500 MKAT INTERN,SUBR
01600 MKAT MEMBER,SUBR
01700 MKAT ED,SUBR
01800 MKAT MAKNAM,SUBR
01900 MKAT READCH,SUBR
02000 MKAT NOT,SUBR
02100 MKAT NULL,SUBR
02200 MKAT GENSYM,SUBR
02300 MKAT ZEROP,SUBR
02400 MKAT DIVIDE,SUBR
02500 MKAT GCD,SUBR
02600 MKAT TIME,SUBR
02700 MKAT FIX,SUBR
02800 MKAT SET,SUBR
02900 MKAT PROG2,SUBR
03000 MKAT LENGTH,SUBR
03100 MKAT READLIST,SUBR
03200 MKAT LAST,SUBR
03300 MKAT ADD1,SUBR
03400 MKAT SUB1,SUBR
03500 MKAT GCTIME,SUBR
03600 MKAT REVERSE,SUBR
03700 MKAT SPEAK,SUBR
03800 MKAT MAPLIST,SUBR
00100 MKAT GC,SUBR
00200 MKAT GETL,SUBR
00300 MKAT BAKGAG,SUBR
00400 MKAT MEMQ,SUBR
00500 MKAT PUTPROP,SUBR
00600 MKAT PRINC,SUBR
00700 MKAT FLATSIZE,SUBR
00800 MKAT ERR,SUBR
00900 MKAT MAPCAR,SUBR
01000 MKAT EXAMINE,SUBR
01100 MKAT DEPOSIT,SUBR
01200 MKAT LSH,SUBR
01300 MKAT NCONS,SUBR
01400 MKAT XCONS,SUBR
01500 MKAT REMPROP,SUBR
01600 MKAT ARG,SUBR
01700 MKAT SETARG,SUBR
01800 MKAT NOUUO,SUBR
01900 MKAT MINUSP,SUBR
02000 MKAT MAP,SUBR
02100 ; MKAT MAPC,SUBR
02200 MKAT OUTC,SUBR
02300 MKAT INC,SUBR
02400 MKAT DDTIN,SUBR
02500 MKAT INITFN,SUBR
02600 MKAT EXCISE,SUBR
02700 MKAT REMAINDER,SUBR
02800 MKAT ABS,SUBR
02900 MKAT PGLINE,SUBR
03000 MKAT SAIL,SUBR
00100 MKAT EXPLODEC,SUBR,%
00200 MKAT TYO,SUBR,I
00300 MKAT TYI,SUBR,I
00400 CEVAL←.+1
00500 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 INPOT,FSUBR,INPUT
02800 MKAT1 SOBST,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 PUTOB T,.+1
00200 TRUTH: XWD -1,.+1
00300 XWD VALUE,.+1
00400 XWD VTRUTH,.+1
00500 XWD PNAME,.+1
00600 XWD .+1,0
00700 PNLIST T
00800 VTRUTH: TRUTH
00900
01000 PUTOB NIL,0
01100 CNIL2: XWD VALUE,.+1
01200 XWD VNIL,.+1
01300 XWD PNAME,.+1
01400 XWD .+1,0
01500 PNLIST NIL
01600 VNIL: NIL
01700
01800 MKAT1 LCALL,SYM,*LCALL,INUM0+%
01900 MKAT1 AMAKE,SYM,*AMAKE,INUM0+%
02000 MKAT1 UDT,SYM,*UDT,INUM0+%
02100 MKAT1 %NOPOINT,VALUE,*NOPOINT
02200 %NOPOINT: NIL
02300
02400
02500 UNBOUND: XWD -1,.+1
02600 XWD PNAME,.+1
02700 XWD .+1,0
02800 PNLIST UNBOUND
00100 MKAT1 EXPN1,SUBR,*EXPAND1
00200 MKAT1 EXPAND,SUBR,*EXPAND
00300 MKAT1 PLUS,SUBR,*PLUS,.
00400 MKAT1 DIF,SUBR,*DIF,.
00500 MKAT1 QUO,SUBR,*QUO,.
00600 MKAT1 TIMES,SUBR,*TIMES,.
00700 MKAT1 APPEND,SUBR,*APPEND,.
00800 MKAT1 RSET,SUBR,*RSET,.
00900 MKAT1 GREAT,SUBR,*GREAT,.
01000 MKAT1 LESS,SUBR,*LESS,.
01100 MKAT1 PUTSYM,SUBR,*PUTSYM
01200 MKAT1 GETSYM,SUBR,*GETSYM
00100 VSPECBIND←INUM0+SPECBIND
00200 MKAT SPECBIND,SYM,V
00300
00400 VSPECSTR←INUM0+SPECSTR
00500 MKAT SPECSTR,SYM,V
00600
00700 VFIX1A←INUM0+FIX1A
00800 MKAT FIX1A,SYM,V
00900
01000 VNSTR←INUM0+NSTR
01100 MKAT NSTR,SYM,V
00100 PUTOB NUMVAL,.+1
00200 XWD -1,.+1
00300 XWD SUBR,.+1
00400 XWD NUMVAL,.+1
00500 XWD SYM,.+1
00600 XWD NUMVAL+INUM0,.+1
00700 XWD PNAME,.+1
00800 XWD .+1,0
00900 PNLIST NUMVAL
01000
01100 MKAT OBLIST,VALUE,V
01200 MKAT BASE,VALUE,V
01300 MKAT IBASE,VALUE,V
01400 MKAT BPEND,VALUE,V
01500 MKAT BPORG,VALUE,V
01600
01700 VOBLIST: OBLIST
01800 VBASE: 8+INUM0
01900 VIBASE: 8+INUM0
02000
00100
00200 ML PNAME
00300 ML FIXNUM
00400 ML FLONUM
00500 ML VALUE
00600 ML LAMBDA
00700 ML SUBR
00800 ML SAIBR
00900 ML FSUBR
01000 ML EXPR
01100 ML FEXPR
01200 ML SYM
01300 ML $EOF$
01400 ML LABEL
01500 ML FUNARG
01600 ML LSUBR
01700 ML MACRO
01800
01900 PUTOB ?,.+1
02000 QST: XWD -1,.+1
02100 XWD PNAME,.+1
02200 XWD .+1,0
02300 PNLIST ?
02400
02500 VBPORG: INUM0
02600 VBPEND: INUM0
00100 ;Define all the loose ends as NIL.
00200
00300 FOR @' i←0,QQ {
00400 IFNDEF ..'i,{..'i←0}}
00500
00600 ;Prenatal Full Word Storage of PNAMES.
00700
00800 BFWS:
00900 XLIST
01000 LIT
01100 LIST
01200 EFWS: 0
01300
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