interpret.c 19 KB
Newer Older
1
#include <math.h>
Camil Staps's avatar
Camil Staps committed
2 3
#include <stdio.h>
#include <stdlib.h>
4
#include <string.h>
Camil Staps's avatar
Camil Staps committed
5

6 7 8 9
#ifdef WINDOWS
# define _NO_BOOL_TYPEDEF /* for mingw */
# define BOOL WINBOOL
# define CHAR WINCHAR
Camil Staps's avatar
Camil Staps committed
10
# define INT WININT
11 12
# include <windows.h>
# include <excpt.h>
Camil Staps's avatar
Camil Staps committed
13
# undef INT
14 15 16 17
# undef BOOL
# undef CHAR
#endif

Camil Staps's avatar
Camil Staps committed
18
#include "abc_instructions.h"
19
#include "bytecode.h"
20
#include "gc.h"
Camil Staps's avatar
Camil Staps committed
21 22
#include "interpret.h"
#include "parse.h"
Camil Staps's avatar
Camil Staps committed
23
#include "settings.h"
Camil Staps's avatar
Camil Staps committed
24
#include "util.h"
Camil Staps's avatar
Camil Staps committed
25

26 27 28 29
#ifdef DEBUG_CURSES
# include "debug_curses.h"
#endif

30
/* Used to store the return address when evaluating a node on the heap */
31
#define EVAL_TO_HNF_LABEL CMAX
32

33 34 35
#define _2chars2int(a,b)             ((void*) (a+(b<<8)))
#define _3chars2int(a,b,c)           ((void*) (a+(b<<8)+(c<<16)))
#define _4chars2int(a,b,c,d)         ((void*) (a+(b<<8)+(c<<16)+(d<<24)))
Camil Staps's avatar
Camil Staps committed
36

37 38 39 40
#ifdef DEBUG_CURSES
void** ARRAY;
#endif

41 42 43 44 45 46 47 48
#if (WORD_WIDTH == 64)
# define _5chars2int(a,b,c,d,e)       ((void*) (a+(b<<8)+(c<<16)+(d<<24)+((BC_WORD)e<<32)))
# define _6chars2int(a,b,c,d,e,f)     ((void*) (a+(b<<8)+(c<<16)+(d<<24)+((BC_WORD)e<<32)+((BC_WORD)f<<40)))
# define _7chars2int(a,b,c,d,e,f,g)   ((void*) (a+(b<<8)+(c<<16)+(d<<24)+((BC_WORD)e<<32)+((BC_WORD)f<<40)+((BC_WORD)g<<48)))
# define _8chars2int(a,b,c,d,e,f,g,h) ((void*) (a+(b<<8)+(c<<16)+(d<<24)+((BC_WORD)e<<32)+((BC_WORD)f<<40)+((BC_WORD)g<<48)+((BC_WORD)h<<56)))

static BC_WORD m____system[] = {7, (BC_WORD) _7chars2int('_','s','y','s','t','e','m')};

49
void* d___Nil[]           = {2+&d___Nil[1], 0, 0, &m____system, (void*) 4, _4chars2int('_','N','i','l')};
50
void* d_FILE[]            = {&m____system, (void*) 258, (void*) 2, _2chars2int('i','i'), (void*) 4, _4chars2int('F','I','L','E')};
51 52

# ifndef LINK_CLEAN_RUNTIME
53
void* __ARRAY__[]         = {0, 0, &m____system, (void*) 7, _7chars2int('_','A','R','R','A','Y','_')};
54
void* __STRING__[]        = {0, 0, &m____system, (void*) 8, _8chars2int('_','S','T','R','I','N','G','_')};
55 56
void* BOOL[]              = {0, 0, &m____system, (void*) 4, _4chars2int('B','O','O','L')};
void* CHAR[]              = {0, 0, &m____system, (void*) 4, _4chars2int('C','H','A','R')};
57
void* REAL[]              = {0, 0, &m____system, (void*) 4, _4chars2int('R','E','A','L')};
58
void* INT[]               = {0, 0, &m____system, (void*) 3, _3chars2int('I','N','T')};
59
# endif
60
void* DREAL[]             = {0, 0, &m____system, (void*) 5, _5chars2int('D','R','E','A','L')};
61
#else /* assuming WORD_WIDTH == 32 */
62
static BC_WORD m____system[] = {7, (BC_WORD) _4chars2int ('_','s','y','s'), (BC_WORD) _3chars2int ('t','e','m') };
63

