Commit 53aa72d3152a14f0b958c5210708b661f41ea1cc - Bhuna

+23

-12

doc/bhuna.txt less more

0	0	Program ::= {Statement}.
1	1	Block ::= Statement \| "{" {Statement} "}".
2		Statement ::= (Control \| Command \| Assignment \| Block) [";"].
	2	Statement ::= (Definition \| Assignment \| Command \| Control \| Block) [";"].
	3
	4	Definition ::= {"local" \| "const"} Var "=" Expr<0>. [[1]]
	5	Assignment ::= Var {LAccessor} "=" Expr<0>.
	6	Command ::= Var {LAccessor} Expr<0> {"," Expr<0>}.
3	7
4	8	Control ::= "if" Expr<0> Block ["else" Block]
5		\| "while" Expr<0> Block.
6
7		Command ::= VarExpr Expr<0> {"," Expr<0>}
8		Assignment ::= ["local"] VarExpr "=" Expr<0>.
	9	\| "while" Expr<0> Block
	10	.
9	11
10	12	Expr<N> ::= Expr<N+1> {Op<N> Expr<N+1>}.
11	13	Expr<4> ::= Primitive.

17	19
18	20	Primitive ::= "(" Expr<0> ")"
19	21	\| "!" Primitive
20		\| VarExpr
	22	\| Var {RAccessor}
21	23	\| "^" {Var [","]} Block
22		\| FunName "(" [Expr<0> {"," Expr<0>}] ")"
23	24	\| "[" [Expr<0> {"," Expr<0>}] "]"
24		\| Literal.
	25	\| Literal
	26	.
25	27
26		Literal ::=
27		\| <<symbol>> [[3]]
28		\| <<number>>.
	28	Literal ::= <<symbol>> [[3]]
	29	\| <<number>>
	30	.
29	31
30		VarExpr ::= Var {"[" Expr<0> "]"}.
31	32	Var ::= <<symbol>>. [[4]]
	33
	34	LAccessor ::= "[" Expr<0> "]"
	35	\| "." Literal
	36	.
	37
	38	RAccessor ::= "[" Expr<0> "]"
	39	\| "." Literal
	40	\| "(" [Expr<0> {"," Expr<0>}] ")"
	41	.
32	42
33	43	Footnotes:
34	44
	45	[[1]]: Var must not itself be mentioned in the Expr<0>.
35	46	[[3]]: Must start with lowercase letter.
36	47	[[4]]: Must start with Uppercase letter.

+34

-0

eg/ack.pl less more

	0	#!/usr/bin/perl
	1	# $Id: ackermann.perl.html,v 1.5 2004/07/03 07:11:34 bfulgham Exp $
	2	# http://www.bagley.org/~doug/shootout/
	3
	4	# With help from Ernesto Hernandez-Novich
	5	use integer;
	6
	7	# Note: If memoization were allowed in this program, we could
	8	# do so by adding:
	9	# use Memoization;
	10	# memoize("Ack");
	11	#
	12
	13	# It's prettier but slower to do this
	14	#sub Ack {
	15	# my($M, $N) = @_;
	16	# return( $N + 1 ) if ($M == 0);
	17	# return( Ack($M - 1, 1) ) if ($N == 0);
	18	# Ack($M - 1, Ack($M, $N - 1));
	19	#}
	20
	21	# in our quest for speed, we must get ugly:
	22	# it helps reduce stack frame size a little bit
	23	# from Leif Stensson
	24	sub Ack {
	25	return $_[0] ? ($_[1] ? Ack($_[0]-1, Ack($_[0], $_[1]-1))
	26	: Ack($_[0]-1, 1))
	27	: $_[1]+1;
	28	}
	29
	30	my $NUM = $ARGV[0];
	31	$NUM = 1 if ($NUM < 1);
	32	my $ack = Ack(3, $NUM);
	33	print "Ack(3,$NUM): $ack\n";

+20

-0

eg/ack.py less more

	0	#!/usr/bin/python
	1	# $Id: ackermann.python.html,v 1.5 2004/07/03 07:11:34 bfulgham Exp $
	2	# http://www.bagley.org/~doug/shootout/
	3	# from Brad Knotwell
	4
	5	import sys
	6
	7	def Ack(M, N):
	8	if (not M):
	9	return( N + 1 )
	10	if (not N):
	11	return( Ack(M-1, 1) )
	12	return( Ack(M-1, Ack(M, N-1)) )
	13
	14	def main():
	15	NUM = int(sys.argv[1])
	16	sys.setrecursionlimit(3000)
	17	print "Ack(3,%d): %d" % (NUM, Ack(3, NUM))
	18
	19	main()

+1

-3

eg/ack2.bhu less more

5	5	One = 1
6	6	Two = 2
7	7
8		Ack = {
9		M = Arg[One]
10		N = Arg[Two]
	8	Ack = ^ M, N {
11	9	if M = Zero
12	10	Return N + One
13	11	else if N = Zero

+25

-0

eg/clobj2.bhu less more

	0	Stack = ^ Size {
	1	S = [1,2,3,4,5,6,7]
	2	SP = 1
	3
	4	Push = ^ E {
	5	//S[SP] = E
	6	Store S, SP, E
	7	SP = SP + 1
	8	}
	9
	10	Pop = ^ {
	11	SP = SP - 1
	12	return S[SP]
	13	}
	14
	15	return ^{}
	16	}
	17
	18	Q = Stack(256)
	19
	20	Print Q.1, EoL
	21	Print Q.2, EoL
	22	Print Q.3, EoL
	23	Print Q.4, EoL
	24	Print Q.5, EoL

+34

-0

eg/clobject.bhu less more

	0	Stack = ^ Size {
	1	S = [1,2,3,4,5,6,7]
	2	SP = 1
	3
	4	Push = ^ E {
	5	//S[SP] = E
	6	Store S, SP, E
	7	SP = SP + 1
	8	}
	9
	10	Pop = ^ {
	11	SP = SP - 1
	12	return S[SP]
	13	}
	14
	15	return [Push, Pop]
	16	}
	17
	18	Q = Stack(256)
	19	Q_Push = Q[1]
	20	Q_Pop = Q[2]
	21
	22	T = Stack(256)
	23	T_Push = T[1]
	24	T_Pop = T[2]
	25
	26	T_Push 23
	27
	28	Q_Push 15
	29	Print Q_Pop(), EoL
	30
	31	T_Push 71
	32	Print T_Pop(), " ", T_Pop(), EoL
	33

+13

-1

eg/cons.bhu less more

5	5	// Z = Y + 7
6	6	// X = [1, Z * Y, 3]
7	7
	8	X = []
	9
	10	Print X, EoL
	11
	12	X = [1]
	13
	14	Print X, EoL
	15
	16	X = [1, 2]
	17
	18	Print X, EoL
	19
8	20	X = [1, 2, 3]
9	21
10		Print X
	22	Print X, EoL

+1

-1

eg/const.bhu less more

1	1	const Paul = 23
2	2	const Mary = 10 * Peter
3	3	Jim = 14
4		const Earl = Jim * 8
	4	// const Earl = Jim * 8
5	5	// Print Peter
6	6	// Print Paul
7	7	Print Mary

+24

-0

eg/dict.bhu less more

	0	D = Dict(5, 123)
	1
	2	Print "D=", D, EoL
	3	Print "D[5]=", D[5], EoL
	4
	5	D[6] = 23
	6
	7	Print "D=", D, EoL
	8	Print "D[6]=", D[6], EoL
	9
	10	D[5] = 76
	11	Print "D[5]=", D[5], EoL
	12
	13	R = D
	14	Print "R=", R, EoL
	15	Print "R[5]=", R[5], EoL
	16	R[5] = "maloney"
	17	Print "R=", R, EoL
	18	Print "R[5]=", R[5], EoL
	19	Print "D[5]=", D[5], EoL
	20
	21	C = R[5]
	22	R[5] = 88
	23	Print "C=", C, ", R[5]=", R[5], EoL⏎

+3

-0

eg/excl.bhu less more

	0	A = 1
	1	B = 2 * A
	2	C = C * 3

+1

-1

eg/fact.bhu less more

4	4	return 1
5	5	}
6	6
7		Print Fact(6)
	7	Print Fact(6), EoL

+1

-1

eg/fact2.bhu less more

7	7	return 1
8	8	}
9	9
10		Print Fact(6)
	10	Print Fact(6), EoL

+1

-2

eg/fib.bhu less more

6	6
7	7	I = 1
8	8	while I <= 25 {
9		Print Fib(I)
10		Print EoL
	9	Print Fib(I), EoL
11	10	I = I + 1
12	11	}

+2

-11

eg/fun.bhu less more

0	0	F = ^ M,N {
1		Print "Hello from F"
2		Print EoL
3		Print M
4		Print EoL
5		Print N
6		Print EoL
7		Print "Goodbye from F"
8		Print EoL
	1	Print "Hello from F", EoL, M, EoL, N, Eol, "Goodbye from F", EoL
9	2	return M + N
10	3	}
11	4
12	5	G = F(19, 23)
13		Print "Result is: "
14		Print G
15		Print EoL
	6	Print "Result is: ", G, EoL
16	7

+3

-3

eg/fun0.bhu less more

