/*
 * This is an implementation of the basics of what would later become LISP
 * as described in the first AI memo by John McCarthy in 1958:
 * http://www.softwarepreservation.org/projects/LISP/MIT/AIM-001.pdf/view
 *
 * Since the paper leaves open many details (e.g. how symbols should work)
 * one cannot implement a complete language from its description.
 * Furthermore the language at this stage is lacking a type system:
 * there is no way of knowing whether a particular datum (esp. the address
 * part of a word) represents a plain number or an address of another word.
 * The description of the diff function seems to suggest that the distinction
 * would have been handled by the user functions operating on a list structure
 * and that the tag part would have been used as a type indicator typically.
 * This, however, makes general print and read functions impossible.
 * The read function McCarthy mentions has a format argument but it is not
 * further explained. A print function is not mentioned at all.
 *   Some of the problems were perhaps addressed in the second AI memo,
 * of which only the first page survives (http://www.softwarepreservation.org/
 * projects/LISP/MIT/AIM-2-page_1_from_Stoyan.pdf, the whereabouts of the
 * rest are not known).
 *   The language as described in AI memo 3 is already quite different
 * from the earlier languages and is of little help clarifying the uncertain
 * points.
 *
 * Note that main() does nothing useful, it only contains some tests I did.
 *
 * Lastly, the peculiar C-style used is that of Tom Duff.
 */