64 65
void* d___Nil[]           = {2+&d___Nil[1], 0, 0, &m____system, (void*) 4, _4chars2int ('_','N','i','l') };
void* d_FILE[]            = {&m____system, (void*) 258, (void*) 2, _2chars2int ('i','i'), (void*) 4, _4chars2int ('F','I','L','E') };
66 67

# ifndef LINK_CLEAN_RUNTIME
68 69 70 71 72 73
void* __ARRAY__[]         = {0, 0, &m____system, (void*) 7, _4chars2int ('_','A','R','R'), _3chars2int ('A','Y','_') };
void* __STRING__[]        = {0, 0, &m____system, (void*) 8, _4chars2int ('_','S','T','R'), _4chars2int ('I','N','G','_') };
void* BOOL[]              = {0, 0, &m____system, (void*) 4, _4chars2int ('B','O','O','L') };
void* CHAR[]              = {0, 0, &m____system, (void*) 4, _4chars2int ('C','H','A','R') };
void* REAL[]              = {0, 0, &m____system, (void*) 4, _4chars2int('R','E','A','L')};
void* INT[]               = {0, 0, &m____system, (void*) 3, _3chars2int ('I','N','T') };
74
# endif
75
void* DREAL[]             = {0, 0, &m____system, (void*) 5, _4chars2int('D','R','E','A'), (void*) 'L'};
76
#endif /* Word-width dependency */
Camil Staps's avatar
Camil Staps committed
77

78
#ifndef LINK_CLEAN_RUNTIME
79 80
BC_WORD small_integers[66];
BC_WORD static_characters[512];
Camil Staps's avatar
Camil Staps committed
81 82
#endif
BC_WORD static_booleans[4];
83

84
static void prepare_static_nodes(void) {
Camil Staps's avatar
Camil Staps committed
85 86 87 88
	static_booleans[2]=static_booleans[0]=(BC_WORD)&BOOL+2;
	static_booleans[1]=0;
	static_booleans[3]=1;
#ifndef LINK_CLEAN_RUNTIME
89 90 91 92 93 94 95 96
	for (int i=0; i<33; i++) {
		small_integers[2*i]=(BC_WORD)&INT+2;
		small_integers[2*i+1]=i;
	}
	for (int i=0; i<256; i++) {
		static_characters[2*i]=(BC_WORD)&CHAR+2;
		static_characters[2*i+1]=i;
	}
97
#endif
Camil Staps's avatar
Camil Staps committed
98
}
Camil Staps's avatar
Camil Staps committed
99

100
#ifdef LINK_CLEAN_RUNTIME
101 102
# include "copy_interpreter_to_host.h"
# include "copy_host_to_interpreter.h"
Camil Staps's avatar
Camil Staps committed
103
void **HOST_NODES[32] = {NULL};
104
BC_WORD HOST_NODE_DESCRIPTORS[1216];
105
static BC_WORD ADD_ARG[33];
106
BC_WORD HOST_NODE_INSTRUCTIONS[32*6];
107

