interpret.c 18.9 KB
Newer Older
1
#include <math.h>
2 3
#include <stdio.h>
#include <stdlib.h>
4
#include <string.h>
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"
21 22
#include "interpret.h"
#include "parse.h"
Camil Staps's avatar
Camil Staps committed
23
#include "settings.h"
24
#include "util.h"
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 61 62
#else /* assuming WORD_WIDTH == 32 */
static BC_WORD m____system[] = { 7, (BC_WORD) _4chars2int ('_','s','y','s'), (BC_WORD) _3chars2int ('t','e','m') };

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

# ifndef LINK_CLEAN_RUNTIME
67
void* __ARRAY__[]         = { 0, 0, &m____system, (void*) 7, _4chars2int ('_','A','R','R'), _3chars2int ('A','Y','_') };
68
void* __STRING__[]        = { 0, 0, &m____system, (void*) 8, _4chars2int ('_','S','T','R'), _4chars2int ('I','N','G','_') };
69 70
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') };
71
void* REAL[]              = { 0, 0, &m____system, (void*) 4, _4chars2int('R','E','A','L')};
72
void* INT[]               = { 0, 0, &m____system, (void*) 3, _3chars2int ('I','N','T') };
73
# endif
74
#endif /* Word-width dependency */
Camil Staps's avatar
Camil Staps committed
75

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

82
static void prepare_static_nodes(void) {
Camil Staps's avatar
Camil Staps committed
83 84 85 86
	static_booleans[2]=static_booleans[0]=(BC_WORD)&BOOL+2;
	static_booleans[1]=0;
	static_booleans[3]=1;
#ifndef LINK_CLEAN_RUNTIME
87 88 89 90 91 92 93 94
	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;
	}
95
#endif
Camil Staps's avatar
Camil Staps committed
96
}
Camil Staps's avatar
Camil Staps committed
97

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

106
static void build_host_nodes(void) {
Camil Staps's avatar
Camil Staps committed
107 108
	if (HOST_NODES[0] != NULL)
		return;
109 110 111 112 113 114
	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
115
# define INSTR(i) (BC_WORD) instruction_labels[i]
116
		interpret(NULL,
Camil Staps's avatar
Camil Staps committed
117
# ifdef POSIX
118 119 120
				0,
# endif
				NULL, 0, NULL, 0, NULL, NULL, NULL, NULL, NULL);
121
#else
122
# define INSTR(i) i
123
#endif
124
		if (arity == 1) {
125 126
			HOST_NODE_INSTRUCTIONS[6*arity-6] = (BC_WORD)1 << IF_INT_64_OR_32(48,16);
			HOST_NODE_INSTRUCTIONS[6*arity-5] = INSTR(Cjsr_eval_host_node);
127
		} else if (arity <= 5) {
128
			HOST_NODE_INSTRUCTIONS[6*arity-6] = INSTR(Cjsr_eval_host_node+arity-1); /* ap entry */
129 130 131 132 133 134 135
			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 {
136
			HOST_NODE_INSTRUCTIONS[6*arity-6] = INSTR(Cjsr_eval_host_node+arity-1); /* ap entry */
137 138 139 140
			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);
		}
141 142 143 144 145 146 147 148

		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)
149
				HOST_NODE_DESCRIPTORS[i++] = (BC_WORD) &HOST_NODE_INSTRUCTIONS[6*arity-3];
150 151 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
		}
		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};
193 194

void **interpret_error=NULL;
195 196
#endif

197 198 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
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
230
	};
Camil Staps's avatar
Camil Staps committed
231

232 233
#include "files.h"

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

250
#include <setjmp.h>
251
#ifdef POSIX
252
# include <signal.h>
253 254 255
#endif

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

264
#ifdef POSIX
265
# ifdef LINK_CLEAN_RUNTIME
266
static struct sigaction old_segv_handler;
267
# endif
268
static void handle_segv(int sig, siginfo_t *info, void *context) {
269 270 271 272 273 274 275 276 277 278
# 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;
	}
279
# endif
280 281 282 283 284 285 286

	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
Camil Staps committed
287
# ifdef LINK_CLEAN_RUNTIME
288 289 290 291 292 293
		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);
294 295
# else
	exit(1);
Camil Staps's avatar
Camil Staps committed
296
# endif
297
}
298 299 300
#elif defined(WINDOWS)
static LONG WINAPI handle_segv(struct _EXCEPTION_POINTERS *exception) {
# ifdef LINK_CLEAN_RUNTIME
301
	interpret_error=&e__ABC_PInterpreter__dDV__StackOverflow;
302 303 304 305 306
	if (segfault_restore_points!=NULL)
		longjmp(segfault_restore_points->restore_point, 1);
# endif
	return EXCEPTION_CONTINUE_SEARCH;
}
307 308
#endif

