bterp.c

OXCC is a multipass, interpreting C compiler with several language extensions. It generates an Archi

	*((long*)&pth[4]) = (long)ft;
	*((long*)&pth[9]) = (long)iv;
	*((long*)&pth[14]) = (long)base_stack;
	*((long*)&pth[22]) = (long)_bterp_handle_callbacks;

	return pth;
}
static void
ensure_strrets(Piv iv)
{
	if(iv->strretcnt+1 >= iv->slcnt) {
		iv->slcnt += 128;
		iv->struclist = realloc(iv->struclist, iv->slcnt * sizeof(void *));
	}
}
static void
prune_structs(Piv iv)
{
	while(iv->strretcnt > 0)
	{
		free(iv->struclist[--iv->strretcnt]);
	}
}
static int
mover(Piv iv, unsigned char *dp, int opcode, int size, char *src, char *dst)
{
char *s, *d;
int bump;

	switch(opcode)
	{
		case S1|D1:
			s = src+(G1(dp)<<2);
			d = dst+(G1(dp+1)<<2);
			bump = 3;
			break;
		case S1|D2:
			s = src+(G1(dp)<<2);
			d = dst+(G2(dp+1)<<2);
			bump = 4;
			break;
		case S1|D3:
			s = src+(G1(dp)<<2);
			d = dst+(G3(dp+1)<<0);
			bump = 5;
			break;
		case S1|D4:
			s = src+(G1(dp)<<2);
			d = (void*)G4(dp+1);
			bump = 6;
			break;
		case S2|D1:
			s = src+(G2(dp)<<2);
			d = dst+G1(dp+2);
			bump = 4;
			break;
		case S2|D2:
			s = src+(G2(dp)<<2);
			d = dst+(G2(dp+2)<<2);
			bump = 5;
			break;
		case S2|D3:
			s = src+(G2(dp)<<2);
			d = dst+(G3(dp+2)<<0);
			bump = 6;
			break;
		case S2|D4:
			s = src+(G2(dp)<<2);
			d = (void*)G4(dp+2);
			bump = 7;
			break;
		case S3|D1:
			s = src+(G3(dp)<<0);
			d = dst+(G1(dp+3)<<2);
			bump = 5;
			break;
		case S3|D2:
			s = src+(G3(dp)<<0);
			d = dst+(G2(dp+3)<<2);
			bump = 6;
			break;
		case S3|D3:
			s = src+(G3(dp)<<0);
			d = dst+(G3(dp+3)<<0);
			bump = 7;
			break;
		case S3|D4:
			s = src+(G3(dp)<<0);
			d = (void*)G4(dp+3);
			bump = 8;
			break;
		case S4|D1:
			s = (void*)G4(dp);
			d = dst+(G1(dp+4)<<2);
			bump = 6;
			break;
		case S4|D2:
			s = (void*)G4(dp);
			d = dst+(G2(dp+4)<<2);
			bump = 7;
			break;
		case S4|D3:
			s = (void*)G4(dp);
			d = dst+(G3(dp+4)<<0);
			bump = 8;
			break;
		case S4|D4:
			s = (void*)G4(dp);
			d = (void*)G4(dp+4);
			bump = 9;
			break;
		default:
			printf("bterp:ERROR: bad opcode for `mover' at pc=%lx\n",
				((char*)dp - iv->text_base) - 1);
			longjmp(iv->jb, 1);			
	}
	if(size == B1)
		*((char*)d) = *((char*)s);
	else if(size == B2)
		*((short*)d) = *((short*)s);
	else if(size == B4)
		*((long*)d) = *((long*)s);
	else if(size == B8)
		*((double*)d) = *((double*)s);
	else
		memcpy(d,s,XSZ);
	return bump;
}
static void
load_efunc(Piv iv, Pft ft)
{
void *e_faddr;
	if(!(e_faddr = oxlink_find_bare_func((void*)ft->funcaddr)))
	{/* not in core, load the file */
		if(!(e_faddr = oxlink_load_bare_symb((void*)ft->funcaddr, 1)))
		{
			printf("bterp:ERROR: Can't load function `%s'\n", (char*)ft->funcaddr);
			exit(1);
		}
	}
	ft->funcaddr = (long)e_faddr;
	ft->fmods |= Fthunked;
}
/* MOST OF THESE BUILTINS ARE UNNECESSARY DEMOS */
/* PUT ANYTHING THAT COULD BE CALLED THROUGH A FUNCPTR HERE */
static int
do_builtin(Piv iv, unsigned char code, char **pes)
{/* NOTE: builtins with no args and void return must leave a pseudo ret on stack */
char *es, *oes;
	es = *pes;
	oes = es-SZ;

	switch(code)
	{
		case ALLOCA:
		{
		char *abuf = malloc(*((unsigned*)es)+sizeof(void*));
			*((void**)es) = abuf+sizeof(void*);
			*((void**)abuf) = iv->allocalist;
			iv->allocalist = abuf;
			return 1;
		}
		case STRLEN:
		{
			*((unsigned*)es) = strlen(*((const char**)es));
			return 1;
		}
		case STRCPY:
		{
			*((void**)oes) = strcpy(*((char**)oes),*((const char**)es));
			*pes = oes;
			return 1;
		}
		case STRCAT:
		{
			*((void**)oes) = strcat(*((char**)oes),*((const char**)es));
			*pes = oes;
			return 1;
		}
		case MEMCPY:
		{
			*((void**)(oes-SZ)) = memcpy(*((void**)(oes-SZ)),*((const void**)oes),*((unsigned*)es));
			*pes -= 2*SZ;
			return 1;
		}
		case MEMMOVE:
		{
			*((void**)(oes-SZ)) = memmove(*((void**)(oes-SZ)),*((const void**)oes),*((unsigned*)es));
			*pes -= 2*SZ;
			return 1;
		}
		case MEMSET:
		{
			*((void**)(oes-SZ)) = 
				memset(*((void**)(oes-SZ)),*((int*)oes),*((long*)es));
			*pes -= 2*SZ;
			return 1;
		}
		case BZERO:
		{
			memset(*((void**)oes),0,*((unsigned*)es));
			*pes = oes;
			return 0;
		}
		case DEBUG:
		{
			iv->debug=1;
			printf("DEBUG ON\n");
			fflush(stdout);
			*pes = es+SZ;	/* pseudo ret */
			return 0;
		}
		case NODEBUG:
		{
			iv->debug=0;
			printf("DEBUG OFF\n");
			fflush(stdout);
			*pes = es+SZ;	/* pseudo ret */
			return 0;
		}
		case MALLOC:
		{
			*((void**)es) = malloc(*((unsigned*)es));
			return 1;
		}
		case CALLOC:
		{
			*((void**)oes) = calloc(*((unsigned*)oes),*((unsigned*)es));
			*pes = oes;
			return 1;
		}
		case REALLOC:
		{
			*((void**)oes) = realloc(*((void**)oes),*((unsigned*)es));
			*pes = oes;
			return 1;
		}
	}	
	return 0;
}
static void *
bterp_eval(Piv iv, long pc_offset, void *base_stack, char *es, char *eb)
{
char *dd, *fs;
unsigned char *pc, *np;
char *oes, *nes, *bes;
long first_loc = -100;
long last_loc = 0;

  dd = iv->dd;
  fs = base_stack + sizeof(SB);
  pc = iv->text_base + pc_offset;
  bes = es;

if(iv->debug) {
printf("FUNCTION ofs=%lx pc=%p bs=%p fs=%p es=%p dd=%p eb=%p\n", 
pc_offset, pc, base_stack, fs, es, dd, eb);
fflush(stdout);
}
  for(;;++pc)
  {
	np = pc+1;
	oes = es-SZ;
	nes = es+SZ;

if(iv->debug) {
printf("ofs:%lx op=%x es=%p val=%lx oval=%lx nval=%lx\n",
((char*)pc) - iv->text_base, *pc, es, 
*((long*)es), *((long*)oes), *((long*)nes));
fflush(stdout);
}
if(es < bes) {
printf("bterp:ERROR: STACK UNDERFLOW ofs:%lx op=%x es=%p val=%lx oval=%lx nval=%lx\n",
((char*)pc) - iv->text_base, *pc, es, *((long*)es), *((long*)oes), *((long*)nes));
fflush(stdout);
longjmp(iv->jb, (int)es);
}
if(es >= eb) {
printf("bterp:ERROR: STACK OVERFLOW ofs:%lx op=%x es=%p val=%lx oval=%lx nval=%lx\n",
((char*)pc) - iv->text_base, *pc, es, *((long*)es), *((long*)oes), *((long*)nes));
fflush(stdout);
longjmp(iv->jb, (int)es);
}
	switch(*pc)
	{
		case LOCATE|J1:
		{
			last_loc = ((char*)(pc + GP1(np))) - iv->text_base;
			if(first_loc == -100) first_loc = last_loc; 			
			++pc;
			break;
		}
		case LOCATE|J2:
		{
			last_loc = ((char*)(pc + GP2(np))) - iv->text_base;
			if(first_loc == -100) first_loc = last_loc; 			
			pc += 2;
			break;
		}
		case LOCATE|J3:
		{
			last_loc = ((char*)(pc + GP3(np))) - iv->text_base;
			if(first_loc == -100) first_loc = last_loc; 			
			pc += 3;
			break;
		}
		case LOCATE|J4:
		{
			last_loc = ((char*)(pc + GP4(np))) - iv->text_base;
			if(first_loc == -100) first_loc = last_loc; 			
			pc += 4;
			break;
		}
		case LS|A1|B1:
			LOADSTK1(char);
		case LS|A1|B2:
			LOADSTK1(short);
		case LS|A1|B4:
			LOADSTK1(long);
		case LS|A1|B8:
			LOADSTK1(double);
		case LS|A2|B1:
			LOADSTK2(char);
		case LS|A2|B2:
			LOADSTK2(short);
		case LS|A2|B4:
			LOADSTK2(long);
		case LS|A2|B8:
			LOADSTK2(double);
		case LS|A3|B1:
			LOADSTK3(char);
		case LS|A3|B2:
			LOADSTK3(short);
		case LS|A3|B4:
			LOADSTK3(long);
		case LS|A3|B8:
			LOADSTK3(double);

		case NEG|BYTE:
			NEG_ES(char);
		case NEG|SHORT:
			NEG_ES(short);
		case NEG|LONG:
			NEG_ES(long);
		case NEG|UBYTE:
			NEG_ES(unsigned char);
		case NEG|USHORT:
			NEG_ES(unsigned short);
		case NEG|ULONG:
			NEG_ES(unsigned long);
		case NEG|FLOAT:
			NEG_ES(float);
		case NEG|DOUBLE:
			NEG_ES(double);

		case LM|A1|B1:
			LOADMEM1(char);
		case LM|A1|B2:
			LOADMEM1(short);
		case LM|A1|B4:
			LOADMEM1(long);
		case LM|A1|B8:
			LOADMEM1(double);
		case LM|A2|B1:
			LOADMEM2(char);
		case LM|A2|B2:
			LOADMEM2(short);
		case LM|A2|B4:
			LOADMEM2(long);
		case LM|A2|B8:
			LOADMEM2(double);
		case LM|A3|B1:
			LOADMEM3(char);
		case LM|A3|B2:
			LOADMEM3(short);
		case LM|A3|B4:
			LOADMEM3(long);
		case LM|A3|B8:
			LOADMEM3(double);
		case LM|A4|B1:
			LOADMEM4(char);
		case LM|A4|B2:
			LOADMEM4(short);
		case LM|A4|B4:
			LOADMEM4(long);
		case LM|A4|B8:
			LOADMEM4(double);

		case COMP|B1:
			COMP_ES(char);
		case COMP|B2:
			COMP_ES(short);
		case COMP|B4:
			COMP_ES(long);
#if SUPPORT_LONG_LONG
		case COMP|B8:
			COMP_ES(long long);
#else
#endif
		case JMP|J1:
			pc += GP1(np)-1;
			break;
		case JMP|J2:
			pc += GP2(np)-1;
			break;
		case JMP|J3:
			pc += GP3(np)-1;
			break;
		case JMP|J4:
			pc += GP4(np)-1;
			break;

		case LJMPT|J1:
			if(*(es)) pc += GP1(np)-1;
			else {pc += 1; es=oes;}
			break;
		case LJMPT|J2:
			if(*(es)) pc += GP2(np)-1;
			else {pc += 2; es=oes;}
			break;
		case LJMPT|J3:
			if(*(es)) pc += GP3(np)-1;
			else {pc += 3; es=oes;}
			break;
		case LJMPT|J4:
			if(*(es)) pc += GP4(np)-1;
			else {pc += 4; es=oes;}
			break;

		case JMPT|J1:
			if(*(es)) pc += GP1(np)-1;
			else pc += 1;
			es = oes;
			break;
		case JMPT|J2:
			if(*(es)) pc += GP2(np)-1;
			else pc += 2;
			es = oes;
			break;
		case JMPT|J3:
			if(*(es)) pc += GP3(np)-1;
			else pc += 3;
			es = oes;
			break;
		case JMPT|J4:
			if(*(es)) pc += GP4(np)-1;
			else pc += 4;
			es = oes;
			break;

		case LJMPF|J1:
			if(!*(es)) pc += GP1(np)-1;
			else {pc += 1; es=oes;}
			break;
		case LJMPF|J2:
			if(!*(es)) pc += GP2(np)-1;
			else {pc += 2; es=oes;};
			break;
		case LJMPF|J3:
			if(!*(es)) pc += GP3(np)-1;
			else {pc += 3; es=oes;}
			break;
		case LJMPF|J4:
			if(!*(es)) pc += GP4(np)-1;
			else {pc +=4; es=oes;}
			break;

		case JMPF|J1:
			if(!*(es)) pc += GP1(np)-1;
			else pc += 1;
			es = oes;
			break;
		case JMPF|J2:
			if(!*(es)) pc += GP2(np)-1;
			else pc += 2;
			es = oes;
			break;
		case JMPF|J3:
			if(!*(es)) pc += GP3(np)-1;
			else pc += 3;
			es = oes;
			break;
		case JMPF|J4:
			if(!*(es)) pc += GP4(np)-1;
			else pc +=4;
			es = oes;
			break;

		case NOT|B1:
			NOT_ES(char);
		case NOT|B2:
			NOT_ES(short);
		case NOT|B4:	/* also FLOAT */
			NOT_ES(long);
		case NOT|B8:	/* also DOUBLE */
#if SUPPORT_LONG_LONG
			NOT_ES(long long);
#else
			NOT_ES1;
#endif
		case SS|A1|B1:
			STORSTK1(char);
		case SS|A1|B2:
			STORSTK1(short);
		case SS|A1|B4:
			STORSTK1(long);
		case SS|A1|B8:
			STORSTK1(double);
		case SS|A2|B1:
			STORSTK2(char);
		case SS|A2|B2:
			STORSTK2(short);
		case SS|A2|B4:
			STORSTK2(long);
		case SS|A2|B8:
			STORSTK2(double);
		case SS|A3|B1:
			STORSTK3(char);
		case SS|A3|B2:
			STORSTK3(short);
		case SS|A3|B4:
			STORSTK3(long);
		case SS|A3|B8:
			STORSTK3(double);

		case TRUTHOF|B2:
			TRUTH_ES(short);
		case TRUTHOF|B4:		/* also FLOAT */
			TRUTH_ES(long);
		case TRUTHOF|B8:		/* also DOUBLE */
#if SUPPORT_LONG_LONG
			TRUTH_ES(long long);
#else