108
static void build_host_nodes(void) {
Camil Staps's avatar
Camil Staps committed
109 110
	if (HOST_NODES[0] != NULL)
		return;
111 112 113 114 115 116
	int i = 0;
	ADD_ARG[0] = Cadd_arg0;
	for (int arity = 1; arity <= 32; arity++) {
		ADD_ARG[arity] = Cadd_arg0 + arity;
		HOST_NODES[arity-1] = (void**) &HOST_NODE_DESCRIPTORS[i+1];
#ifdef COMPUTED_GOTOS
117
# define INSTR(i) (BC_WORD) instruction_labels[i]
118
		interpret(NULL,
Camil Staps's avatar
Cleanup  
Camil Staps committed
119
# ifdef POSIX
120 121 122
				0,
# endif
				NULL, 0, NULL, 0, NULL, NULL, NULL, NULL, NULL);
123
#else
124
# define INSTR(i) i
125
#endif
126
		if (arity == 1) {
127
			HOST_NODE_INSTRUCTIONS[6*arity-6] = (BC_WORD)1 << IF_INT_64_OR_32(32,0);
128
			HOST_NODE_INSTRUCTIONS[6*arity-5] = INSTR(Cjsr_eval_host_node);
129
		} else if (arity <= 5) {
130
			HOST_NODE_INSTRUCTIONS[6*arity-6] = INSTR(Cjsr_eval_host_node+arity-1); /* ap entry */
131 132 133 134 135 136 137
			HOST_NODE_INSTRUCTIONS[6*arity-3] = INSTR(
				arity == 2 ? Crepl_args1 :
				arity == 3 ? Crepl_args2 :
				arity == 4 ? Crepl_args3 :
				             Crepl_args4);
			HOST_NODE_INSTRUCTIONS[6*arity-2] = INSTR(Cjsr_eval_host_node+arity-1);
		} else {
138
			HOST_NODE_INSTRUCTIONS[6*arity-6] = INSTR(Cjsr_eval_host_node+arity-1); /* ap entry */
139 140 141 142
			HOST_NODE_INSTRUCTIONS[6*arity-3] = INSTR(Crepl_args);
			HOST_NODE_INSTRUCTIONS[6*arity-2] = arity-1;
			HOST_NODE_INSTRUCTIONS[6*arity-1] = INSTR(Cjsr_eval_host_node+arity-1);
		}
143 144 145 146 147 148 149 150

		HOST_NODE_DESCRIPTORS[i] = (BC_WORD)&HOST_NODE_DESCRIPTORS[i+1]+2;
		i++;
		for (int n = 0; n <= arity; n++) {
			HOST_NODE_DESCRIPTORS[i++] = (((arity-n) << 3) << 16) + n;
			if (n < arity - 1)
				HOST_NODE_DESCRIPTORS[i++] = (BC_WORD) &ADD_ARG[n];
			else if (n == arity - 1)
151
				HOST_NODE_DESCRIPTORS[i++] = (BC_WORD) &HOST_NODE_INSTRUCTIONS[6*arity-3];
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
		}
		HOST_NODE_DESCRIPTORS[i++] = (arity << 16) + 0;
		HOST_NODE_DESCRIPTORS[i++] = 0;
		HOST_NODE_DESCRIPTORS[i++] = 0;
	}
}

extern void *ap_2;
extern void *ap_3;
extern void *ap_4;
extern void *ap_5;
extern void *ap_6;
extern void *ap_7;
extern void *ap_8;
extern void *ap_9;
extern void *ap_10;
extern void *ap_11;
extern void *ap_12;
extern void *ap_13;
extern void *ap_14;
extern void *ap_15;
extern void *ap_16;
extern void *ap_17;
extern void *ap_18;
extern void *ap_19;
extern void *ap_20;
extern void *ap_21;
extern void *ap_22;
extern void *ap_23;
extern void *ap_24;
extern void *ap_25;
extern void *ap_26;
extern void *ap_27;
extern void *ap_28;
extern void *ap_29;
extern void *ap_30;
extern void *ap_31;
extern void *ap_32;

void *ap_addresses[] = {&ap_2, &ap_3, &ap_4, &ap_5, &ap_6, &ap_7, &ap_8, &ap_9,
	&ap_10, &ap_11, &ap_12, &ap_13, &ap_14, &ap_15, &ap_16, &ap_17, &ap_18,
	&ap_19, &ap_20, &ap_21, &ap_22, &ap_23, &ap_24, &ap_25, &ap_26, &ap_27,
	&ap_28, &ap_29, &ap_30, &ap_31, &ap_32};
195 196

void **interpret_error=NULL;
197 198
#endif

199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
BC_WORD Fjmp_ap[32] =
	{ Cjmp_ap1
	, Cjmp_ap2
	, Cjmp_ap3
	, Cjmp_ap4
	, Cjmp_ap5
	, Cjmp_ap6
	, Cjmp_ap7
	, Cjmp_ap8
	, Cjmp_ap9
	, Cjmp_ap10
	, Cjmp_ap11
	, Cjmp_ap12
	, Cjmp_ap13
	, Cjmp_ap14
	, Cjmp_ap15
	, Cjmp_ap16
	, Cjmp_ap17
	, Cjmp_ap18
	, Cjmp_ap19
	, Cjmp_ap20
	, Cjmp_ap21
	, Cjmp_ap22
	, Cjmp_ap23
	, Cjmp_ap24
	, Cjmp_ap25
	, Cjmp_ap26
	, Cjmp_ap27
	, Cjmp_ap28
	, Cjmp_ap29
	, Cjmp_ap30
	, Cjmp_ap31
	, Cjmp_ap32
232
	};