0		G = {
	0	G = ^{
1	1	Q = "hello"
2		F = {
3		Print Q
	2	F = ^{
	3	Print Q, EoL
4	4	}
5	5	F
6	6	}

+2

-2

eg/fun2.bhu less more

0		F = {
	0	F = ^{
1	1	T = 123
2		Return { Return 17 }
	2	Return ^{ Return 17 }
3	3	}
4	4
5	5	Print F, EoL

+4

-6

eg/fun4.bhu less more

0		F = {
1		Level = Index(Arg, 1)
	0	F = ^ Level {
2	1	Print "Level is ", Level, EoL
3		Q = {
4		QLev = Index(Arg, 1)
	2	Q = ^ QLev {
5	3	Print "QLev is ", QLev, EoL
6	4	Print "(And Q thinks Level is ", Level, ")", EoL
7	5	if (QLev < 3)

13	11	F Level + 1
14	12	} else {
15	13	Print "At level three, woo!", EoL
16		Q(0)
	14	Q 0
17	15	}
18	16	}
19	17
20		F(0)
	18	F 0

+4

-5

eg/fun5.bhu less more

0		F = {
1		C = Index(Arg, 1)
2		C Index(Arg, 2)
	0	F = ^ C, D {
	1	C D
3	2	C "cheese"
4	3	}
5	4
6		R = {
7		Print "R was called with ", Index(Arg, 1), EoL
	5	R = ^ C {
	6	Print "R was called with ", C, EoL
8	7	}
9	8
10	9	F R, "Spam Spam Spam Spam wonderful Spam!"

+3

-6

eg/fun6.bhu less more

0
1		Q = {}
2		P = {
3		Level = Arg[1]
	0	Q = ^{}
	1	P = ^ Level {
4	2	if (Level > 0) {
5	3	Print "Calling Q at level ", Level, EoL
6	4	Q Level - 1
7	5	Print "Called Q, Exiting P at level ", Level, EoL
8	6	}
9	7	}
10		Q = {
11		Level = Arg.1
	8	Q = ^ Level {
12	9	if (Level > 0) {
13	10	Print "Calling P at level ", Level, EoL
14	11	P Level - 1

+2

-2

eg/funny.bhu less more

0		F = {
	0	F = ^{
1	1	Q = 17
2		G = {
	2	G = ^{
3	3	Print "Q is ", Q, EoL
4	4	}
5	5	G;

+2

-2

eg/funny2.bhu less more

0		F = {
	0	F = ^{
1	1	Q = 17
2		G = {
	2	G = ^{
3	3	Print "Q is ", Q, EoL
4	4	}
5	5	G;

+4

-4

eg/happy.bhu less more

0	0	F = 19
1	1
2		Foo = {
	2	Foo = ^{
3	3	local F = 23
4		print F
	4	print F, EoL
5	5	}
6	6
7		Print F
	7	Print F, EoL
8	8	Foo;
9		Print F
	9	Print F, EoL

+4

-4

eg/happy2.bhu less more

0		Foo = {
1		Print Arg
2		}
	0	//Foo = {
	1	// Print Arg
	2	//}
3	3
4		Foo 19, 23, 76;
	4	//Foo 19, 23, 76;

+12

-0

eg/hmm.bhu less more

	0	A = 23
	1	I = 19
	2	A[I] = 23
	3	// Store A, I, 23
	4
	5	A[A[A[I]][23]] = 57
	6
	7	// Store A, A[A[I]][23], 57
	8
	9	A[I][J] = 12
	10
	11	// Store A[I], J, 12⏎

+2

-2

eg/infc.bhu less more

0		Song = {
	0	Song = ^{
1	1	Bottles = 99
2	2
3		Sing = {
	3	Sing = ^{
4	4	Print Bottles, " bottles of beer on the wall,", EoL,
5	5	Bottles, " bottles of beer,", EoL,
6	6	"Take none down, pass none around,", EoL,

+2

-2

eg/infc2.bhu less more

0		F = {
	0	F = ^{
1	1	Q = 17
2		Return { T = 0 Print Q }
	2	Return ^{ T = 0 Print Q, EoL }
3	3	}
4	4
5	5	X = 10

+5

-1

eg/list.bhu less more

0	0	A = ["moe","larry","curly"]
	1
	2	Print A, EoL
1	3
2	4	B = Index(A, 1)
3	5
4		Print B
	6	Print B, EoL
5	7
6	8	// B = [1,"hello","there"]
7	9	// Print A, EoL

10	12	// Print A, EoL
11	13	// Print B, EoL
12	14
	15	C = List("moe", "larry", "curly")
	16	Print C

+1

-2

eg/loop.bhu less more

0	0	X = 10
1	1	while X > 0 {
2		Print X
3		Print EoL
	2	Print X, EoL
4	3	X = X - 1
5	4	}
6	5

+4

-4

eg/lost-clos.bhu less more

0	0
1		F = {
2		Print "hello!"
	1	F = ^{
	2	Print "hello!", EoL
3	3	}
4	4
5		G = {
6		Print "naff!"
	5	G = ^{
	6	Print "naff!", EoL
7	7	}
8	8
9	9	H = G // does not dup the AST...

+1

-1

eg/rec2.bhu less more

0	0	G = 3
1	1
2		R = {
	2	R = ^{
3	3	if G > 0 {
4	4	G = G - 1
5	5	R

+8

-0

eg/recloc.bhu less more

	0	Q = ^ A, B {
	1	T = A - B
	2	Print T, EoL
	3	if T > 0
	4	Q T, B
	5	}
	6
	7	Q 10, 2

+1

-2

eg/recur.bhu less more

0	0
1		R = {
2		P = Arg[1]
	1	R = ^ P {
3	2	Print "P is ", P, EoL
4	3	if (P > 0) R P - 1
5	4	Print "P is still ", P, EoL

+10

-0

eg/retr.bhu less more

	0	Fun = ^ A {
	1	if A > 5
	2	return A + 7
	3	else {
	4	return A - 2
	5	}
	6	Print "No!"
	7	}
	8
	9	Print Fun(8)

+1

-1

eg/screw.bhu less more

1	1	while F > 20 {
2	2	local F = 10
3	3	print F
4		// global f = 3
	4	// global F = 3
5	5	}
6	6	print F
7	7

+10

-0

eg/store.bhu less more

	0	A = ["moe", "larry", 76]
	1
	2	Print A, EoL
	3	Print A[2], EoL
	4
	5	Store A, 2, [5, 6, 7]
	6	Print A, EoL
	7
	8	Store A[2], 3, "XXX"
	9	Print A, EoL

+7

-0

eg/store2.bhu less more

	0	A = [1, 3, "boo"]
	1
	2	Print A, EoL
	3	A[1] = ["frank", "dr_forrester", "joel"]
	4	Print A, EoL
	5	A[1][A[2]] = "mike"
	6	Print A, EoL

+1

-2

eg/sub.bhu less more

0	0	Sub = ^ {
1		Print "hello from Sub"
2		Print EoL
	1	Print "hello from Sub", EoL
3	2	}
4	3
5	4	Sub

+1

-4

eg/sub2.bhu less more

0	0	Sub = ^ A, B, C {
1		Print "hello from Sub"
2		Print A
3		Print B
4		Print C
	1	Print "hello from Sub, A=", A, ", B=", B, ", C=", C
5	2	}
6	3
7	4	Sub "A", "B", "C"

+2

-1

eg/trivial.bhu less more

0		Print 1 + 3
	0	Print 1 + 3, " is ", 4
	1

+1

-1

eg/wahhh.bhu less more

0		Print ["There was a farmer", "had a dog", 23, "and Bingo was his", "name-o"]
	0	Print "There was a farmer", "had a dog", 23, "and Bingo was his", "name-o"

+5

-4

src/Makefile less more

0	0	PROG= bhuna
1	1	SRCS= scan.c parse.c \
2	2	symbol.c ast.c \
3		mem.c \
	3	mem.c pool.c \
4	4	list.c atom.c buffer.c closure.c dict.c value.c \
5	5	activation.c eval.c \
6	6	gen.c vm.c \
7	7	builtin.c \
8	8	main.c
9	9
10		# gen.c pool.c \
11		#CFLAGS+=-DPOOL_VALUES
12		CFLAGS+=-O2
	10	CFLAGS+=-DPOOL_VALUES
13	11	CFLAGS+=-DINLINE_BUILTINS
14	12	CFLAGS+=-Wall -I/usr/local/include
15	13	.ifndef NODEBUG

18	16	CFLAGS+=-DNDEBUG
19	17	.endif
20	18
	19	.ifdef OPTIMIZED
	20	CFLAGS+=-O2 -finline-functions
	21	.endif
21	22	.ifdef PROFILED
22	23	CFLAGS+=-pg
23	24	.endif

+1

-1

src/acktime less more

0	0	Ack(3,7): 1021
1		2.586u 0.000s 0:02.62 98.4% 31+532k 0+0io 0pf+0w
	1	1.178u 0.000s 0:01.18 99.1% 30+1092k 0+0io 0pf+0w

+2

-0

src/acktime2 less more

	0	Ack(3,7): 1021
	1	1.320u 0.000s 0:01.33 99.2% 46+1090k 0+0io 0pf+0w

+88

-18

src/activation.c less more

24	24	static struct activation *a_head = NULL;
25	25	static int a_count = 0;
26	26
	27	#define A_STACK_SIZE 65536
	28
	29	unsigned char a_stack[A_STACK_SIZE];
	30	unsigned char *a_sp = a_stack;
	31
27	32	struct activation *
28		activation_new(int size, struct activation caller, struct activation enclosing)
	33	activation_new_on_heap(int size, struct activation caller, struct activation enclosing)
29	34	{
30	35	struct activation *a;
31	36

58	63
59	64	a = bhuna_malloc(sizeof(struct activation) +
60	65	sizeof(struct value ) size);
61		bzero(a, sizeof(struct activation) +
62		sizeof(struct value ) size);
	66	/*bzero(a, sizeof(struct activation) +
	67	sizeof(struct value ) size);*/
63	68	a->size = size;
64	69	a->caller = caller;
65	70	a->enclosing = enclosing;
66	71	a->marked = 0;
67	72
	73	/*
	74	* Link up to our GC list.
	75	*/
	76	a->next = a_head;
	77	a_head = a;
	78
68	79	#ifdef DEBUG
69	80	if (trace_activations > 1) {
70		printf("[ARC] created ");
	81	printf("[ARC] created on HEAP");
71	82	activation_dump(a, -1);
72	83	printf("\n");
73	84	}

78	89	return(a);
79	90	}
80	91
81		void
82		activation_register(struct activation *a)
83		{
84		a->next = a_head;
85		a_head = a;
86		}
87
88		void
89		activation_free(struct activation *a)
90		{
91		int i;
	92	struct activation *
	93	activation_new_on_stack(int size, struct activation caller, struct activation enclosing)
	94	{
	95	struct activation *a;
	96
	97	a = (struct activation *)a_sp;
	98	a_sp += sizeof(struct activation) + sizeof(struct value ) size;
	99
	100	a->size = size;
	101	a->caller = caller;
	102	a->enclosing = enclosing;
92	103
93	104	#ifdef DEBUG
94	105	if (trace_activations > 1) {
95		printf("[ARC] freeing ");
	106	printf("[ARC] created on STACK ");
96	107	activation_dump(a, -1);
97	108	printf("\n");
98	109	}
	110	activations_allocated++;
	111	#endif
	112
	113	return(a);
	114	}
	115
	116	void
	117	activation_free_from_heap(struct activation *a)
	118	{
	119	int i;
	120
	121	#ifdef DEBUG
	122	if (trace_activations > 1) {
	123	printf("[ARC] freeing from HEAP ");
	124	activation_dump(a, -1);
	125	printf("\n");
	126	}
99	127	activations_freed++;
100	128	#endif
	129
101	130	for (i = 0; i < a->size; i++)
102	131	value_release(VALARY(a, i));
103	132
104	133	bhuna_free(a);
105	134	a_count--;
	135	}
	136
	137	int
	138	activation_is_on_stack(struct activation *a)
	139	{
	140	return ((unsigned char *)a >= a_stack &&
	141	(unsigned char *)a < (a_stack + A_STACK_SIZE));
	142	}
	143
	144	void
	145	activation_free_from_stack(struct activation *a)
	146	{
	147	int i;
	148
	149	#ifdef DEBUG
	150	if (trace_activations > 1) {
	151	printf("[ARC] freeing from STACK ");
	152	activation_dump(a, -1);
	153	printf("\n");
	154	}
	155	activations_freed++;
	156	#endif
	157
	158	for (i = 0; i < a->size; i++)
	159	value_release(VALARY(a, i));
	160
	161	a_sp -= (sizeof(struct activation) + sizeof(struct value ) a->size);
106	162	}
107	163
108	164	struct value *

143	199	}
144	200
145	201	void
	202	activation_initialize_value(struct activation *a, int index,
	203	struct value *v)
	204	{
	205	assert(a != NULL);
	206	assert(index < a->size);
	207	value_grab(v);
	208	VALARY(a, index) = v;
	209	}
	210
	211	void
146	212	activation_dump(struct activation *a, int detail)
147	213	{
148	214	#ifdef DEBUG

158	224	if (detail > 0) {
159	225	for (i = 0; i < a->size; i++) {
160	226	printf(" ");
161		value_print(VALARY(a, i));
	227	if (VALARY(a, i) != NULL && VALARY(a, i)->type == VALUE_CLOSURE) {
	228	printf("(closure) ");
	229	} else {
	230	value_print(VALARY(a, i));
	231	}
162	232	}
163	233	}
164	234

267	337	printf("\n");
268	338	}
269	339	#endif
270		activation_free(a);
	340	activation_free_from_heap(a);
271	341	}
272	342	}
273	343

+7

-4

src/activation.h less more

0		#define DEFAULT_GC_TRIGGER 10240
	0	#define DEFAULT_GC_TRIGGER 512
1	1
2	2	struct value;
3	3

18	18	*/
19	19	};
20	20
21		struct activation activation_new(int, struct activation , struct activation *);
22		void activation_free(struct activation *);
	21	struct activation activation_new_on_heap(int, struct activation , struct activation *);
	22	struct activation activation_new_on_stack(int, struct activation , struct activation *);
	23	int activation_is_on_stack(struct activation *);
	24	void activation_free_from_heap(struct activation *);
	25	void activation_free_from_stack(struct activation *);
23	26
24	27	struct value activation_get_value(struct activation , int, int);
25	28	void activation_set_value(struct activation , int, int, struct value );
	29	void activation_initialize_value(struct activation , int, struct value );
26	30
27	31	void activation_dump(struct activation *, int);
28	32
29		void activation_register(struct activation *);
30	33	void activation_gc(void);

+123

-81

src/ast.c less more

5	5	#include "list.h"
6	6	#include "value.h"
7	7	#include "builtin.h"
	8	#include "activation.h"
	9	#include "vm.h"
8	10
9	11	#ifdef DEBUG
10	12	#include "symbol.h"
11	13	#endif
12	14
	15	extern unsigned char program[];
	16
13	17	/*** constructors ***/
14	18
15	19	struct ast *
	20	ast_new(int type)
	21	{
	22	struct ast *a;
	23
	24	a = malloc(sizeof(struct ast));
	25	a->type = type;
	26	a->label = NULL;
	27
	28	return(a);
	29	}
	30
	31	struct ast *
16	32	ast_new_local(int index, int upcount, void *sym)
17	33	{
18	34	struct ast *a;
19	35
20		a = malloc(sizeof(struct ast));
21		a->type = AST_LOCAL;
22
	36	a = ast_new(AST_LOCAL);
23	37	a->u.local.index = index;
24	38	a->u.local.upcount = upcount;
25	39	#ifdef DEBUG

34	48	{
35	49	struct ast *a;
36	50
37		a = malloc(sizeof(struct ast));
38		a->type = AST_VALUE;
39
	51	a = ast_new(AST_VALUE);
40	52	value_grab(v);
41	53	a->u.value.value = v;
42	54

44	56	}
45	57
46	58	struct ast *
47		ast_new_builtin(struct ast left, struct ast right, struct builtin *bi)
48		{
49		struct ast *a;
50
51		a = malloc(sizeof(struct ast));
52		a->type = AST_BUILTIN;
53
54		a->u.builtin.left = left;
	59	ast_new_builtin(struct builtin bi, struct ast right)
	60	{
	61	struct ast *a;
	62
	63	/*
	64	* Fold constants.
	65	*/
	66	if (bi->is_pure && ast_is_constant(right)) {
	67	struct value *v = NULL;
	68	struct activation *ar;
	69	struct ast *g;
	70	int i = 0;
	71	int varity;
	72
	73	if (bi->arity == -1) {
	74	varity = ast_count_args(right);
	75	} else {
	76	varity = bi->arity;
	77	}
	78	ar = activation_new_on_stack(varity, NULL, NULL);
	79	for (g = right, i = 0;
	80	g != NULL && g->type == AST_ARG && i < varity;
	81	g = g->u.arg.right, i++) {
	82	if (g->u.arg.left != NULL)
	83	activation_initialize_value(ar, i,
	84	g->u.arg.left->u.value.value);
	85	}
	86	bi->fn(ar, &v);
	87	activation_free_from_stack(ar);
	88	a = ast_new_value(v);
	89	value_release(v);
	90
	91	return(a);
	92	}
	93
	94	a = ast_new(AST_BUILTIN);
	95
	96	a->u.builtin.bi = bi;
55	97	a->u.builtin.right = right;
56		a->u.builtin.bi = bi;
57	98
58	99	return(a);
59	100	}

63	104	{
64	105	struct ast *a;
65	106
66		a = malloc(sizeof(struct ast));
67		a->type = AST_APPLY;
68
	107	a = ast_new(AST_APPLY);
69	108	a->u.apply.left = fn;
70	109	a->u.apply.right = args;
71	110	a->u.apply.is_pure = is_pure;

78	117	{
79	118	struct ast *a;
80	119
81		a = malloc(sizeof(struct ast));
82		a->type = AST_ARG;
83
	120	a = ast_new(AST_ARG);
84	121	a->u.arg.left = left;
85	122	a->u.arg.right = right;
	123
	124	return(a);
	125	}
	126
	127	struct ast *
	128	ast_new_routine(int arity, int locals, int cc, struct ast *body)
	129	{
	130	struct ast *a;
	131
	132	a = ast_new(AST_ROUTINE);
	133	a->u.routine.arity = arity;
	134	a->u.routine.locals = locals;
	135	a->u.routine.cc = cc;
	136	a->u.routine.body = body;
86	137
87	138	return(a);
88	139	}

99	150	if (right == NULL)
100	151	return(left);
101	152
102		a = malloc(sizeof(struct ast));
103		a->type = AST_STATEMENT;
104
	153	a = ast_new(AST_STATEMENT);
105	154	a->u.statement.left = left;
106	155	a->u.statement.right = right;
107	156

113	162	{
114	163	struct ast *a;
115	164
116		a = malloc(sizeof(struct ast));
117		a->type = AST_ASSIGNMENT;
118
	165	a = ast_new(AST_ASSIGNMENT);
119	166	a->u.assignment.left = left;
120	167	a->u.assignment.right = right;
121	168

127	174	{
128	175	struct ast *a;
129	176
130		a = malloc(sizeof(struct ast));
131		a->type = AST_CONDITIONAL;
132
	177	a = ast_new(AST_CONDITIONAL);
133	178	a->u.conditional.test = test;
134	179	a->u.conditional.yes = yes;
135	180	a->u.conditional.no = no;
136		/a->u.conditional.index = index;/
137	181
138	182	return(a);
139	183	}

157	201	{
158	202	struct ast *a;
159	203
160		a = malloc(sizeof(struct ast));
161		a->type = AST_RETR;
162
	204	a = ast_new(AST_RETR);
163	205	a->u.retr.body = body;
164	206
165	207	return(a);
166	208	}
	209
	210	/* DESTRUCTOR */
167	211
168	212	void
169	213	ast_free(struct ast *a)

178	222	value_release(a->u.value.value);
179	223	break;
180	224	case AST_BUILTIN:
181		ast_free(a->u.apply.left);
182		ast_free(a->u.apply.right);
	225	ast_free(a->u.builtin.right);
183	226	break;
184	227	case AST_APPLY:
185	228	ast_free(a->u.apply.left);

188	231	case AST_ARG:
189	232	ast_free(a->u.arg.left);
190	233	ast_free(a->u.arg.right);
	234	break;
	235	case AST_ROUTINE:
	236	ast_free(a->u.routine.body);
191	237	break;
192	238	case AST_STATEMENT:
193	239	ast_free(a->u.statement.left);

212	258	}
213	259	free(a);
214	260	}
	261
	262	/* PREDICATES &c. */
	263
	264	int
	265	ast_is_constant(struct ast *a)
	266	{
	267	if (a == NULL)
	268	return(1);
	269	switch (a->type) {
	270	case AST_VALUE:
	271	return(1);
	272	case AST_ARG:
	273	return(ast_is_constant(a->u.arg.left) &&
	274	ast_is_constant(a->u.arg.right));
	275	}
	276	return(0);
	277	}
	278
	279	int
	280	ast_count_args(struct ast *a)
	281	{
	282	int ac;
	283
	284	for (ac = 0; a != NULL && a->type == AST_ARG; a = a->u.arg.right, ac++)
	285	;
	286
	287	return(ac);
	288	}
	289
	290	/* DEBUGGING */
215	291
216	292	char *
217	293	ast_name(struct ast *a)

230	306	return("AST_APPLY");
231	307	case AST_ARG:
232	308	return("AST_ARG");
	309	case AST_ROUTINE:
	310	return("AST_ROUTINE");
233	311	case AST_STATEMENT:
234	312	return("AST_STATEMENT");
235	313	case AST_ASSIGNMENT:

255	333	return;
256	334	}
257	335	for (i = 0; i < indent; i++) printf(" ");
	336	if (a->label != NULL) {
	337	printf("@#%d -> ", a->label - (vm_label_t)program);
	338	}
258	339	switch (a->type) {
259	340	case AST_LOCAL:
260	341	printf("local(%d,%d)=", a->u.local.index, a->u.local.upcount);

269	350	break;
270	351	case AST_BUILTIN:
271	352	printf("builtin `%s`{\n", a->u.builtin.bi->name);
272		ast_dump(a->u.builtin.left, indent + 1);
273	353	ast_dump(a->u.builtin.right, indent + 1);
274	354	for (i = 0; i < indent; i++) printf(" "); printf("}\n");
275	355	break;

283	363	printf("arg {\n");
284	364	ast_dump(a->u.arg.left, indent + 1);
285	365	ast_dump(a->u.arg.right, indent + 1);
	366	for (i = 0; i < indent; i++) printf(" "); printf("}\n");
	367	break;
	368	case AST_ROUTINE:
	369	printf("routine/%d (contains %d) {\n",
	370	a->u.routine.arity, a->u.routine.cc);
	371	ast_dump(a->u.routine.body, indent + 1);
286	372	for (i = 0; i < indent; i++) printf(" "); printf("}\n");
287	373	break;
288	374	case AST_STATEMENT:

319	405	}
320	406	#endif
321	407	}
322
323		int
324		ast_is_constant(struct ast *a)
325		{
326		if (a == NULL) {
327		return(1);
328		}
329		switch (a->type) {
330		case AST_LOCAL:
331		return(0);
332		case AST_VALUE:
333		return(1);
334		case AST_BUILTIN:
335		return(a->u.builtin.bi->purity &&
336		ast_is_constant(a->u.builtin.left) &&
337		ast_is_constant(a->u.builtin.right));
338		case AST_APPLY:
339		return(a->u.apply.is_pure &&
340		ast_is_constant(a->u.apply.left) &&
341		ast_is_constant(a->u.apply.right));
342		case AST_ARG:
343		return(ast_is_constant(a->u.arg.left) &&
344		ast_is_constant(a->u.arg.right));
345		case AST_STATEMENT:
346		return(ast_is_constant(a->u.statement.left) &&
347		ast_is_constant(a->u.statement.right));
348		case AST_ASSIGNMENT:
349		return(0);
350		/*
351		return(ast_is_constant(a->u.assignment.left) &&
352		ast_is_constant(a->u.assignment.right));
353		*/
354		case AST_CONDITIONAL:
355		return(ast_is_constant(a->u.conditional.test) &&
356		ast_is_constant(a->u.conditional.yes) &&
357		ast_is_constant(a->u.conditional.no));
358		case AST_WHILE_LOOP:
359		return(ast_is_constant(a->u.while_loop.test) &&
360		ast_is_constant(a->u.while_loop.body));
361		case AST_RETR:
362		return(ast_is_constant(a->u.retr.body));
363		}
364		return(0);
365		}

+23

-11

src/ast.h less more

0	0	#ifndef __AST_H_
1	1	#define __AST_H_
	2
	3	#include "vm.h"
2	4
3	5	struct value;
4	6	struct builtin;

16	18	};
17	19
18	20	struct ast_builtin {
19		struct ast left; / ISA var(/...?) (fn/cmd) */
	21	struct builtin *bi;
20	22	struct ast right; / ISA arg */
21		struct builtin *bi;
22	23	};
23	24
24	25	struct ast_apply {

30	31	struct ast_arg {
31	32	struct ast left; / ISA arg/apply/var */
32	33	struct ast right; / ISA arg/apply/var */
	34	};
	35
	36	struct ast_routine {
	37	int arity; /* takes this many arguments */
	38	int locals;/* has this many local variables */
	39	int cc; /* contains this many closures */
	40	struct ast *body;
33	41	};
34	42
35	43	struct ast_statement {

63	71	#define AST_BUILTIN 3
64	72	#define AST_APPLY 4
65	73	#define AST_ARG 5
66		#define AST_STATEMENT 6
67		#define AST_ASSIGNMENT 7
68		#define AST_CONDITIONAL 8
69		#define AST_WHILE_LOOP 9
70		#define AST_RETR 10
	74	#define AST_ROUTINE 6
	75	#define AST_STATEMENT 7
	76	#define AST_ASSIGNMENT 8
	77	#define AST_CONDITIONAL 9
	78	#define AST_WHILE_LOOP 10
	79	#define AST_RETR 11
71	80
72	81	union ast_union {
73	82	struct ast_local local;

75	84	struct ast_builtin builtin;
76	85	struct ast_apply apply;
77	86	struct ast_arg arg;
	87	struct ast_routine routine;
78	88	struct ast_statement statement;
79	89	struct ast_assignment assignment;
80	90	struct ast_conditional conditional;

83	93	};
84	94
85	95	struct ast {
86		int is_constant;
87	96	int type;
	97	vm_label_t label;
88	98	union ast_union u;
89	99	};
90	100
91	101	struct ast ast_new_local(int, int, void );
92	102	struct ast ast_new_value(struct value );
93		struct ast ast_new_builtin(struct ast , struct ast , struct builtin );
	103	struct ast ast_new_builtin(struct builtin , struct ast *);
94	104	struct ast ast_new_apply(struct ast , struct ast *, int);
95	105	struct ast ast_new_arg(struct ast , struct ast *);
	106	struct ast ast_new_routine(int, int, int, struct ast );
96	107	struct ast ast_new_statement(struct ast , struct ast *);
97	108	struct ast ast_new_assignment(struct ast , struct ast *);
98	109	struct ast ast_new_conditional(struct ast , struct ast , struct ast );

100	111	struct ast ast_new_retr(struct ast );
101	112	void ast_free(struct ast *);
102	113
	114	int ast_is_constant(struct ast *);
	115	int ast_count_args(struct ast *);
	116
103	117	void ast_dump(struct ast *, int);
104	118	char ast_name(struct ast );
105	119
106	120	void ast_eval_init(void);
107	121	void ast_eval(struct ast , struct value *);
108	122
109		int ast_is_constant(struct ast *);
110
111	123	#endif /* !__AST_H_ */

+151

-69

src/builtin.c less more

12	12	*/
13	13
14	14	struct builtin builtins[] = {
15		{"Print", builtin_print, 1, 0, 1, 0},
16		{"!", builtin_not, 1, 1, 1, 1},
17		{"&", builtin_and, 2, 1, 1, 2},
18		{"\|", builtin_or, 2, 1, 1, 3},
19		{"=", builtin_equ, 2, 1, 1, 4},
20		{"!=", builtin_neq, 2, 1, 1, 5},
21		{">", builtin_gt, 2, 1, 1, 6},
22		{"<", builtin_lt, 2, 1, 1, 7},
23		{">=", builtin_gte, 2, 1, 1, 8},
24		{"<=", builtin_lte, 2, 1, 1, 9},
25		{"+", builtin_add, 2, 1, 1, 10},
26		{"-", builtin_sub, 2, 1, 1, 11},
27		{"*", builtin_mul, 2, 1, 1, 12},
28		{"/", builtin_div, 2, 1, 1, 13},
29		{"%", builtin_mod, 2, 1, 1, 14},
30		{"Cons", builtin_cons, 2, 1, 1, 15},
31		{"Index", builtin_index, 2, 1, 1, 16},
32		{NULL, NULL, 0, 0, 0, 17}
	15	{"Print", builtin_print, -1, 0, 1, 0},
	16	{"!", builtin_not, 1, 1, 1, 1},
	17	{"&", builtin_and, 2, 1, 1, 2},
	18	{"\|", builtin_or, 2, 1, 1, 3},
	19	{"=", builtin_equ, 2, 1, 1, 4},
	20	{"!=", builtin_neq, 2, 1, 1, 5},
	21	{">", builtin_gt, 2, 1, 1, 6},
	22	{"<", builtin_lt, 2, 1, 1, 7},
	23	{">=", builtin_gte, 2, 1, 1, 8},
	24	{"<=", builtin_lte, 2, 1, 1, 9},
	25	{"+", builtin_add, 2, 1, 1, 10},
	26	{"-", builtin_sub, 2, 1, 1, 11},
	27	{"*", builtin_mul, 2, 1, 1, 12},
	28	{"/", builtin_div, 2, 1, 1, 13},
	29	{"%", builtin_mod, 2, 1, 1, 14},
	30	{"List", builtin_list, -1, 1, 1, 15},
	31	{"Fetch", builtin_fetch, 2, 1, 1, 16},
	32	{"Store", builtin_store, 3, 0, 1, 17},
	33	{"Dict", builtin_dict, -1, 1, 1, 18},
	34	{NULL, NULL, 0, 0, 0, 19}
33	35	};
34	36
35	37	void
36	38	builtin_print(struct activation ar, struct value *q)
37	39	{
38		struct value *v = activation_get_value(ar, 0, 0);
39
40		switch (v->type) {
41		case VALUE_INTEGER:
42		printf("%d", v->v.i);
43		break;
44		case VALUE_BOOLEAN:
45		printf("%s", v->v.b ? "true" : "false");
46		break;
47		case VALUE_STRING:
48		printf("%s", v->v.s);
49		break;
50		case VALUE_LIST:
51		list_dump(v->v.l);
52		break;
53		case VALUE_ERROR:
54		printf("#ERR<%s>", v->v.e);
55		break;
56		case VALUE_BUILTIN:
57		printf("#BIF<%08lx>", (unsigned long)v->v.bi);
58		break;
59		case VALUE_CLOSURE:
60		closure_dump(v->v.k);
61		break;
62		case VALUE_DICT:
63		dict_dump(v->v.d);
64		break;
65		default:
66		printf("???unknown(%d)???", v->type);
67		break;
	40	int i;
	41	/struct list l;*/
	42	struct value *v = NULL;
	43
	44	for (i = 0; i < ar->size; i++) {
	45	v = activation_get_value(ar, i, 0);
	46	if (v == NULL) {
	47	printf("(null)");
	48	continue;
	49	}
	50
	51	switch (v->type) {
	52	case VALUE_INTEGER:
	53	printf("%d", v->v.i);
	54	break;
	55	case VALUE_BOOLEAN:
	56	printf("%s", v->v.b ? "true" : "false");
	57	break;
	58	case VALUE_STRING:
	59	printf("%s", v->v.s);
	60	break;
	61	case VALUE_LIST:
	62	/*
	63	printf("[");
	64	for (l = v->v.l; l != NULL; l = l->next) {
	65	*/
	66
	67	list_dump(v->v.l);
	68	break;
	69	case VALUE_ERROR:
	70	printf("#ERR<%s>", v->v.e);
	71	break;
	72	case VALUE_BUILTIN:
	73	printf("#BIF<%08lx>", (unsigned long)v->v.bi);
	74	break;
	75	case VALUE_CLOSURE:
	76	closure_dump(v->v.k);
	77	break;
	78	case VALUE_DICT:
	79	dict_dump(v->v.d);
	80	break;
	81	default:
	82	printf("???unknown(%d)???", v->type);
	83	break;
	84	}
68	85	}
69	86
70	87	value_set_from_value(q, v);

274	291	/* list */
275	292
276	293	void
277		builtin_cons(struct activation ar, struct value *v)
278		{
279		struct value *l = activation_get_value(ar, 0, 0);
280		struct value *r = activation_get_value(ar, 1, 0);
281
282		if (l->type == VALUE_LIST) {
283		list_cons(&l->v.l, r);
284		value_set_from_value(v, l);
285		} else {
286		return(value_set_error(v, "type mismatch"));
287		}
288		}
289
290		void
291		builtin_index(struct activation ar, struct value *v)
292		{
293		struct value *l = activation_get_value(ar, 0, 0);
294		struct value *r = activation_get_value(ar, 1, 0);
	294	builtin_list(struct activation ar, struct value *v)
	295	{
	296	int i;
	297	struct value *x = NULL;
	298
	299	value_set_list(v);
	300
	301	for (i = ar->size - 1; i >= 0; i--) {
	302	x = activation_get_value(ar, i, 0);
	303	value_list_append(v, x);
	304	value_release(x);
	305	}
	306	}
	307
	308	void
	309	builtin_fetch(struct activation ar, struct value *v)
	310	{
	311	struct value *l = activation_get_value(ar, 0, 0);
	312	struct value *r = activation_get_value(ar, 1, 0);
	313	struct value *q;
295	314	int count;
296	315	struct list *li;
297	316
298		if (l->type == VALUE_LIST && r->type == VALUE_INTEGER) {
	317	if (l->type == VALUE_CLOSURE && r->type == VALUE_INTEGER) {
	318	int i = r->v.i - 1;
	319	/*
	320	* This is _EVIL_!
	321	*/
	322	if (i >= 0 && i < l->v.k->ar->size) {
	323	q = activation_get_value(l->v.k->ar, i, 0);
	324	value_set_from_value(v, q);
	325	} else {
	326	value_set_error(v, "out of bounds");
	327	}
	328	} else if (l->type == VALUE_DICT) {
	329	q = dict_fetch(l->v.d, r);
	330	value_set_from_value(v, q);
	331	value_release(q);
	332	} else if (l->type == VALUE_LIST && r->type == VALUE_INTEGER) {
299	333	li = l->v.l;
300		for (count = 1; l != NULL && count < r->v.i; count++)
	334	for (count = 1; li != NULL && count < r->v.i; count++)
301	335	li = li->next;
302	336	if (li == NULL)
303		return(value_set_error(v, "no such element"));
	337	return(value_set_error(v, "out of bounds"));
304	338	else {
305	339	value_set_from_value(v, li->value);
306	340	}

308	342	return(value_set_error(v, "type mismatch"));
309	343	}
310	344	}
	345
	346	void
	347	builtin_store(struct activation ar, struct value *v)
	348	{
	349	struct value *d = activation_get_value(ar, 0, 0);
	350	struct value *i = activation_get_value(ar, 1, 0);
	351	struct value *p = activation_get_value(ar, 2, 0);
	352	int count;
	353	struct list *li;
	354
	355	if (d->type == VALUE_DICT) {
	356	dict_store(d->v.d, i, p);
	357	value_set_from_value(v, d);
	358	} else if (d->type == VALUE_LIST && i->type == VALUE_INTEGER) {
	359	li = d->v.l;
	360	for (count = 1; li != NULL && count < i->v.i; count++)
	361	li = li->next;
	362	if (li == NULL)
	363	value_set_error(v, "no such element");
	364	else {
	365	value_set_from_value(&li->value, p);
	366	value_set_from_value(v, d);
	367	}
	368	} else {
	369	value_set_error(v, "type mismatch");
	370	}
	371	}
	372
	373	void
	374	builtin_dict(struct activation ar, struct value *v)
	375	{
	376	int i;
	377	struct value key = NULL, val = NULL;
	378
	379	value_set_dict(v);
	380
	381	if (ar->size % 2 != 0) {
	382	value_set_error(v, "number of argument must be even");
	383	} else {
	384	for (i = 0; i < ar->size; i += 2) {
	385	key = activation_get_value(ar, i, 0);
	386	val = activation_get_value(ar, i + 1, 0);
	387	value_dict_store(v, key, val);
	388	value_release(key);
	389	value_release(val);
	390	}
	391	}
	392	}

+11

-6

src/builtin.h less more

7	7	char *name;
8	8	void (fn)(struct activation , struct value **);
9	9	int arity;
10		int purity;
11		int constness;
	10	int is_pure;
	11	int is_const;
12	12	int index;
13	13	};
14	14

27	27	#define INDEX_BUILTIN_MUL 12
28	28	#define INDEX_BUILTIN_DIV 13
29	29	#define INDEX_BUILTIN_MOD 14
30		#define INDEX_BUILTIN_CONS 15
31		#define INDEX_BUILTIN_INDEX 16
	30	#define INDEX_BUILTIN_LIST 15
	31	#define INDEX_BUILTIN_FETCH 16
	32	#define INDEX_BUILTIN_STORE 17
	33	#define INDEX_BUILTIN_DICT 18
32	34
33	35	#define INDEX_BUILTIN_LAST 127
34	36

53	55	void builtin_div(struct activation , struct value *);
54	56	void builtin_mod(struct activation , struct value *);
55	57
56		void builtin_cons(struct activation , struct value *);
57		void builtin_index(struct activation , struct value *);
	58	void builtin_list(struct activation , struct value *);
	59	void builtin_fetch(struct activation , struct value *);
	60	void builtin_store(struct activation , struct value *);
	61
	62	void builtin_dict(struct activation , struct value *);
58	63
59	64	#endif

+4

-8

src/closure.c less more

9	9	#include "vm.h"
10	10
11	11	struct closure *
12		closure_new(struct ast a, struct activation ar, int arity, int cc)
	12	closure_new(struct ast a, struct activation ar)
13	13	{
14	14	struct closure *c;
15	15
16	16	c = bhuna_malloc(sizeof(struct closure));
17	17	c->ast = a;
18		c->label = NULL;
19	18	c->ar = ar;
20		c->arity = arity;
21		c->cc = cc;
22	19
23	20	return(c);
24	21	}

26	23	void
27	24	closure_free(struct closure *c)
28	25	{
29		/activation_release(c->ar);/
30	26	bhuna_free(c);
31	27	}
32	28

34	30	closure_dump(struct closure *c)
35	31	{
36	32	#ifdef DEBUG
37		printf("closure(arity=%d,contains=%d){", c->arity, c->cc);
38		activation_dump(c->ar, 0);
39		ast_dump(c->ast, 0);
	33	printf("closure{");
	34	activation_dump(c->ar, 1);
	35	ast_dump(c->ast, 1);
40	36	printf("}");
41	37	#endif
42	38	}

+1

-4

src/closure.h less more

7	7
8	8	struct closure {
9	9	struct ast *ast;
10		vm_label_t label;
11	10	struct activation ar; / env in which we were created */
12		int arity; /* takes this many arguments */
13		int cc; /* contains this many sub-closures */
14	11	};
15	12
16		struct closure closure_new(struct ast , struct activation *, int, int);
	13	struct closure closure_new(struct ast , struct activation *);
17	14	void closure_free(struct closure *);
18	15	void closure_dump(struct closure *);
19	16

+57

-6

src/dict.c less more

70	70	return(d);
71	71	}
72	72
	73	static struct chain *
	74	chain_dup(struct chain *f)
	75	{
	76	struct chain c, n, p = NULL, h = NULL;
	77
	78	for (c = f; c != NULL; c = c->next) {
	79	n = bhuna_malloc(sizeof(struct chain));
	80
	81	n->next = NULL;
	82	value_grab(c->key);
	83	n->key = c->key;
	84	value_grab(c->value);
	85	n->value = c->value;
	86
	87	if (h == NULL)
	88	h = n;
	89	else
	90	p->next = n;
	91
	92	p = n;
	93	}
	94
	95	return(h);
	96	}
	97
	98	struct dict *
	99	dict_dup(struct dict *f)
	100	{
	101	struct dict *d;
	102	int i;
	103
	104	d = bhuna_malloc(sizeof(struct dict));
	105	d->num_buckets = 31;
	106	d->bucket = bhuna_malloc(sizeof(struct chain ) d->num_buckets);
	107	for (i = 0; i < d->num_buckets; i++) {
	108	d->bucket[i] = chain_dup(f->bucket[i]);
	109	}
	110	d->cursor = NULL; /* hmmm... dup'ing this would take trickery. */
	111	d->cur_bucket = 0;
	112
	113	return(d);
	114	}
	115
73	116	/* DESTRUCTORS */
74	117
75	118	static void

116	159	* This is naff... for certain values this will work.
117	160	* For others, it won't...
118	161	*/
119		for (p = (char )key; p - (char )key < sizeof(struct value); p++) {
120		h = (h << 4) + (*p);
121		if ((g = h & 0xf0000000))
122		h = (h ^ (g >> 24)) ^ g;
	162	if (key->type == VALUE_INTEGER \|\|
	163	key->type == VALUE_BOOLEAN \|\|
	164	key->type == VALUE_ATOM) {
	165	for (p = (char )key; p - (char )key < sizeof(int); p++) {
	166	h = (h << 4) + (*p);
	167	if ((g = h & 0xf0000000))
	168	h = (h ^ (g >> 24)) ^ g;
	169	}
	170	} else {
	171	assert("key no good" == NULL);
123	172	}
124	173
125	174	return(h % table_size);

136	185	c = bhuna_malloc(sizeof(struct chain));
137	186
138	187	c->next = NULL;
139		/* XXX grab? */
140	188	c->key = key;
141	189	c->value = value;
142	190

171	219
172	220	dict_locate(d, k, &i, &c);
173	221	if (c != NULL) {
174		/* XXX grab? */
	222	value_grab(c->value);
175	223	return(c->value);
176	224	} else {
177	225	return(NULL);

190	238	dict_locate(d, k, &i, &c);
191	239	if (c == NULL) {
192	240	/* Chain does not exist, add a new one. */
	241	value_grab(k);
	242	value_grab(v);
193	243	c = chain_new(k, v);
194	244	c->next = d->bucket[i];
195	245	d->bucket[i] = c;
196	246	} else {
197	247	/* Chain already exists, replace the value. */
198	248	value_release(c->value);
	249	value_grab(v);
199	250	c->value = v;
200	251	}
201	252	}

+1

-0

src/dict.h less more

56	56	};
57	57
58	58	struct dict *dict_new(void);
	59	struct dict dict_dup(struct dict );
59	60	void dict_free(struct dict *);
60	61
61	62	struct value dict_fetch(struct dict , struct value *);

+31

-16

src/gen.c less more

13	13	extern int trace_gen;
14	14
15	15	static vm_label_t gptr;
16		static unsigned char program[65536];
	16	unsigned char program[65536];
17	17
18	18	vm_label_t patch_stack[4096];
19	19	int psp = 0;

69	69	#endif
70	70
71	71	gen(INSTR_PUSH_VALUE);
	72	value_grab(v);
72	73	(((struct value *)gptr)++) = v;
73	74	}
74	75

183	184	}
184	185
185	186	static void
186		gen_set_activation_bp(int *bpid)
187		{
188		#ifdef DEBUG
189		if (trace_gen)
190		printf("#%d: *SET_ACTIVATION", gptr - program);
	187	gen_set_activation(void)
	188	{
	189	#ifdef DEBUG
	190	if (trace_gen)
	191	printf("#%d: *SET_ACTIVATION\n", gptr - program);
191	192	#endif
192	193	gen(INSTR_SET_ACTIVATION);
193		*bpid = request_backpatch(&gptr);
194		#ifdef DEBUG
195		if (trace_gen)
196		printf("($%d)\n", *bpid);
197		#endif
	194	}
	195
	196	static void
	197	gen_deep_copy(void)
	198	{
	199	#ifdef DEBUG
	200	if (trace_gen)
	201	printf("#%d: *DEEP_COPY\n", gptr - program);
	202	#endif
	203	gen(INSTR_DEEP_COPY);
198	204	}
199	205
200	206	static void

202	208	{
203	209	int bpid_1, bpid_2;
204	210	vm_label_t label;
	211	struct value *v;
205	212
206	213	if (a == NULL)
207	214	return;
208	215
	216	a->label = gptr;
209	217	switch (a->type) {
210	218	case AST_LOCAL:
211	219	gen_push_local(a->u.local.index, a->u.local.upcount);

213	221	case AST_VALUE:
214	222	gen_push_value(a->u.value.value);
215	223	if (a->u.value.value->type == VALUE_CLOSURE) {
216		gen_set_activation_bp(&bpid_1);
217		gen_jmp_bp(&bpid_2);
218		backpatch(bpid_1);
	224	gen_set_activation();
	225	gen_jmp_bp(&bpid_1);
219	226	ast_gen_r(a->u.value.value->v.k->ast);
220	227	gen_ret();
221		backpatch(bpid_2);
	228	backpatch(bpid_1);
222	229	}
223	230	break;
224	231	case AST_BUILTIN:
225		ast_gen_r(a->u.builtin.left);
226	232	ast_gen_r(a->u.builtin.right);
	233	if (a->u.builtin.bi->arity == -1) {
	234	v = value_new_integer(ast_count_args(a->u.builtin.right));
	235	gen_push_value(v);
	236	value_release(v);
	237	}
227	238	gen_builtin(a->u.builtin.bi);
228	239	break;
229	240	case AST_APPLY:

231	242	ast_gen_r(a->u.apply.left);
232	243	gen_apply();
233	244	break;
	245	case AST_ROUTINE:
	246	ast_gen_r(a->u.routine.body);
	247	break;
234	248	case AST_ARG:
235	249	ast_gen_r(a->u.arg.left);
236	250	ast_gen_r(a->u.arg.right);

243	257	assert(a->u.assignment.left != NULL);
244	258	assert(a->u.assignment.left->type == AST_LOCAL);
245	259	ast_gen_r(a->u.assignment.right);
	260	gen_deep_copy();
246	261	gen_pop_local(a->u.assignment.left->u.local.index,
247	262	a->u.assignment.left->u.local.upcount);
248	263	break;

+10

-0

src/list.c less more

15	15	n->value = v;
16	16	n->next = *l;
17	17	*l = n;
	18	}
	19
	20	struct list *
	21	list_dup(struct list *l)
	22	{
	23	struct list *n;
	24
	25	/* ... XXX ... */
	26
	27	return(n);
18	28	}
19	29
20	30	void

+6

-5

src/list.h less more

9	9	struct value *value;
10	10	};
11	11
12		void list_cons(struct list *, struct value );
13		void list_free(struct list **);
14		size_t list_length(struct list *);
15		int list_contains(struct list , struct value );
	12	void list_cons(struct list *, struct value );
	13	struct list list_dup(struct list );
	14	void list_free(struct list **);
	15	size_t list_length(struct list *);
	16	int list_contains(struct list , struct value );
16	17
17		void list_dump(struct list *);
	18	void list_dump(struct list *);
18	19
19	20	#endif /* !__LIST_H_ */

+13

-7

src/main.c less more

25	25	int trace_closures = 0;
26	26	int trace_vm = 0;
27	27	int trace_gen = 0;
	28	int trace_pool = 0;
28	29
29	30	int num_vars_created = 0;
30	31	int num_vars_grabbed = 0;

38	39	#endif
39	40
40	41	#ifdef DEBUG
41		#define OPTS "acfg:klmnoprstvxz"
	42	#define OPTS "acdfg:klmnoprstvxz"
42	43	#define RUN_PROGRAM run_program
43	44	#else
44	45	#define OPTS "g:x"

58	59	#ifdef DEBUG
59	60	fprintf(stderr, " -a: trace assignments\n");
60	61	fprintf(stderr, " -c: trace calls\n");
	62	fprintf(stderr, " -d: trace pooling\n");
61	63	fprintf(stderr, " -f: trace frames\n");
62	64	#endif
63	65	fprintf(stderr, " -g int: set garbage collection threshold\n");

90	92	for (i = 0; b[i].name != NULL; i++) {
91	93	v = value_new_builtin(&b[i]);
92	94	sym = symbol_define(stab, b[i].name, SYM_KIND_COMMAND, v);
93		sym->is_pure = b[i].purity;
	95	sym->is_pure = b[i].is_pure;
94	96	sym->builtin = &b[i];
95	97	value_release(v);
96	98	}
97
	99
98	100	/* XXX */
99	101	v = value_new_string("\n");
100	102	sym = symbol_define(stab, "EoL", SYM_KIND_VARIABLE, v);

116	118	struct scan_st *sc;
117	119	struct symbol_table *stab;
118	120	struct ast *a;
119		struct value *v;
120	121	char *source = NULL;
121	122	int opt;
122	123	int use_vm = 0;

151	152	case 'c':
152	153	trace_calls++;
153	154	break;
	155	case 'd':
	156	trace_pool++;
	157	break;
154	158	case 'f':
155	159	debug_frame++;
156	160	break;

215	219	gc_target = gc_trigger;
216	220	if ((sc = scan_open(source)) != NULL) {
217	221	stab = symbol_table_new(NULL, 0);
218		global_ar = activation_new(100, NULL, NULL);
219		activation_register(global_ar);
	222	global_ar = activation_new_on_stack(100, NULL, NULL);
220	223	load_builtins(stab, builtins);
221	224	a = parse_program(sc, stab);
222	225	scan_close(sc);

235	238	unsigned char *program;
236	239
237	240	program = ast_gen(a);
	241	/* ast_dump(a, 0); */
238	242	if (RUN_PROGRAM) {
239	243	vm_run(program);
240	244	}
	245	vm_release(program);
	246	/value_dump_global_table();/
241	247	#ifdef RECURSIVE_AST_EVALUATOR
242	248	} else if (sc->errors == 0 && RUN_PROGRAM) {
243	249	v = value_new_integer(76);

252	258	#endif
253	259	ast_free(a);
254	260	activation_gc();
255		activation_free(global_ar);
	261	activation_free_from_stack(global_ar);
256	262	#ifdef DEBUG
257	263	symbol_table_free(stab);
258	264	if (trace_refcounting > 0) {

+3

-3

src/mem.h less more

42	42
43	43	#include <sys/types.h>
44	44
45		#ifdef DEBUG
	45	/*#ifdef DEBUG
46	46	void *bhuna_malloc(size_t);
47	47	char bhuna_strdup(char );
48	48	void bhuna_free(void *);
49		#else
	49	#else*/
50	50	#define bhuna_malloc(x) malloc(x)
51	51	#define bhuna_strdup(x) strdup(x)
52	52	#define bhuna_free(x) free(x)
53		#endif
	53	/#endif/
54	54
55	55	#endif

+0

-367

~~src/misc/i_eval.c~~ less more

0		#include <assert.h>
1		#include <stdio.h>
2		#include <stdlib.h>
3		#include <string.h>
4
5		#include "ast.h"
6		#include "value.h"
7		#include "list.h"
8		#include "closure.h"
9		#include "activation.h"
10
11		#ifdef DEBUG
12		#include "symbol.h"
13
14		extern int trace_assignments;
15		extern int trace_calls;
16		extern int trace_ast;
17		extern int trace_closures;
18		#endif
19
20		extern struct activation *current_ar;
21
22		/* UTILITY */
23
24		#define MOVE 0
25		#define QUERY 1
26
27		struct stack {
28		struct tree *t;
29		int state;
30		} s[256];
31		int sp = 0;
32
33		static void
34		push(struct ast *t, int state)
35		{
36		if (t == NULL) return;
37		s[sp].t = t;
38		s[sp].state = state;
39		sp++;
40		}
41
42		static void
43		pop(struct ast *t, int state)
44		{
45		--sp;
46		*t = s[sp].t;
47		*state = s[sp].state;
48		}
49
50		/* OPERATIONS */
51
52		/*
53		* Fill out an activation record with arguments.
54		* !!!!!!!!ar in here is part of the G.D. root set!!!!!!!!!!!
55		*/
56		static void
57		ast_fillout(struct ast a, struct activation ar, int *idxp)
58		{
59		struct value *v = NULL;
60
61		if (a == NULL)
62		return;
63
64		switch (a->type) {
65		case AST_ARG:
66		ast_fillout(a->u.arg.left, ar, idxp);
67		ast_fillout(a->u.arg.right, ar, idxp);
68		break;
69		default:
70		ast_eval(a, &v);
71
72		activation_set_value(ar, (*idxp)++, 0, v);
73		value_release(v);
74		}
75		}
76
77		/* EVALUATOR */
78
79		/*
80		* a is roughly analogous to the program counter (PC.)
81		*
82		* v is roughly analogous to the accumulator (A) or top of stack (ToS).
83		*/
84		void
85		ast_eval(struct ast a, struct value *v)
86		{
87		int state;
88
89		push(a, MOVE);
90
91		while (sp != 0) {
92		pop(&a, &state);
93		if (state == MOVE) {
94		switch (a->type) {
95		case AST_LOCAL:
96		case AST_VALUE:
97		case AST_SCOPE:
98		ast_eval(a->u.scope.body, v);
99		break;
100		case AST_APPLY:
101		ast_eval(a->u.apply.left, &l);
102		ast_eval(l->v.k->ast, v);
103		break;
104		case AST_ARG:
105		assert("this should never happen" == NULL);
106		/*value_set_list(v);
107		ast_flatten(a, v);*/
108		break;
109		case AST_STATEMENT:
110		push(a, QUERY);
111		push(a->u.statement.right, MOVE);
112		push(a->u.statement.left, MOVE);
113		break;
114		case AST_ASSIGNMENT:
115		ast_eval(a->u.assignment.right, v);
116		break;
117		case AST_CONDITIONAL:
118		ast_eval(a->u.conditional.test, &l);
119		ast_eval(a->u.conditional.yes, v);
120		ast_eval(a->u.conditional.no, v);
121		case AST_WHILE_LOOP:
122		ast_eval(a->u.while_loop.test, &l);
123		ast_eval(a->u.while_loop.body, v);
124		}
125
126		push(t, QUERY);
127		if (t->r != NULL) push(t->r, MOVE);
128		if (t->l != NULL) push(t->l, MOVE);
129		}
130		} else if (state == QUERY) {
131		printf(" %c", t->c);
132		}
133		}
134		}
135
136
137
138
139		void
140		ast_eval(struct ast a, struct value *v)
141		{
142		struct value l = NULL, lv = NULL;
143		struct activation new_ar = NULL, old_ar = NULL;
144		int i;
145
146		if (a == NULL)
147		return;
148
149		#ifdef DEBUG
150		if (trace_ast) {
151		printf(">>> ENTERING %s[0x%08lx]\n", ast_name(a), (unsigned long)a);
152		}
153		#endif
154
155		switch (a->type) {
156		case AST_LOCAL:
157		/*
158		printf("index = %d, upcount = %d\n",
159		a->u.local.index, a->u.local.upcount);
160		activation_dump(current_ar, 0);
161		printf("\n");
162		*/
163		lv = activation_get_value(current_ar,
164		a->u.local.index, a->u.local.upcount);
165		assert(lv != NULL);
166		value_set_from_value(v, lv);
167		/value_release(lv);/
168		break;
169		case AST_VALUE:
170		value_set_from_value(v, a->u.value.value);
171		if (v != NULL && (v)->type == VALUE_CLOSURE) {
172		#ifdef DEBUG
173		if (trace_closures) {
174		printf("Freshening ");
175		closure_dump((*v)->v.k);
176		printf(" with ");
177		activation_dump(current_ar, 1);
178		printf("\n");
179		}
180		#endif
181		/activation_release((v)->v.k->ar);
182		activation_grab(current_ar);*/
183		(*v)->v.k->ar = current_ar;
184		}
185		/value_release(a->u.value.value);/
186		break;
187		case AST_SCOPE:
188		/*
189		* pretty sure we don't need to do anything with the stab, here.
190		* although we may want to note somewhere that this is the
191		* most recently encountered stab.
192		*/
193		ast_eval(a->u.scope.body, v);
194		break;
195		case AST_APPLY:
196		/*
197		* Get the function we're being asked to apply.
198		*/
199		ast_eval(a->u.apply.left, &l);
200
201		/*
202		* Create a new activation record apropos to l.
203		* When l is a closure, include the closure's
204		* environment as the lexical link of the record.
205		*/
206		assert(l->type == VALUE_BUILTIN \|\| l->type == VALUE_CLOSURE);
207		old_ar = current_ar;
208		if (l->type == VALUE_BUILTIN) {
209		new_ar = activation_new(2, current_ar, NULL); /* haha */
210		} else if (l->type == VALUE_CLOSURE) {
211		assert(l->v.k->ast->type == AST_SCOPE);
212		/* value_print(l); */
213		new_ar = activation_new(
214		l->v.k->ast->u.scope.frame_size,
215		current_ar,
216		l->v.k->ar);
217		}
218		assert(current_ar == old_ar);
219
220		/*
221		* Now, fill out that activation record with the
222		* supplied arguments.
223		*/
224		i = 0;
225		ast_fillout(a->u.apply.right, new_ar, &i);
226		/printf(":: filled out %d\n", i);/
227
228		#ifdef DEBUG
229		if (trace_calls) {
230		printf("---> call:");
231		value_print(l);
232		printf("(");
233		activation_dump(current_ar, 1);
234		printf(")\n");
235		}
236		#endif
237
238		if (l->type == VALUE_BUILTIN) {
239		struct value *g;
240		g = l->v.f(new_ar);
241		assert(current_ar == old_ar);
242		value_set_from_value(v, g);
243		value_release(g);
244		} else if (l->type == VALUE_CLOSURE) {
245		current_ar = new_ar;
246		ast_eval(l->v.k->ast, v);
247		assert(current_ar == new_ar);
248		assert(current_ar->caller == old_ar);
249		current_ar = current_ar->caller;
250		}
251
252		/*
253		* Indicate that we're not longer using ar and that
254		* the refcounter can deallocate it if it wants.
255		*/
256		/activation_release(current_ar);/
257
258		/*
259		* Restore the environment of the symbols to what it was
260		* before the closure was evaluated.
261		*/
262		/*
263		printf("Returning to caller:\n");
264		activation_dump(current_ar->prev, 1);
265		printf("\n");
266		*/
267
268
269		/*
270		current_ar = old_ar;
271		*/
272
273		#ifdef DEBUG
274		if (trace_calls) {
275		printf("<--- call done, retval=");
276		value_print(*v);
277		printf("\n");
278		}
279		#endif
280
281		value_release(l);
282		break;
283		case AST_ARG:
284		assert("this should never happen" == NULL);
285		/*value_set_list(v);
286		ast_flatten(a, v);*/
287		break;
288		case AST_STATEMENT:
289		ast_eval(a->u.statement.left, &l);
290		value_release(l);
291		ast_eval(a->u.statement.right, v);
292		break;
293		case AST_ASSIGNMENT:
294		ast_eval(a->u.assignment.right, v);
295		assert(a->u.assignment.left != NULL);
296		if (a->u.assignment.left->type == AST_LOCAL) {
297		activation_set_value(current_ar,
298		a->u.assignment.left->u.local.index,
299		a->u.assignment.left->u.local.upcount,
300		*v);
301		#ifdef DEBUG
302		if (trace_assignments) {
303		symbol_dump(a->u.assignment.left->u.local.sym, 1);
304		printf(":=");
305		value_print(*v);
306		printf("\n");
307		}
308		#endif
309		} else {
310		value_set_error(v, "bad lvalue");
311		}
312		break;
313		case AST_CONDITIONAL:
314		ast_eval(a->u.conditional.test, &l);
315		if (l == NULL \|\| l->type != VALUE_BOOLEAN) {
316		value_set_error(v, "type mismatch");
317		} else {
318		if (l->v.b) {
319		ast_eval(a->u.conditional.yes, v);
320		} else if (a->u.conditional.no != NULL) {
321		ast_eval(a->u.conditional.no, v);
322		} else {
323		value_set_error(v, "missing else");
324		}
325		}
326		value_release(l);
327		break;
328		case AST_WHILE_LOOP:
329		for (;;) {
330		ast_eval(a->u.while_loop.test, &l);
331		if (l == NULL \|\| l->type != VALUE_BOOLEAN) {
332		value_release(l);
333		value_set_error(v, "type mismatch");
334		break;
335		} else {
336		/*
337		printf("WHILE: test=");
338		value_print(l);
339		printf("\n");
340		*/
341		if (!l->v.b) {
342		/*
343		* `while' condition evaluated to false.
344		*/
345		value_release(l);
346		break;
347		}
348		ast_eval(a->u.while_loop.body, v);
349		/*
350		printf("WHILE: body=");
351		value_print(*v);
352		printf("\n");
353		*/
354		}
355		}
356		break;
357		}
358
359		#ifdef DEBUG
360		if (trace_ast) {
361		printf("<<< LEAVING %s[0x%08lx] w/value=", ast_name(a), (unsigned long)a);
362		value_print(*v);
363		printf("\n");
364		}
365		#endif
366		}

+0

-99

~~src/misc/itree.c~~ less more

0		#include <stdlib.h>
1		#include <stdio.h>
2
3		struct tree {
4		struct tree *l;
5		struct tree *r;
6		char c;
7		};
8
9		struct tree *
10		new_tree(struct tree l, struct tree r, char c)
11		{
12		struct tree *t;
13
14		t = malloc(sizeof(struct tree));
15		t->l = l;
16		t->r = r;
17		t->c = c;
18		return(t);
19		}
20
21		void
22		dump_tree_r(struct tree *t)
23		{
24		if (t == NULL) return;
25		dump_tree_r(t->l);
26		dump_tree_r(t->r);
27		printf(" %c", t->c);
28		}
29
30		/-------------------------------------------/
31
32		#define MOVE 0
33		#define QUERY 1
34
35		struct stack {
36		struct tree *t;
37		int state;
38		} s[256];
39		int sp = 0;
40
41		void
42		push(struct tree *t, int state)
43		{
44		s[sp].t = t;
45		s[sp].state = state;
46		sp++;
47		}
48
49		void
50		pop(struct tree *t, int state)
51		{
52		--sp;
53		*t = s[sp].t;
54		*state = s[sp].state;
55		}
56
57		void
58		dump_tree_i(struct tree *arg)
59		{
60		struct tree *t;
61		int state;
62
63		push(arg, MOVE);
64
65		while (sp != 0) {
66		pop(&t, &state);
67		if (state == MOVE) {
68		push(t, QUERY);
69		if (t->r != NULL) {
70		push(t->r, MOVE);
71		}
72		if (t->l != NULL) {
73		push(t->l, MOVE);
74		}
75		} else if (state == QUERY) {
76		printf(" %c", t->c);
77		}
78		}
79		}
80
81		int main(int argc, char **argv)
82		{
83		struct tree *t;
84
85		t = new_tree(
86		new_tree(NULL, NULL, 'a'),
87		new_tree(
88		new_tree(NULL, NULL, '2'),
89		new_tree(NULL, NULL, '3'),
90		'+'),
91		'=');
92
93		dump_tree_r(t);
94		printf("\n");
95		dump_tree_i(t);
96		printf("\n");
97		return(0);
98		}

+0

-83

~~src/misc/pool.c~~ less more

0		#include <assert.h>
1		#include <stdlib.h>
2		#include <stdio.h>
3
4		#include "pool.h"
5
6		static struct value_pool *current_vp = NULL;
7		static struct pooled_value *pv_free = NULL;
8
9		int trace_pool = 1;
10
11		void
12		value_pool_new(void)
13		{
14		struct value_pool *vp;
15		int i;
16
17		#ifdef DEBUG
18		if (trace_pool) {
19		printf("MAKING NEW POOL\n");
20		printf("value size = %4d\n", sizeof(struct value));
21		printf("pooled-value size = %4d\n", sizeof(struct pooled_value));
22		printf("page size = %4d\n", PAGE_SIZE);
23		printf("header size = %4d\n", HEADER_SIZE);
24		printf("value pool size = %4d\n", sizeof(struct value_pool));
25		printf("values per pool = %4d\n", VALUES_PER_POOL);
26		}
27		#endif
28		assert(sizeof(struct value_pool) <= PAGE_SIZE);
29		vp = malloc(PAGE_SIZE);
30
31		/*
32		* Link us up to the parent pool, if any.
33		*/
34		vp->prev = current_vp;
35
36		/*
37		* Create an initial freelist within the pool,
38		* and link it into our global freelist pv_free.
39		*/
40		vp->pool[0].pv.free = pv_free;
41		for (i = 1; i < VALUES_PER_POOL; i++)
42		vp->pool[i].pv.free = &vp->pool[i-1];
43		pv_free = &vp->pool[VALUES_PER_POOL - 1];
44
45		current_vp = vp;
46		}
47
48		struct value *
49		value_allocate(void)
50		{
51		struct value *r;
52
53		/*
54		* Check to see if this is the last remaining slot in the pool.
55		*/
56		if (pv_free->pv.free == NULL) {
57		/*
58		* If so, create a new pool.
59		*/
60		value_pool_new();
61		}
62		/*
63		* Find the next pooled value on the freelist,
64		* remove it from the freelist, and return it.
65		*/
66		r = &(pv_free->pv.v);
67		pv_free = pv_free->pv.free;
68
69		/printf("pool: allocate: next free now %08lx\n", pv_free);/
70		return(r);
71		}
72
73		void
74		value_deallocate(struct value *v)
75		{
76		/*
77		* Tack this value back onto the freelist.
78		*/
79		((struct pooled_value *)v)->pv.free = pv_free;
80		pv_free = (struct pooled_value *)v;
81		printf("pool: deallocate: next free now %08lx\n", (unsigned long)pv_free);
82		}

+0

-22

~~src/misc/pool.h~~ less more

0		#include "value.h"
1
2		struct pooled_value {
3		union {
4		struct value v;
5		struct pooled_value *free;
6		} pv;
7		};
8
9		#define PAGE_SIZE 16384
10		#define HEADER_SIZE sizeof(struct value_pool *)
11		#define VALUES_PER_POOL (PAGE_SIZE - HEADER_SIZE) / sizeof(struct pooled_value) - 1
12
13		struct value_pool {
14		struct value_pool * prev;
15		struct pooled_value pool[VALUES_PER_POOL];
16		};
17
18		void value_pool_new(void);
19
20		struct value *value_allocate(void);
21		void value_deallocate(struct value *);

+171

-122

src/parse.c less more

58	58	/* --- util --- */
59	59
60	60	/*
61		* Convenience function to create AST for a named function call on 2 arguments.
	61	* Convenience function to create AST for a named arity-2 function call.
62	62	*/
63	63	static struct ast *
64		ast_new_nfcall(char name, struct symbol_table stab, struct ast a, struct ast b)
	64	ast_new_call2(char name, struct symbol_table stab,
	65	struct ast left, struct ast right)
65	66	{
66	67	struct symbol *sym;
67		/struct ast l, r = NULL;/
	68	struct ast *a;
	69
	70	left = ast_new_arg(left, NULL);
	71	right = ast_new_arg(right, NULL);
	72	left->u.arg.right = right;
68	73
69	74	sym = symbol_lookup(stab, name, VAR_GLOBAL);
70		assert(sym->builtin != NULL);
71		a = ast_new_builtin(a, b, sym->builtin);
72		/*
73		} else if (sym->value != NULL) {
74		r = ast_new_arg(a, b);
75		l = ast_new_value(sym->value);
76		a = ast_new_apply(l, r, sym->is_pure);
77		} else {
78		r = ast_new_arg(a, b);
79		l = ast_new_local(sym->index, stab->level - sym->in->level, sym);
80		a = ast_new_apply(l, r, sym->is_pure);
81		}
82		*/
	75	assert(sym != NULL && sym->builtin != NULL);
	76	a = ast_new_builtin(sym->builtin, left);
	77
	78	return(a);
	79	}
	80
	81	static struct ast *
	82	ast_new_call3(char name, struct symbol_table stab,
	83	struct ast left, struct ast index, struct ast *right)
	84	{
	85	struct symbol *sym;
	86	struct ast *a;
	87
	88	left = ast_new_arg(left, NULL);
	89	index = ast_new_arg(index, NULL);
	90	right = ast_new_arg(right, NULL);
	91	left->u.arg.right = index;
	92	index->u.arg.right = right;
	93
	94	sym = symbol_lookup(stab, name, VAR_GLOBAL);
	95	assert(sym != NULL && sym->builtin != NULL);
	96	a = ast_new_builtin(sym->builtin, left);
	97
83	98	return(a);
84	99	}
85	100

89	104	parse_program(struct scan_st sc, struct symbol_table stab)
90	105	{
91	106	struct ast *a = NULL;
92		int cc;
93
94		while (sc->type != TOKEN_EOF) {
	107	int cc, retr = 0;
	108
	109	while (sc->type != TOKEN_EOF && !retr) {
95	110	cc = 0;
96		a = ast_new_statement(a, parse_statement(sc, stab, &cc));
	111	a = ast_new_statement(a, parse_statement(sc, stab, &retr, &cc));
97	112	}
98	113
99	114	return(a);

108	123	struct symbol_table *istab, int cc)
109	124	{
110	125	struct ast *a = NULL;
111		/* struct value *v;
112		struct symbol sym; /
	126	int retr = 0;
113	127
114	128	assert(*istab != NULL);
115	129
116	130	if (tokeq(sc, "{")) {
117	131	scan_expect(sc, "{");
118		while (tokne(sc, "}") && sc->type != TOKEN_EOF) {
119		a = ast_new_statement(a, parse_statement(sc, *istab, cc));
	132	while (tokne(sc, "}") && sc->type != TOKEN_EOF && !retr) {
	133	a = ast_new_statement(a,
	134	parse_statement(sc, *istab, &retr, cc));
120	135	}
121	136	scan_expect(sc, "}");
122	137	} else {
123		a = parse_statement(sc, *istab, cc);
	138	a = parse_statement(sc, *istab, &retr, cc);
124	139	}
125	140
126	141	/*
127		* For housekeeping, we place a reference to this symbol table
128		* in an anonymous symbol in the overlying symbol table.
	142	* XXX
	143	* For housekeeping, it would be nice to place a reference to this
	144	* symbol table in the overlying symbol table, so that when it is
	145	* dumped, this one is dumped too.
129	146	*/
130		/*
131		if (!symbol_table_is_empty(*istab) != NULL) {
132		sym = symbol_define(stab, NULL, SYM_KIND_ANONYMOUS);
133		v = value_new_symbol_table(*istab);
134		symbol_set_value(sym, v);
135		value_release(v);
136		}
137		*/
138
139		return(a);
140		}
141
142		struct ast *
143		parse_statement(struct scan_st sc, struct symbol_table stab, int *cc)
	147
	148	return(a);
	149	}
	150
	151	struct ast *
	152	parse_statement(struct scan_st sc, struct symbol_table stab, int retr, int cc)
144	153	{
145	154	struct symbol_table *istab;
146		/struct symbol sym;*/
147	155	struct ast a, l, *r;
148	156
149	157	if (tokeq(sc, "{")) {

151	159	a = parse_block(sc, stab, &istab, cc);
152	160	} else if (tokeq(sc, "if")) {
153	161	scan(sc);
154		/*
155		* Create a temporary value for this test.
156		*/
157		/*
158		sym = symbol_define(stab, NULL, SYM_KIND_ANONYMOUS, NULL);
159		*/
160		a = parse_expr(sc, stab, 0, cc);
	162	a = parse_expr(sc, stab, 0, NULL, cc);
161	163	istab = symbol_table_new(stab, 0);
162	164	l = parse_block(sc, stab, &istab, cc);
163	165	if (tokeq(sc, "else")) {

167	169	} else {
168	170	r = NULL;
169	171	}
170		/*
171		a = ast_new_conditional(a, l, r, sym->index);
172		*/
173	172	a = ast_new_conditional(a, l, r);
174	173	} else if (tokeq(sc, "while")) {
175	174	scan(sc);
176		l = parse_expr(sc, stab, 0, cc);
	175	l = parse_expr(sc, stab, 0, NULL, cc);
177	176	istab = symbol_table_new(stab, 0);
178	177	r = parse_block(sc, stab, &istab, cc);
179	178	a = ast_new_while_loop(l, r);
180	179	} else if (tokeq(sc, "return")) {
181	180	scan(sc);
182		a = parse_expr(sc, stab, 0, cc);
	181	a = parse_expr(sc, stab, 0, NULL, cc);
183	182	a = ast_new_retr(a);
	183	*retr = 1;
184	184	} else {
185	185	int is_const = 0;
186		int is_assign = 0;
	186	int is_def = 0;
187	187
188	188	while (tokeq(sc, "local") \|\| tokeq(sc, "const")) {
189		is_assign = 1;
	189	is_def = 1;
190	190	if (tokeq(sc, "local")) {
191	191	scan(sc);
192	192	/* Not much, mere presence works. */

195	195	is_const = 1;
196	196	}
197	197	}
198		if (is_assign \|\| symbol_lookup(stab, sc->token, VAR_GLOBAL) == NULL) {
	198	if (is_def \|\| symbol_lookup(stab, sc->token, VAR_GLOBAL) == NULL) {
199	199	/*
200		* Symbol doesn't exist at all - it MUST be
201		* an assignment, and it MUST be local.
	200	* Symbol doesn't exist at all, so it
	201	* must be a variable definition.
202	202	*/
203		a = parse_assignment(sc, stab, is_const, cc);
	203	a = parse_definition(sc, stab, is_const, cc);
204	204	} else {
205		a = parse_command(sc, stab, cc);
	205	/*
	206	* Symbol already exists, so it could be
	207	* either a command or an assignment.
	208	*/
	209	a = parse_command_or_assignment(sc, stab, cc);
206	210	}
207	211	}
208	212	if (tokeq(sc, ";"))

211	215	}
212	216
213	217	struct ast *
214		parse_assignment(struct scan_st sc, struct symbol_table stab, int is_const,
	218	parse_definition(struct scan_st sc, struct symbol_table stab, int is_const,
215	219	int *cc)
216	220	{
217	221	struct symbol *sym;

227	231	l = parse_var(sc, stab, &sym, VAR_LOCAL, VAR_MUST_NOT_EXIST, v);
228	232	value_release(v);
229	233	scan_expect(sc, "=");
230		r = parse_expr(sc, stab, 0, cc);
	234	r = parse_expr(sc, stab, 0, sym, cc);
231	235	if (is_const) {
232		if (!ast_is_constant(r)) {
	236	if (r == NULL \|\| r->type != AST_VALUE) {
233	237	scan_error(sc, "Expression must be constant");
234	238	} else {
235		/* XXX CONSTANT FOLDING PLEASE */
236		/*
237		ast_eval(r, &v);
238		printf("Constant value = ");
239		value_print(v);
240		printf("\n");
241		symbol_set_value(sym, v);
242
	239	symbol_set_value(sym, r->u.value.value);
243	240	ast_free(l);
244	241	ast_free(r);
245		*/
246	242	}
247	243	return(NULL);
248	244	} else {

251	247	}
252	248
253	249	struct ast *
254		parse_command(struct scan_st sc, struct symbol_table stab,
255		int *cc)
	250	parse_command_or_assignment(struct scan_st sc, struct symbol_table stab,
	251	int *cc)
256	252	{
257	253	struct symbol *sym;
258	254	struct ast a, l, r, z;
259	255
260	256	a = parse_var(sc, stab, &sym, VAR_GLOBAL, VAR_MUST_EXIST, NULL);
	257
	258	/*
	259	* A[I] = J -> Store A, I, J
	260	* A[A[I]] = J -> Store A, A[I], J
	261	* A[I][J] = K -> Store A[I], J, K
	262	* A[I][J][K] = L -> Store A[I][J], K, L
	263	*/
	264	while (tokeq(sc, "[") \|\| tokeq(sc, ".")) {
	265	if (tokeq(sc, "[")) {
	266	scan(sc);
	267	l = parse_expr(sc, stab, 0, NULL, cc);
	268	scan_expect(sc, "]");
	269	if (tokeq(sc, "=")) {
	270	/*
	271	* It was the last one; this is an assigment.
	272	*/
	273	scan(sc);
	274	r = parse_expr(sc, stab, 0, NULL, cc);
	275	a = ast_new_call3("Store", stab, a, l, r);
	276	return(a);
	277	} else if (tokne(sc, "[") && tokne(sc, ".")) {
	278	/*
	279	* It was the last one; this is a command.
	280	*/
	281	/* ... */
	282	} else {
	283	/*
	284	* Still more to go.
	285	*/
	286	a = ast_new_call2("Fetch", stab, a, l);
	287	}
	288	} else if (tokeq(sc, ".")) {
	289	scan(sc);
	290	r = parse_literal(sc, stab);
	291	a = ast_new_call2("Fetch", stab, a, r);
	292	}
	293	}
	294
	295	/*
	296	* If the variable-expression was followed by an equals sign,
	297	* it's an assignment to an already-existing variable.
	298	*/
261	299	if (tokeq(sc, "=")) {
262		/*
263		* Actually... it's an assignment to an already-existing variable.
264		*/
265	300	if (sym->value != NULL) {
266	301	scan_error(sc, "Value not modifiable");
267	302	} else {
268	303	scan(sc);
269		r = parse_expr(sc, stab, 0, cc);
	304	r = parse_expr(sc, stab, 0, NULL, cc);
270	305	a = ast_new_assignment(a, r);
271	306	}
272	307	return(a);
273	308	}
274	309
	310	/*
	311	* Otherwise, it's a command.
	312	*/
	313	if (tokne(sc, "}") && tokne(sc, ";") && sc->type != TOKEN_EOF) {
	314	l = parse_expr(sc, stab, 0, NULL, cc);
	315	l = ast_new_arg(l, NULL);
	316	z = l;
	317	while (tokeq(sc, ",")) {
	318	scan_expect(sc, ",");
	319	r = parse_expr(sc, stab, 0, NULL, cc);
	320	r = ast_new_arg(r, NULL);
	321	z->u.arg.right = r;
	322	z = r;
	323	}
	324	} else {
	325	l = NULL;
	326	}
275	327	if (sym->builtin != NULL) {
276		l = NULL; r = NULL;
277		if (tokne(sc, "}") && tokne(sc, ";") && sc->type != TOKEN_EOF) {
278		l = parse_expr(sc, stab, 0, cc);
279		if (tokeq(sc, ",")) {
280		scan_expect(sc, ",");
281		r = parse_expr(sc, stab, 0, cc);
282		}
283		}
284		a = ast_new_builtin(l, r, sym->builtin);
285		} else {
286		if (tokne(sc, "}") && tokne(sc, ";") && sc->type != TOKEN_EOF) {
287		l = parse_expr(sc, stab, 0, cc);
288		l = ast_new_arg(l, NULL);
289		z = l;
290		while (tokeq(sc, ",")) {
291		scan_expect(sc, ",");
292		r = parse_expr(sc, stab, 0, cc);
293		r = ast_new_arg(r, NULL);
294		z->u.arg.right = r;
295		z = r;
296		}
297		} else {
298		l = NULL;
299		}
	328	a = ast_new_builtin(sym->builtin, l);
	329	} else {
300	330	a = ast_new_apply(a, l, 0);
301	331	}
302	332

316	346
317	347	struct ast *
318	348	parse_expr(struct scan_st sc, struct symbol_table stab, int level,
319		int *cc)
	349	struct symbol excl, int cc)
320	350	{
321	351	struct ast l, r;
322	352	int done = 0, i = 0;
323	353	char the_op[256];
324	354
325	355	if (level > maxlevel) {
326		l = parse_primitive(sc, stab, cc);
	356	l = parse_primitive(sc, stab, excl, cc);
327	357	return(l);
328	358	} else {
329		l = parse_expr(sc, stab, level + 1, cc);
	359	l = parse_expr(sc, stab, level + 1, excl, cc);
330	360	while (!done) {
331	361	done = 1;
332	362	for (i = 0; i < 6 && op[level][i][0] != '\0'; i++) {

334	364	strlcpy(the_op, sc->token, 256);
335	365	scan(sc);
336	366	done = 0;
337		r = parse_expr(sc, stab, level + 1, cc);
338		l = ast_new_nfcall(the_op, stab, l, r);
	367	r = parse_expr(sc, stab, level + 1, excl, cc);
	368	l = ast_new_call2(the_op, stab, l, r);
339	369	break;
340	370	}
341	371	}

345	375	}
346	376
347	377	struct ast *
348		parse_primitive(struct scan_st sc, struct symbol_table stab, int *cc)
	378	parse_primitive(struct scan_st sc, struct symbol_table stab,
	379	struct symbol excl, int cc)
349	380	{
350	381	struct ast a, l, r, z;
351	382	struct value *v;

354	385
355	386	if (tokeq(sc, "(")) {
356	387	scan(sc);
357		a = parse_expr(sc, stab, 0, cc);
	388	a = parse_expr(sc, stab, 0, excl, cc);
358	389	scan_expect(sc, ")");
359	390	} else if (tokeq(sc, "^")) {
360	391	int my_cc = 0;
	392	int my_arity = 0;
361	393
362	394	/*
363	395	* Enclosing block contains a closure:

369	401	a = parse_var(sc, istab, &sym,
370	402	VAR_LOCAL, VAR_MUST_NOT_EXIST, NULL);
371	403	ast_free(a);
	404	my_arity++;
372	405	if (tokeq(sc, ","))
373	406	scan(sc);
374	407	}
375	408	a = parse_block(sc, stab, &istab, &my_cc);
376		v = value_new_closure(a, NULL, symbol_table_size(istab), my_cc);
	409	a = ast_new_routine(my_arity, symbol_table_size(istab) - my_arity, my_cc, a);
	410	v = value_new_closure(a, NULL);
377	411	a = ast_new_value(v);
378	412	value_release(v);
379	413	} else if (tokeq(sc, "!")) {
380	414	scan(sc);
381		a = parse_primitive(sc, stab, cc);
	415	a = parse_primitive(sc, stab, excl, cc);
382	416	sym = symbol_lookup(stab, "!", 1);
383	417	a = ast_new_apply(ast_new_local(
384	418	sym->index,

390	424	a = ast_new_value(v);
391	425	value_release(v);
392	426	if (tokne(sc, "]")) {
393		r = parse_expr(sc, stab, 0, cc);
394		a = ast_new_nfcall("Cons", stab, a, r);
	427	ast_free(a);
	428	l = parse_expr(sc, stab, 0, excl, cc);
	429	r = ast_new_arg(l, NULL);
	430	z = r;
395	431	while (tokeq(sc, ",")) {
396	432	scan(sc);
397		r = parse_expr(sc, stab, 0, cc);
398		a = ast_new_nfcall("Cons", stab, a, r);
	433	l = parse_expr(sc, stab, 0, excl, cc);
	434	l = ast_new_arg(l, NULL);
	435	z->u.arg.right = l;
	436	z = l;
399	437	}
	438	sym = symbol_lookup(stab, "List", VAR_GLOBAL);
	439	assert(sym->builtin != NULL);
	440	a = ast_new_builtin(sym->builtin, r);
400	441	}
401	442	scan_expect(sc, "]");
402	443	} else if (sc->type == TOKEN_BAREWORD && isupper(sc->token[0])) {
403	444	a = parse_var(sc, stab, &sym, VAR_GLOBAL, VAR_MUST_EXIST, NULL);
	445	if (sym == excl) {
	446	scan_error(sc, "Initializer cannot refer to variable being defined");
	447	return(NULL);
	448	}
404	449	while (tokeq(sc, "(") \|\| tokeq(sc, "[") \|\| tokeq(sc, ".")) {
405	450	if (tokeq(sc, "(")) {
406	451	scan(sc);
407	452	if (tokne(sc, ")")) {
408		l = parse_expr(sc, stab, 0, cc);
	453	l = parse_expr(sc, stab, 0, excl, cc);
409	454	l = ast_new_arg(l, NULL);
410	455	z = l;
411	456	while (tokeq(sc, ",")) {
412	457	scan(sc);
413		r = parse_expr(sc, stab, 0, cc);
	458	r = parse_expr(sc, stab, 0, excl, cc);
414	459	r = ast_new_arg(r, NULL);
415	460	z->u.arg.right = r;
416	461	z = r;

419	464	l = NULL;
420	465	}
421	466	scan_expect(sc, ")");
422		a = ast_new_apply(a, l, sym->is_pure);
	467	if (sym->builtin != NULL) {
	468	a = ast_new_builtin(sym->builtin, l);
	469	} else {
	470	a = ast_new_apply(a, l, sym->is_pure);
	471	}
423	472	} else if (tokeq(sc, "[")) {
424	473	scan(sc);
425		r = parse_expr(sc, stab, 0, cc);
	474	r = parse_expr(sc, stab, 0, excl, cc);
426	475	scan_expect(sc, "]");
427		a = ast_new_nfcall("Index", stab, a, r);
	476	a = ast_new_call2("Fetch", stab, a, r);
428	477	} else if (tokeq(sc, ".")) {
429	478	scan(sc);
430	479	r = parse_literal(sc, stab);
431		a = ast_new_nfcall("Index", stab, a, r);
	480	a = ast_new_call2("Fetch", stab, a, r);
432	481	}
433	482	}
434	483	} else {

+5

-5

src/parse.h less more

16	16	struct ast parse_block(struct scan_st , struct symbol_table *,
17	17	struct symbol_table *, int );
18	18	struct ast parse_statement(struct scan_st , struct symbol_table *,
	19	int , int );
	20	struct ast parse_definition(struct scan_st , struct symbol_table *, int,
19	21	int *);
20		struct ast parse_assignment(struct scan_st , struct symbol_table *, int,
21		int *);
22		struct ast parse_command(struct scan_st , struct symbol_table *,
	22	struct ast parse_command_or_assignment(struct scan_st , struct symbol_table *,
23	23	int *);
24	24	struct ast parse_expr(struct scan_st , struct symbol_table *, int,
25		int *);
	25	struct symbol , int );
26	26	struct ast parse_primitive(struct scan_st , struct symbol_table *,
27		int *);
	27	struct symbol , int );
28	28	/struct ast parse_list_elem(struct scan_st , struct symbol_table );*/
29	29	struct ast parse_literal(struct scan_st , struct symbol_table *);
30	30	struct ast parse_var(struct scan_st , struct symbol_table *,

+93

-0

src/pool.c less more

	0	#include <assert.h>
	1	#include <stdlib.h>
	2	#include <stdio.h>
	3
	4	#include "pool.h"
	5
	6	static struct value_pool *current_vp = NULL;
	7	static struct pooled_value *pv_free = NULL;
	8
	9	extern int trace_pool;
	10
	11	void
	12	value_pool_new(void)
	13	{
	14	struct value_pool *vp;
	15	int i;
	16
	17	#ifdef DEBUG
	18	if (trace_pool > 0) {
	19	printf("MAKING NEW POOL\n");
	20	printf("value size = %4d\n", sizeof(struct value));
	21	printf("pooled-value size = %4d\n", sizeof(struct pooled_value));
	22	printf("page size = %4d\n", PAGE_SIZE);
	23	printf("header size = %4d\n", HEADER_SIZE);
	24	printf("value pool size = %4d\n", sizeof(struct value_pool));
	25	printf("values per pool = %4d\n", VALUES_PER_POOL);
	26	}
	27	#endif
	28	assert(sizeof(struct value_pool) <= PAGE_SIZE);
	29	vp = malloc(PAGE_SIZE);
	30
	31	/*
	32	* Link us up to the parent pool, if any.
	33	*/
	34	vp->prev = current_vp;
	35
	36	/*
	37	* Create an initial freelist within the pool,
	38	* and link it into our global freelist pv_free.
	39	*/
	40	vp->pool[0].pv.free = pv_free;
	41	for (i = 1; i < VALUES_PER_POOL; i++)
	42	vp->pool[i].pv.free = &vp->pool[i-1];
	43	pv_free = &vp->pool[VALUES_PER_POOL - 1];
	44
	45	current_vp = vp;
	46	}
	47
	48	struct value *
	49	value_allocate(void)
	50	{
	51	struct value *r;
	52
	53	/*
	54	* Check to see if this is the last remaining slot in the pool.
	55	*/
	56	if (pv_free->pv.free == NULL) {
	57	/*
	58	* If so, create a new pool.
	59	*/
	60	value_pool_new();
	61	}
	62	/*
	63	* Find the next pooled value on the freelist,
	64	* remove it from the freelist, and return it.
	65	*/
	66	r = &(pv_free->pv.v);
	67	pv_free = pv_free->pv.free;
	68
	69	#ifdef DEBUG
	70	if (trace_pool > 1) {
	71	printf("pool: allocate: next free now %08lx\n",
	72	(unsigned long)pv_free);
	73	}
	74	#endif
	75	return(r);
	76	}
	77
	78	void
	79	value_deallocate(struct value *v)
	80	{
	81	/*
	82	* Tack this value back onto the freelist.
	83	*/
	84	((struct pooled_value *)v)->pv.free = pv_free;
	85	pv_free = (struct pooled_value *)v;
	86	#ifdef DEBUG
	87	if (trace_pool > 1) {
	88	printf("pool: deallocate: next free now %08lx\n",
	89	(unsigned long)pv_free);
	90	}
	91	#endif
	92	}

+22

-0

src/pool.h less more

	0	#include "value.h"
	1
	2	struct pooled_value {
	3	union {
	4	struct value v;
	5	struct pooled_value *free;
	6	} pv;
	7	};
	8
	9	#define PAGE_SIZE 16384
	10	#define HEADER_SIZE sizeof(struct value_pool *)
	11	#define VALUES_PER_POOL (PAGE_SIZE - HEADER_SIZE) / sizeof(struct pooled_value) - 1
	12
	13	struct value_pool {
	14	struct value_pool * prev;
	15	struct pooled_value pool[VALUES_PER_POOL];
	16	};
	17
	18	void value_pool_new(void);
	19
	20	struct value *value_allocate(void);
	21	void value_deallocate(struct value *);

+38

-37

src/value.c less more

126	126	#else
127	127	v = bhuna_malloc(sizeof(struct value));
128	128	#endif
129		bzero(v, sizeof(struct value));
	129	/* bzero(v, sizeof(struct value)); */
130	130	v->type = type;
131	131	v->refcount = 1;
132	132

143	143	/* UNCONDITIONAL DUPLICATOR */
144	144
145	145	/*
146		* Returns a copy of the given value.
147		* The copy is not so 'deep' as it could be, but should be OK w/refcounting.
	146	* Returns a deep(-ish) copy of the given value.
148	147	* New strings (char arrays) are created when copying a string;
149	148	* New list spines (struct list *) are created, but values are only grabbed, not dup'ed.
150	149	* Some things are not copied, only the pointers to them.
151	150	*
152	151	* Note that the dup'ed value is 'new', i.e. it has a refcount of 1.
153	152	*/
154		static struct value *
	153	struct value *
155	154	value_dup(struct value *v)
156	155	{
157	156	struct value n; / z; /

170	169	for (l = v->v.l; l != NULL; l = l->next) {
171	170	value_list_append(&n, l->value);
172	171	}
	172	/*
	173	n = value_new(VALUE_LIST);
	174	n->v.l = list_dup(v->v.l);
	175	*/
173	176	return(n);
174	177	case VALUE_ERROR:
175	178	return(value_new_error(v->v.e));

177	180	return(value_new_builtin(v->v.bi));
178	181	case VALUE_CLOSURE:
179	182	/* XXX depth?? */
180		return(value_new_closure(v->v.k->ast, v->v.k->ar,
181		v->v.k->arity, v->v.k->cc));
	183	return(value_new_closure(v->v.k->ast, v->v.k->ar));
182	184	case VALUE_DICT:
183		n = value_new_dict();
184		/* XXX for each key in v->v.d, insert into n */
	185	n = value_new(VALUE_DICT);
	186	n->v.d = dict_dup(v->v.d);
185	187	return(n);
186	188	default:
187	189	return(value_new_error("unknown type"));

289	291	{
290	292	if (v == NULL)
291	293	return;
	294	#ifdef DEBUG
	295	if (trace_refcounting > 1) {
	296	printf("[RC] grabbing ");
	297	value_print(v);
	298	printf(", refcount now %d\n", v->refcount + 1);
	299	}
	300	num_vars_grabbed++;
	301	#endif
292	302	assert(v->refcount > 0);
293	303	v->refcount++;
	304	}
	305
	306	void
	307	value_release(struct value *v)
	308	{
	309	if (v == NULL)
	310	return;
294	311	#ifdef DEBUG
295	312	if (trace_refcounting > 1) {
296		printf("[RC] grabbed ");
297		value_print(v);
298		printf(", refcount now %d\n", v->refcount);
299		}
300		num_vars_grabbed++;
301		#endif
302		}
303
304		void
305		value_release(struct value *v)
306		{
307		if (v == NULL)
308		return;
	313	printf("[RC] releasing ");
	314	value_print(v);
	315	printf(", refcount now %d\n", v->refcount - 1);
	316	}
	317	num_vars_released++;
	318	#endif
309	319	assert(v->refcount > 0);
310	320	v->refcount--;
311		#ifdef DEBUG
312		if (trace_refcounting > 1) {
313		printf("[RC] released ");
314		value_print(v);
315		printf(", refcount now %d\n", v->refcount);
316		}
317		num_vars_released++;
318		#endif
319	321	if (v->refcount == 0)
320	322	value_free(v);
321	323	}

456	458	}
457	459
458	460	struct value *
459		value_new_closure(struct ast a, struct activation ar, int arity, int cc)
	461	value_new_closure(struct ast a, struct activation ar)
460	462	{
461	463	struct value *v;
462	464
463	465	v = value_new(VALUE_CLOSURE);
464		v->v.k = closure_new(a, ar, arity, cc);
	466	v->v.k = closure_new(a, ar);
465	467
466	468	#ifdef DEBUG
467	469	if (trace_valloc > 1) {

603	605	}
604	606
605	607	void
606		value_set_closure(struct value *v, struct ast a, struct activation *ar,
607		int arity, int cc)
608		{
609		if (*v == NULL) {
610		*v = value_new_closure(a, ar, arity, cc);
	608	value_set_closure(struct value *v, struct ast a, struct activation *ar)
	609	{
	610	if (*v == NULL) {
	611	*v = value_new_closure(a, ar);
611	612	return;
612	613	}
613	614

615	616	value_empty(*v);
616	617
617	618	(*v)->type = VALUE_CLOSURE;
618		(*v)->v.k = closure_new(a, ar, arity, cc);
	619	(*v)->v.k = closure_new(a, ar);
619	620	}
620	621
621	622	void

+4

-2

src/value.h less more

53	53	void value_grab(struct value *);
54	54	void value_release(struct value *);
55	55
	56	struct value value_dup(struct value );
	57
56	58	struct value *value_new_integer(int);
57	59	struct value *value_new_boolean(int);
58	60	struct value *value_new_atom(int);

60	62	struct value *value_new_list(void);
61	63	struct value value_new_error(char );
62	64	struct value value_new_builtin(struct builtin );
63		struct value value_new_closure(struct ast , struct activation *, int, int);
	65	struct value value_new_closure(struct ast , struct activation *);
64	66	struct value *value_new_dict(void);
65	67
66	68	void value_set_from_value(struct value *, struct value );

72	74	void value_set_list(struct value **);
73	75	void value_set_error(struct value *, char );
74	76	void value_set_builtin(struct value *, struct builtin );
75		void value_set_closure(struct value *, struct ast , struct activation *, int, int);
	77	void value_set_closure(struct value *, struct ast , struct activation *);
76	78	void value_set_dict(struct value **);
77	79
78	80	void value_list_append(struct value *, struct value );

+0

-25

~~src/vm/ulti_vm.h~~ less more

0		#include <sys/types.h>
1
2		struct value;
3
4		struct vm {
5		void (pc)(struct vm );
6		struct value **stack;
7		void (*prog)(struct vm );
8		int ctr;
9		}
10
11
12		struct vm *vm_new(size_t, size_t);
13		void vm_free(struct vm *);
14		void vm_run(struct vm *);
15
16		void vm_gen(struct vm , void ()(struct vm *));
17
18		void op_local(struct vm *);
19		void op_value(struct vm *);
20		void op_apply(struct vm *);
21		void op_assign(struct vm *);
22		void op_jz(struct vm *);
23		void op_jmp(struct vm *);
24		void op_halt(struct vm *);

+0

-87

~~src/vm/util_vm.c~~ less more

0		#include "mem.h"
1		#include "vm.h"
2
3		struct vm {
4		size_t pc;
5		value **stack;
6		void (*f)(struct vm );
7		}
8
9
10		struct vm *
11		vm_new(size_t prog_size, size_t stack_size)
12		{
13		struct vm *vm;
14
15		vm = bhuna_malloc(sizeof(struct vm));
16		vm->prog = bhuna_malloc(void ()(struct vm ) * stack_size);
17		vm->stack = bhuna_malloc(sizeof(struct value ) stack_size);
18		vm->pc = vm->prog[0];
19		vm->ctr = 0;
20
21		return(vm);
22		}
23
24		void
25		vm_free(struct vm *vm)
26		{
27		bhuna_free(vm->prog);
28		bhuna_free(vm->stack);
29		bhuna_free(vm);
30		}
31
32		void
33		vm_run(struct vm *vm)
34		{
35		while (vm->pc != op_halt) {
36		vm->pc++;
37		}
38		}
39
40		void
41		vm_gen(struct vm vm, void (ins)(struct vm *))
42		{
43		vm->prog[vm->cnt++] = ins;
44		}
45
46		void op_local(struct vm *);
47		void op_value(struct vm *);
48
49		void
50		op_apply(struct vm *vm)
51		{
52		struct closure *k;
53		struct activation *ar;
54		struct value *v;
55
56		vm_pop(k);
57		vm_pop(ar);
58		v = f(ar);
59		vm_push(v);
60		}
61
62		void
63		op_assign(struct vm *vm)
64		{
65		vm_pop(v);
66		vm_pop(local);
67		local_poke(local, v);
68		}
69
70		void
71		op_jz(struct vm *vm)
72		{
73		}
74
75		void
76		op_jmp(struct vm *vm)
77		{
78		vm_pop(k);
79		vm->pc = vm->prog[k];
80		}
81
82		void
83		op_halt(struct vm *vm)
84		{
85		/* n/a */
86		}

+0

-119

~~src/vm/vm.c~~ less more

0		#include "mem.h"
1		#include "vm.h"
2
3		struct vm *
4		vm_new(size_t prog_size, size_t stack_size)
5		{
6		struct vm *vm;
7
8		vm = bhuna_malloc(sizeof(struct vm));
9		vm->pc = 0;
10		vm->sp = 0;
11		vm->prog = bhuna_malloc(sizeof(struct op) * stack_size);
12		vm->stack = bhuna_malloc(sizeof(struct value ) stack_size);
13
14		return(vm);
15		}