#include <stdio.h>
#include <stdint.h>
#include <stdarg.h>
typedef uint64_t word;
#define FREE 0	/* free storage list */
word memory[1<<15];
word bit(word w, word n){ return w >> 35-n & 1; }
word seg(word w, word m, word n){ return w >> 35-n & ~0+(1UL<<n-m+1); } 
word pre(word w){ return seg(w, 0, 2); }
word sgn(word w){ return bit(w, 0); }
word ind(word w){ return seg(w, 1, 2); }
word dec(word w){ return seg(w, 3, 17); }
word tag(word w){ return seg(w, 18, 20); }
word add(word w){ return seg(w, 21, 35); }
word comb4(word p, word d, word t, word a){
	return (p&07)<<33 | (d&077777)<<18 | (t&07)<<15 | a&077777;
}
word comb5(word s, word i, word d, word t, word a){
	return comb4(i|s<<2, d, t, a);
}
word choice(word c, word a0, word a1){
	return c&a1 | ~c&a0;
}
word cwr(word n){ return memory[n]&0777777777777; }
word cbr(word n, word m){ return bit(cwr(n), m); }
word csgr(word n, word m1, word m2){ return seg(cwr(n), m1, m2); }
word cpr(word n){ return pre(cwr(n)); }
word csr(word n){ return sgn(cwr(n)); }
word cir(word n){ return ind(cwr(n)); }
word cdr(word n){ return dec(cwr(n)); }
word ctr(word n){ return tag(cwr(n)); }
word car(word n){ return add(cwr(n)); }
word stwr(word n, word w){
	word r;
	r=cwr(n);
	memory[n]=w&0777777777777;
	return r;
}
word stbr(word n, word w, word m){
	word r;
	r=cbr(n, m);
	stwr(n, choice(1UL<<35-m, cwr(n), w<<35-m));
	return r;
}
word stsgr(word n, word w, word m1, word m2){
	word r;
	r=csgr(n, m1, m2);
	stwr(n, choice((~0+(1UL<<m1-m2+1))<<35-m2, cwr(n), w<<35-m2));
	return r;
}
word stpr(word n, word w){ return stsgr(n, w, 0, 2); }
word stsr(word n, word w){ return stbr(n, w, 0); }
word stir(word n, word w){ return stsgr(n, w, 1, 2); }
word stdr(word n, word w){ return stsgr(n, w, 3, 17); }
word sttr(word n, word w){ return stsgr(n, w, 18, 20); }
word star(word n, word w){ return stsgr(n, w, 21, 35); }
word consw(word w){
	word n;
	n=cdr(FREE);
	stdr(FREE, cdr(n));
	stwr(n, w);
	return n;
}
word consel(word a, word d){ return consw(comb4(0, d, 0, a)); }
word consfl(word w, word d){ return consw(comb4(1, d, 0, consw(w))); }
word consls(word a, word d){ return consw(comb4(2, d, 0, a)); }
word erase(word j){
	word w;
	w=cwr(j);
	stwr(j, comb4(0, cdr(FREE), 0, 0));
	stwr(FREE, comb4(0, j, 0, 0));
	return w;
}
#define point(j, k) (j=point_(k))
#define mova(j) (j=mova_(j))
#define movd(j) (j=movd_(j))
#define movup(j) (j=movup_(j))
word point_(word k){ return consel(k, 0); }
word mova_(word j){ return consel(car(car(j)), j); }
word movd_(word j){ return consel(cdr(car(j)), j); }
word movup_(word j){ return dec(erase(j)); }
void eralis(word j){
	if(j==0)
		return;
	switch(cir(j)){
	case 1:	erase(car(j));
	zero:
	case 0: eralis(dec(erase(j))); return;
	case 2: eralis(car(j)); goto zero;
	}
}
void kill(word j){ eralis(j); };	/* why an extra function? */
word copy(word j){	/* ignores tags and signs */
	return j==0 ? 0 :
	       cir(j)==0 ? consel(car(j), copy(cdr(j))) :
	       cir(j)==1 ? consfl(cwr(car(j)), copy(cdr(j))) :
	       cir(j)==2 ? consls(copy(car(j)), copy(cdr(j))) : 0;
}
word listn(word n, ...){
	va_list ap;
	word ret, l;
	va_start(ap, n);
	ret=l=consw(0);
	while(n--){
		stdr(l, consel(va_arg(ap, word), 0));
		l = cdr(l);
	}
	va_end(ap);
	return dec(erase(ret));
}
word equal(word l1, word l2){
	return l1==l2 ? 1 :
	       cir(l1)!=cir(l2) ? 0 :
	       cir(l1)==0 && car(l1)!=car(l2) ? 0 :
	       cir(l1)==1 && cwr(car(l1))!=cwr(car(l2)) ? 0 :
	       cir(l1)==2 && !equal(car(l1), car(l2)) ? 0 :
	       equal(cdr(l1), cdr(l2));
}
void initfree(void){
	int n;
	stwr(FREE, 0);
	for(n=(1<<15)-1;n>0;n--)
		erase(n);
}
void printlis(word j){
	if(j==0)
		return;
	putchar('(');
	for(;j;j=cdr(j)){
		if(cir(j)==0)
			printf("%lo", car(j));
		else if(cir(j)==1)
			printf("[%lo]", cwr(car(j)));
		else
			printlis(car(j));
		if(cdr(j))
			printf(", ");
	}
	putchar(')');
}
void dumpmem(void){
	int n;
	printf("mem:\n");
	for(n=0;n < 1<<15;n++)
		printf("%lo\n", cwr(n));
}
/* only some stupid tests */
int main(){
	word x, y, l;
	printf("%lo %lo %lo %lo %lo %lo\n",
		pre(0700000000000),
		ind(0300000000000),
		sgn(0400000000000),
		dec(0012345000000),
		tag(0000000700000),
		add(0000000012345));
	printf("%lo\n", comb4(07, 012345, 07, 054321));
	printf("%lo\n", comb5(1, 3, 012345, 07, 054321));
	printf("%lo\n", choice(0777777000000, 0333333754321, 0712345333333));
	stwr(10, 0777777777777);
	printf("0: %lo\n", cwr(10));
	stpr(10, 0);
	printf("1: %lo\n", cwr(10));
	star(10, 012345);
	printf("2: %lo\n", cwr(10));
	stdr(10, 054321);
	printf("3: %lo\n", cwr(10));
	stsr(10, 1);
	printf("4: %lo\n", cwr(10));
	initfree();
//	dumpmem();
	x=consw(01234);
	printf("%lo %lo\n", cwr(x), cwr(FREE));
	y=consel(01234, 04321);
	printf("%lo\n", cwr(y));

	l=consfl(01234, consls(consel(1, consel(2, 0)), consel(0333, 0)));
	printlis(l); putchar('\n');
	eralis(l);
	printlis(listn(4, 1, 2, 3, 4)); putchar('\n');
	return 0;
}