Camil Staps's avatar
Camil Staps committed
233

234 235
#include "files.h"

236 237 238 239
void* __interpreter_cycle_in_spine[2] = {
	(void*) 0,
	(void*) Chalt
};
240
void* __interpreter_indirection[9] = {
Camil Staps's avatar
Camil Staps committed
241 242 243 244 245 246
	(void*) Cjsr_eval0,
	(void*) Cfill_a01_pop_rtn,
	(void*) Chalt,
	(void*) Chalt,
	(void*) -2,
	(void*) Cpush_node1,
247
	(void*) &__interpreter_cycle_in_spine[1],
Camil Staps's avatar
Camil Staps committed
248 249 250 251
	(void*) Cjsr_eval0,
	(void*) Cfill_a01_pop_rtn
};

252
#include <setjmp.h>
Camil Staps's avatar
Camil Staps committed
253
#ifdef POSIX
Camil Staps's avatar
Camil Staps committed
254
# include <signal.h>
255 256 257
#endif

#ifdef LINK_CLEAN_RUNTIME
258 259 260 261 262
struct segfault_restore_points {
	jmp_buf restore_point;
	BC_WORD *host_a_ptr;
	struct segfault_restore_points *prev;
};
263 264
static struct segfault_restore_points *segfault_restore_points=NULL;
#endif
265

266
#ifdef POSIX
267
# ifdef LINK_CLEAN_RUNTIME
268
static struct sigaction old_segv_handler;
269
# endif
270
static void handle_segv(int sig, siginfo_t *info, void *context) {
271 272 273 274 275 276 277 278 279 280
# ifdef LINK_CLEAN_RUNTIME
	if (segfault_restore_points==NULL) {
		if (old_segv_handler.sa_handler!=SIG_DFL && old_segv_handler.sa_handler!=SIG_IGN) {
			if (old_segv_handler.sa_flags & SA_SIGINFO)
				old_segv_handler.sa_sigaction(sig,info,context);
			else
				old_segv_handler.sa_handler(sig);
		}
		return;
	}
281
# endif
282 283 284 285 286 287 288

	if (sig==SIGFPE) {
# ifdef LINK_CLEAN_RUNTIME
		interpret_error=&e__ABC_PInterpreter__dDV__FloatingPointException;
# endif
		EPRINTF("Floating point exception during interpretation\n");
	} else {
Camil Staps's avatar
Cleanup  
Camil Staps committed
289
# ifdef LINK_CLEAN_RUNTIME
290 291 292 293 294 295
		interpret_error=&e__ABC_PInterpreter__dDV__StackOverflow;
# endif
		EPRINTF("Segmentation fault during interpretation\n");
	}
# ifdef LINK_CLEAN_RUNTIME
	siglongjmp(segfault_restore_points->restore_point, sig);
296 297
# else
	exit(1);
Camil Staps's avatar
Cleanup  
Camil Staps committed
298
# endif
Camil Staps's avatar
Camil Staps committed
299
}
300 301 302
#elif defined(WINDOWS)
static LONG WINAPI handle_segv(struct _EXCEPTION_POINTERS *exception) {
# ifdef LINK_CLEAN_RUNTIME
303
	interpret_error=&e__ABC_PInterpreter__dDV__StackOverflow;
304 305 306 307 308
	if (segfault_restore_points!=NULL)
		longjmp(segfault_restore_points->restore_point, 1);
# endif
	return EXCEPTION_CONTINUE_SEARCH;
}
Camil Staps's avatar
Camil Staps committed
309 310
#endif