309
static void install_signal_handlers(void) {
Camil Staps's avatar
Camil Staps committed
310
#ifdef POSIX
311
	stack_t signal_stack;
312 313 314 315 316 317 318
	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;
319
	segv_handler.sa_sigaction=handle_segv;
320
	sigemptyset(&segv_handler.sa_mask);
321
	segv_handler.sa_flags=SA_ONSTACK | SA_SIGINFO | SA_RESTART;
322 323 324 325 326 327 328
	if (sigaction(SIGSEGV, &segv_handler,
# ifdef LINK_CLEAN_RUNTIME
				&old_segv_handler
# else
				NULL
# endif
				) == -1)
329
		perror("sigaction");
330 331
	if (sigaction(SIGFPE, &segv_handler, NULL) == -1)
		perror("sigaction");
332 333
#elif defined(WINDOWS)
	SetUnhandledExceptionFilter(&handle_segv);
334 335 336 337 338
#else
	EPRINTF("warning: interpreter does not recover from segfaults on this platform\n");
#endif
}

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

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

348
	install_signal_handlers();
349

350 351 352 353 354 355 356 357
	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
358 359 360 361
		interpret(NULL, 0,
# else
		struct interpretation_options options;
		interpret(NULL, options,
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388
# endif
				NULL, 0, NULL, 0, NULL, NULL, NULL, NULL, NULL);

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

		__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]];

# ifdef LINK_CLEAN_RUNTIME
		for (int i = 0; i < 32; i++)
			HOST_NODES[i][1]=instruction_labels[Cjsr_eval_host_node+i];
# endif
	}
#endif

	interpreter_initialized=1;

	return 1;
}

389 390 391
#ifdef LINK_CLEAN_RUNTIME
static BC_WORD *hp;
#endif
392 393
int interpret(
#ifdef LINK_CLEAN_RUNTIME
394
		struct interpretation_environment *ie,
395
		int create_restore_point,
396 397
#else
		struct program *program,
398
		struct interpretation_options options,
399
#endif
Camil Staps's avatar
Camil Staps committed
400
		BC_WORD *stack, size_t stack_size,
401
		BC_WORD *heap, size_t heap_size,
402
		BC_WORD *asp, BC_WORD *bsp, BC_WORD *csp, BC_WORD *_hp,
403
		BC_WORD *_pc) {
404
#ifdef COMPUTED_GOTOS
405 406 407 408 409 410 411 412 413 414 415 416
	/* 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) {
417 418
# define _COMPUTED_GOTO_LABELS
# include "abc_instructions.h"
419
		memcpy(instruction_labels, _instruction_labels, sizeof(BC_WORD) * CMAX);
420 421 422 423
		return 0;
	}
#endif

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

432
	BC_WORD *pc;
433 434 435 436 437
#ifdef LINK_CLEAN_RUNTIME
	hp=_hp;
#else
	BC_WORD *hp=_hp;
#endif
438
	heap_size /= 2; /* copying garbage collector */
439
#ifdef LINK_CLEAN_RUNTIME
440
	BC_WORD_S heap_free=heap + heap_size/(ie->options.in_first_semispace ? 2 : 1) - hp;
441 442 443
#else
	BC_WORD_S heap_free = heap + heap_size - hp;
#endif
Camil Staps's avatar
Camil Staps committed
444

445
#ifdef LINK_CLEAN_RUNTIME
446 447 448 449 450
	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;
451
# ifdef POSIX
452
		if (sigsetjmp(new->restore_point, 1) != 0) {
453 454 455
# else
		if (setjmp(new->restore_point) != 0) {
# endif
456 457 458
			ie->host->host_a_ptr=segfault_restore_points->host_a_ptr;
			goto eval_to_hnf_return_failure;
		}
459 460 461
	}
#endif

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

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

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

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

576 577 578
#ifndef LINK_CLEAN_RUNTIME

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

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

593 594 595 596
	struct interpretation_options options;
	options.in_first_semispace=1;
	options.allow_file_io=0;

597 598
	BC_WORD *stack;
	BC_WORD *heap;
599

600
	struct parser state;
601 602
	init_parser(&state);

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

639 640
	ensure_interpreter_init();

641 642 643
	struct char_provider cp;
	new_file_char_provider(&cp, input);
	int res = parse_program(&state, &cp);
644
	free_parser(&state);
645
	free_char_provider(&cp);
646
	if (res) {
647
		EPRINTF("Parsing failed (%d)\n", res);
648
		EXIT(NULL,res);
649
	}
650

651
#if !defined(DEBUG_CURSES) && !defined(COMPUTED_GOTOS)
652
	if (list_program) {
653
		print_program(state.program);
654 655
	}

656 657
	if (!run)
		return 0;
658
#endif
659

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

666 667 668 669 670
	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
671
	init_debugger(state.program, stack, asp, bsp, csp, heap, heap_size);
672 673
#endif

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

682 683 684 685
#ifdef DEBUG_CURSES
	close_debugger();
#endif

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

691 692
	return 0;
}
693
#endif