311
static void install_signal_handlers(void) {
Camil Staps's avatar
Cleanup  
Camil Staps committed
312
#ifdef POSIX
Camil Staps's avatar
Camil Staps committed
313
	stack_t signal_stack;
314 315 316 317 318 319 320
	signal_stack.ss_sp=safe_malloc(SIGSTKSZ);
	signal_stack.ss_size=SIGSTKSZ;
	signal_stack.ss_flags=0;
	if (sigaltstack(&signal_stack,NULL) == -1)
		perror("sigaltstack");

	struct sigaction segv_handler;
321
	segv_handler.sa_sigaction=handle_segv;
322
	sigemptyset(&segv_handler.sa_mask);
323
	segv_handler.sa_flags=SA_ONSTACK | SA_SIGINFO | SA_RESTART;
324 325 326 327 328 329 330
	if (sigaction(SIGSEGV, &segv_handler,
# ifdef LINK_CLEAN_RUNTIME
				&old_segv_handler
# else
				NULL
# endif
				) == -1)
331
		perror("sigaction");
332 333
	if (sigaction(SIGFPE, &segv_handler, NULL) == -1)
		perror("sigaction");
334 335
#elif defined(WINDOWS)
	SetUnhandledExceptionFilter(&handle_segv);
336 337 338 339 340
#else
	EPRINTF("warning: interpreter does not recover from segfaults on this platform\n");
#endif
}

341
#ifdef COMPUTED_GOTOS
342
void *instruction_labels[CMAX]={NULL};
343 344
#endif

345 346 347 348 349
static int interpreter_initialized=0;
int ensure_interpreter_init(void) {
	if (interpreter_initialized)
		return 1;

350
	install_signal_handlers();
351

352 353 354 355 356 357 358 359
	prepare_static_nodes();
#ifdef LINK_CLEAN_RUNTIME
	build_host_nodes();
#endif
#ifdef COMPUTED_GOTOS
	/* Fetch label addresses */
	if (instruction_labels[0]==NULL) {
# ifdef LINK_CLEAN_RUNTIME
360 361 362 363
		interpret(NULL, 0,
# else
		struct interpretation_options options;
		interpret(NULL, options,
364 365
# endif
				NULL, 0, NULL, 0, NULL, NULL, NULL, NULL, NULL);
366
	}
367

368 369
	for (int i=0; i<32; i++)
		Fjmp_ap[i]=(BC_WORD)instruction_labels[Fjmp_ap[i]];
370

371 372 373 374 375 376 377 378
	__interpreter_cycle_in_spine[1]=(void*)instruction_labels[(BC_WORD)__interpreter_cycle_in_spine[1]];
	__interpreter_indirection[0]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[0]];
	__interpreter_indirection[1]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[1]];
	__interpreter_indirection[2]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[2]];
	__interpreter_indirection[3]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[3]];
	__interpreter_indirection[5]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[5]];
	__interpreter_indirection[7]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[7]];
	__interpreter_indirection[8]=(void*)instruction_labels[(BC_WORD)__interpreter_indirection[8]];
379 380

# ifdef LINK_CLEAN_RUNTIME
381 382
	for (int i = 0; i < 32; i++)
		HOST_NODES[i][1]=instruction_labels[Cjsr_eval_host_node+i];
383 384 385 386 387 388 389 390
# endif
#endif

	interpreter_initialized=1;

	return 1;
}

391 392 393
#ifdef LINK_CLEAN_RUNTIME
static BC_WORD *hp;
#endif
394 395
int interpret(
#ifdef LINK_CLEAN_RUNTIME
396
		struct interpretation_environment *ie,
397
		int create_restore_point,
398 399
#else
		struct program *program,
400
		struct interpretation_options options,
401
#endif
Camil Staps's avatar
Camil Staps committed
402
		BC_WORD *stack, size_t stack_size,
403
		BC_WORD *heap, size_t heap_size,
404
		BC_WORD *asp, BC_WORD *bsp, BC_WORD *csp, BC_WORD *_hp,
405
		BC_WORD *_pc) {
406
#ifdef COMPUTED_GOTOS
407 408 409 410 411 412 413 414 415 416 417 418
	/* When compiled with COMPUTED_GOTOS defined and stack=NULL, this function does
	 * not interpret at all but instead copy an array with label addresses to the
	 * instruction_labels array defined above.  If anybody other than John (who,
	 * we're sure, will immediately understand) ever reads this, here is the
	 * rationale: with computed gotos, we want to store pointers to the label
	 * addresses in interpret_instructions.h instead of the bytecode values of the
	 * instructions themselves. However, compilers won't allow you to get a label
	 * address from outside a function (which is kind of silly). So, we call
	 * interpret(.., NULL, ..) from the parser to get an array with all the
	 * addresses needed.
	 */
	if (stack == NULL) {
419 420
# define _COMPUTED_GOTO_LABELS
# include "abc_instructions.h"
421
		memcpy(instruction_labels, _instruction_labels, sizeof(BC_WORD) * CMAX);
422 423 424 425
		return 0;
	}
#endif

426 427
#ifdef LINK_CLEAN_RUNTIME
	struct program *program = ie->program;
428
	void **caf_list = ie->caf_list;
429
	int instr_arg; /* for jsr_eval_host_node_n */
430 431
#else
	void *caf_list[2] = {0, &caf_list[1]};
432 433
#endif

434
	BC_WORD *pc;
435 436 437 438 439
#ifdef LINK_CLEAN_RUNTIME
	hp=_hp;
#else
	BC_WORD *hp=_hp;
#endif
440
	heap_size /= 2; /* copying garbage collector */
441
#ifdef LINK_CLEAN_RUNTIME
442
	BC_WORD_S heap_free=ie->hp_end-hp;
443 444 445
#else
	BC_WORD_S heap_free = heap + heap_size - hp;
#endif
Camil Staps's avatar
Camil Staps committed
446

447
#ifdef LINK_CLEAN_RUNTIME
448 449 450 451 452
	if (create_restore_point) {
		struct segfault_restore_points *new=safe_malloc(sizeof(struct segfault_restore_points));
		new->prev=segfault_restore_points;
		new->host_a_ptr=ie->host->host_a_ptr;
		segfault_restore_points=new;
453
# ifdef POSIX
454
		if (sigsetjmp(new->restore_point, 1) != 0) {
455 456 457
# else
		if (setjmp(new->restore_point) != 0) {
# endif
458 459 460
			ie->host->host_a_ptr=segfault_restore_points->host_a_ptr;
			goto eval_to_hnf_return_failure;
		}
Camil Staps's avatar
Camil Staps committed
461 462 463
	}
#endif

464
	BC_WORD ret;
465
	if (_pc != NULL) {
466
#ifdef COMPUTED_GOTOS
467
		ret=(BC_WORD)&&eval_to_hnf_return;
468
#else
469
		ret=EVAL_TO_HNF_LABEL;
470
#endif
471
		*++csp=(BC_WORD)&ret;
472
		pc=_pc;
473

Camil Staps's avatar
Camil Staps committed
474
		if (0) {
475
#ifdef LINK_CLEAN_RUNTIME
476 477
			struct segfault_restore_points *old;
#endif
478
eval_to_hnf_return:
Camil Staps's avatar
Cleanup  
Camil Staps committed
479
#ifdef LINK_CLEAN_RUNTIME
Camil Staps's avatar
Camil Staps committed
480 481 482 483
			ie->asp = asp;
			ie->bsp = bsp;
			ie->csp = csp;
			ie->hp = hp;
484 485 486 487 488
			if (create_restore_point) {
				old=segfault_restore_points;
				segfault_restore_points=old->prev;
				free(old);
			}
Camil Staps's avatar
Cleanup  
Camil Staps committed
489
#endif
490
			return 0;
491 492 493 494 495 496
#ifdef LINK_CLEAN_RUNTIME
eval_to_hnf_return_failure:
			ie->asp = asp;
			ie->bsp = bsp;
			ie->csp = csp;
			ie->hp = hp;
497 498 499 500 501
			if (create_restore_point) {
				old=segfault_restore_points;
				segfault_restore_points=old->prev;
				free(old);
			}
502 503 504
			if (stack[stack_size/2-1]!=A_STACK_CANARY) {
				stack[stack_size/2-1]=A_STACK_CANARY;
				interpret_error=&e__ABC_PInterpreter__dDV__StackOverflow;
505 506
			} else if (bsp <= csp)
				interpret_error=&e__ABC_PInterpreter__dDV__StackOverflow;
507 508
			return -1;
#endif
Camil Staps's avatar
Camil Staps committed
509
		}
510 511
	} else if (program->start_symbol_id == -1) {
		EPRINTF("error in interpret: no start symbol and no program counter given\n");
512
		EXIT(NULL,1);
513
		return -1;
514 515
	} else {
		pc = (BC_WORD*)program->symbol_table[program->start_symbol_id].offset;
516 517
	}

518
	BC_WORD fast_ap_descriptor=0;
519
#ifdef COMPUTED_GOTOS
520
	goto **(void**)pc;
521 522
# include "interpret_instructions.h"
#else
Camil Staps's avatar
Camil Staps committed
523
	for (;;) {
524
# if defined(DEBUG_ALL_INSTRUCTIONS) && !defined(DEBUG_CURSES)
525
		if (program->data <= pc && pc < program->data + program->data_size)
Camil Staps's avatar
Camil Staps committed
526
			EPRINTF("D:%d\t%s\n", (int) (pc-program->data), instruction_name(*pc));
527
		else if (program->code <= pc && pc < program->code + program->code_size)
528
			print_instruction(1, program, pc-program->code);
529
		else
Camil Staps's avatar
Camil Staps committed
530
			EPRINTF(":------ %s\n", instruction_name(*pc));
531 532
# endif
# ifdef DEBUG_CURSES
Camil Staps's avatar
Camil Staps committed
533
		debugger_update_views(pc, asp, bsp, csp);
534
		while (debugger_input(asp) != 0);
535
# endif
Camil Staps's avatar
Camil Staps committed
536
		switch (*pc) {
537
# include "interpret_instructions.h"
Camil Staps's avatar
Camil Staps committed
538
		}
539 540 541 542 543 544
#endif

#ifdef COMPUTED_GOTOS
	garbage_collect:
	{
#endif
545
		int old_heap_free = heap_free;
546
		hp = garbage_collect(stack, asp, heap, heap_size, &heap_free, caf_list
547
#ifdef LINK_CLEAN_RUNTIME
548
				, &ie->options, ie, &ie->host->clean_ie->__ie_2->__ie_shared_nodes[3]
549
#else
550
				, &options
551
#endif
Camil Staps's avatar
Camil Staps committed
552
#ifdef DEBUG_GARBAGE_COLLECTOR
553
				, program->code, program->data
Camil Staps's avatar
Camil Staps committed
554 555
#endif
				);
Camil Staps's avatar
Camil Staps committed
556
#ifdef DEBUG_CURSES
557
		debugger_set_heap(options.in_first_semispace ? heap : (heap+heap_size));
Camil Staps's avatar
Camil Staps committed
558
#endif
Camil Staps's avatar
Camil Staps committed
559
		if (heap_free <= old_heap_free) {
Camil Staps's avatar
Camil Staps committed
560
			EPRINTF("Heap full (%d/%d).\n",old_heap_free,(int)heap_free);
561 562 563
			EXIT(ie,1);
#ifdef LINK_CLEAN_RUNTIME
			interpret_error=&e__ABC_PInterpreter__dDV__HeapFull;
564
			goto eval_to_hnf_return_failure;
565 566
#endif
			return 1;
567
#ifdef DEBUG_GARBAGE_COLLECTOR
568
		} else {
Camil Staps's avatar
Camil Staps committed
569
			EPRINTF("Freed %d words; now %d free words.\n", (int) (heap_free-old_heap_free), (int) heap_free);
570
#endif
571
		}
Camil Staps's avatar
Camil Staps committed
572
	}
573
#ifdef COMPUTED_GOTOS
574
	goto **(void**)pc;
575
#endif
Camil Staps's avatar
Camil Staps committed
576 577
}

578 579 580
#ifndef LINK_CLEAN_RUNTIME

# if defined(DEBUG_CURSES) || defined(COMPUTED_GOTOS)
581
const char usage[] = "Usage: %s [-io] [-h SIZE] [-s SIZE] FILE\n";
582
# else
583
const char usage[] = "Usage: %s [-l] [-R] [-io] [-h SIZE] [-s SIZE] FILE\n";
584
# endif
585

Camil Staps's avatar
Camil Staps committed
586
int main(int argc, char **argv) {
587
#if !defined(DEBUG_CURSES) && !defined(COMPUTED_GOTOS)
588
	int list_program = 0;
Camil Staps's avatar
Camil Staps committed
589
	int run = 1;
590
#endif
591
	FILE *input = NULL;
592
	size_t stack_size = (512 << 10) * 2;
593 594
	size_t heap_size = 2 << 20;

595 596 597 598
	struct interpretation_options options;
	options.in_first_semispace=1;
	options.allow_file_io=0;

599 600
	BC_WORD *stack;
	BC_WORD *heap;
601

Camil Staps's avatar
Camil Staps committed
602
	struct parser state;
603 604
	init_parser(&state);

Camil Staps's avatar
Camil Staps committed
605
	for (int i=1; i<argc; i++) {
606
#if !defined(DEBUG_CURSES) && !defined(COMPUTED_GOTOS)
Camil Staps's avatar
Camil Staps committed
607 608 609 610 611
		if (!strcmp(argv[i],"-l"))
			list_program=1;
		else if (!strcmp(argv[i],"-R"))
			run=0;
		else
612
#endif
Camil Staps's avatar
Camil Staps committed
613 614 615
		if (!strcmp(argv[i],"-s")) {
			stack_size=string_to_size(argv[++i]);
			if (stack_size==-1) {
Camil Staps's avatar
Camil Staps committed
616 617
				EPRINTF("Illegal stack size: '%s'\n", argv[i]);
				EPRINTF(usage, argv[0]);
618
				EXIT(NULL,-1);
Camil Staps's avatar
Camil Staps committed
619 620 621 622
			}
		} else if (!strcmp(argv[i],"-h")) {
			heap_size=string_to_size(argv[++i]);
			if (heap_size==-1) {
Camil Staps's avatar
Camil Staps committed
623 624
				EPRINTF("Illegal heap size: '%s'\n", argv[i]);
				EPRINTF(usage, argv[0]);
625
				EXIT(NULL,-1);
Camil Staps's avatar
Camil Staps committed
626
			}
627 628
		} else if (!strcmp(argv[i],"-io")) {
			options.allow_file_io=1;
Camil Staps's avatar
Camil Staps committed
629
		} else if (input) {
Camil Staps's avatar
Camil Staps committed
630
			EPRINTF(usage, argv[0]);
631
			EXIT(NULL,-1);
Camil Staps's avatar
Camil Staps committed
632 633 634
		} else {
			input = fopen(argv[i], "rb");
			if (!input) {
Camil Staps's avatar
Camil Staps committed
635
				EPRINTF("Could not open '%s'\n", argv[i]);
636
				EXIT(NULL,-1);
Camil Staps's avatar
Camil Staps committed
637
			}
638 639
		}
	}
Camil Staps's avatar
Camil Staps committed
640

641 642
	ensure_interpreter_init();

643 644 645
	struct char_provider cp;
	new_file_char_provider(&cp, input);
	int res = parse_program(&state, &cp);
646
	free_parser(&state);
647
	free_char_provider(&cp);
648
	if (res) {
Camil Staps's avatar
Camil Staps committed
649
		EPRINTF("Parsing failed (%d)\n", res);
650
		EXIT(NULL,res);
Camil Staps's avatar
Camil Staps committed
651
	}
652

653
#if !defined(DEBUG_CURSES) && !defined(COMPUTED_GOTOS)
654
	if (list_program) {
Camil Staps's avatar
Camil Staps committed
655
		print_program(state.program);
656 657
	}

Camil Staps's avatar
Camil Staps committed
658 659
	if (!run)
		return 0;
660
#endif
Camil Staps's avatar
Camil Staps committed
661

662
	heap_size /= sizeof(BC_WORD);
663
	heap_size *= 2; /* Copying garbage collector */
664
	stack = safe_malloc(stack_size * sizeof(BC_WORD));
665
	stack[stack_size/2-1] = A_STACK_CANARY;
666
	heap = safe_malloc((heap_size+4) * sizeof(BC_WORD));
667

668 669 670 671 672
	BC_WORD *asp = stack;
	BC_WORD *bsp = &stack[stack_size];
	BC_WORD *csp = &stack[stack_size >> 1];

#ifdef DEBUG_CURSES
Camil Staps's avatar
Camil Staps committed
673
	init_debugger(state.program, stack, asp, bsp, csp, heap, heap_size);
674 675
#endif

676
	interpret(state.program,
677
			options,
Camil Staps's avatar
Camil Staps committed
678
			stack, stack_size,
679
			heap, heap_size,
680
			asp, bsp, csp,
681
			heap,
682
			NULL);
Camil Staps's avatar
Camil Staps committed
683

684 685 686 687
#ifdef DEBUG_CURSES
	close_debugger();
#endif

Camil Staps's avatar
Camil Staps committed
688
	free_program(state.program);
Camil Staps's avatar
Camil Staps committed
689 690 691 692
	free(state.program);
	free(stack);
	free(heap);

Camil Staps's avatar
Camil Staps committed
693 694
	return 0;
}
695
#endif