bterp.c

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

					EQ_ES(long double);

				case LS|A1:
					LOADSTK1(long double);
				case LS|A2:
					LOADSTK2(long double);
				case LS|A3:
					LOADSTK3(long double);

				case LM|A1:
					LOADMEM1(long double);
				case LM|A2:
					LOADMEM2(long double);
				case LM|A3:
					LOADMEM3(long double);
				case LM|A4:
					LOADMEM4(long double);

				case SS|A1:
					STORSTK1(long double);
				case SS|A2:
					STORSTK2(long double);
				case SS|A3:
					STORSTK3(long double);

				case SM|A1:
					STORMEM1(long double);
				case SM|A2:
					STORMEM2(long double);
				case SM|A3:
					STORMEM3(long double);
				case SM|A4:
					STORMEM4(long double);

				case MOVSS:
				{
					pc += mover(iv, np+1, *np, BX, fs, fs);
					break;
				}				
				case MOVSM:
				{
					pc += mover(iv, np+1, *np, BX, fs, dd);
					break;
				}
				case MOVMS:
				{
					pc += mover(iv, np+1, *np, BX, dd, fs);
					break;
				}
				case MOVMM:
				{
					pc += mover(iv, np+1, *np, BX, dd, dd);
					break;
				}
#endif /* SUPPORT_LONG_DOUBLE */
			}
			break;
		}/* END: XTD */

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

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

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

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

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

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

		case ARG:
		case ARGA:
		case ARGF:
		{
		PCB cb = (PCB)(es-(3*SZ));
		long size = *((long*)es);
		void *src = oes-SZ;
		void *dst;
			if(cb->flags & 0x80)
			{/* arg to builtin func */
				cb->es += SZ;
				dst = cb->es;
			}
			else
			{
				dst = cb->base_stack+sizeof(SB)+(cb->argofs<<2)+*((long*)oes);
			}
			if(*pc == ARGA)
			{/* dereference */
				src = *((void**)src);
			}
			else if(*pc == ARGF)
			{/* Passing address of function */
			Pft ft = *((Pft*)src);

			  if(ft->fmods & Fnested)
			  {/* Record the current evaluation stack
			  		the nested func will be called back */
			    ((PSB)base_stack)->cbes = (void*)cb;
			  }
			  if(cb->flags & 0x40)
			  {/* To an external function */
				if(!(ft->fmods & Fextern))
				{/* Passing address of local function */
				  if(!(ft->fmods & Fthunked))
				  {
					*((void**)src) = make_callback_thunk(	iv,
															base_stack,
															ft);
					ft->fmods |= Fthunked;
					if(ft->fmods & Fnested)
					{/* The thunk will be freed later */
						((PSB)base_stack)->thunkaddr = *((void**)src);
					}
				  }
				}
			  }
			}/* END: *pc == ARGF */
			switch(size)
			{
				case 1:
					*((char*)dst) = *((char*)src);
					break;
				case 2:
					*((short*)dst) = *((short*)src);
					break;
				case 4:
					*((long*)dst) = *((long*)src);
					break;
				case 8:
					*((double*)dst) = *((double*)src);
					break;
				default:
					memcpy(dst, src, size);
					break;
			}
			es -= 3*SZ;
			break;
		}

		case MOVSS|B1:
		case MOVSS|B2:
		case MOVSS|B4:
		case MOVSS|B8:
		{
			pc += mover(iv, np+1, *np, *pc & 3, fs, fs);
			break;
		}
		case MOVSM|B1:
		case MOVSM|B2:
		case MOVSM|B4:
		case MOVSM|B8:
		{
			pc += mover(iv, np+1, *np, *pc & 3, fs, dd);
			break;
		}
		case MOVMS|B1:
		case MOVMS|B2:
		case MOVMS|B4:
		case MOVMS|B8:
		{
			pc += mover(iv, np+1, *np, *pc & 3, dd, fs);
			break;
		}		
		case MOVMM|B1:
		case MOVMM|B2:
		case MOVMM|B4:
		case MOVMM|B8:
		{
			pc += mover(iv, np+1, *np, *pc & 3, dd, dd);
			break;
		}
		case DUMP:
		{
			es = oes;
			break;
		}
		case REGAIN:
		{
			es = nes;
			break;
		}
		case CALL:
		{
		PCB cb = (PCB)es;
		Pft ft = cb->loc;
		  if(cb->flags & 0x80)
		  {/* call builtin function through a function pointer */
		  char *pes = cb->es;

			if(do_builtin(iv, (unsigned char)ft->funcaddr, &pes))
			{/* builtin returned something */
#if SUPPORT_LONG_DOUBLE
				*((long double*)es) = *((long double*)(pes));
#else
				*((double*)es) = *((double*)pes);
#endif
			}
			free(cb->base_stack);
		  }
		  else if(cb->flags & 0x40)
		  {/* call external function */
		  unsigned short fmods = ft->fmods;
		  DATUM lastval;
		    if(fmods & Fretstr)
		    {
			  _ExternCallS(	ft->funcaddr, 
							cb->base_stack+sizeof(SB), 
							cb->argsiz,
							&lastval);
		    }
		    else
		    {
			  _ExternCall(	ft->funcaddr, 
							cb->base_stack+sizeof(SB), 
							cb->argsiz,
							&lastval);
		    }
			if(fmods & Fretdbl)
			{
				asm ("fstpl %0" : "=g"(lastval.Udouble) :);
			}
			else if(fmods & Fretflt)
			{
				asm ("fstps %0" : "=g"(lastval.Ufloat) :);
			}
			else if(fmods & Fretldbl)
			{
#if SUPPORT_LONG_DOUBLE
				asm ("fstpt %0" : "=g"(lastval.Ulongdouble) :);
#else
				asm ("fstpl %0" : "=g"(lastval.Udouble) :);
#endif
			}
#if SUPPORT_LONG_DOUBLE
			*((long double*)es) = lastval.Ulongdouble;
#else
			*((double*)es) = lastval.Udouble;
#endif
			free(cb->base_stack);
		  }/* END: call external func */
		  else
		  { /* call internal function */
		  void *pes;
		  void *lastalloca = iv->allocalist;
			pes = bterp_eval(iv, ft->funcaddr, cb->base_stack, cb->es, 
				cb->base_stack+((PSB)cb->base_stack)->stksize);
#if SUPPORT_LONG_DOUBLE
			*((long double*)es) = *((long double*)pes);
#else
			*((double*)es) = *((double*)pes);
#endif
			if(cb->flags & 0x20)
			{/* calledback a nested function */

			}
			else if(!(cb->flags & 0x10))
			{/* called interpreted function */
				free(cb->base_stack);
			} 
			purge_allocas(iv, lastalloca);
		  }/* END: call internal function */
		  break;
		}
		case RET:
		{
if(iv->debug) {
printf("RET ofs=%lx es=%p val=0x%lx\n", pc_offset, es, *((long*)es));
fflush(stdout);
}
			return es;
		}
		case SWAP:
		{
		char t[SZ];
			memcpy(t,es,SZ);
			memcpy(es,oes,SZ);
			memcpy(oes,t,SZ);
			break;
		}	
		case SWAP4:
		{
		long x;
			x = *((long *)es);
			*((long*)es) = *((long*)oes);
			*((long*)oes) = x;
			break;
		}
		case SWAP4DEEP:
		{
		long x;
			x = *((long*)oes);
			*((long*)oes) = *((long*)(oes-SZ));
			*((long*)(oes-SZ)) = x;
			break;
		}
		case DUP:
		{
			memcpy(nes,es,SZ);
			es = nes;
			break;
		}
		case DUP4:
		{
			*((long*)nes) = *((long*)es);
			es = nes;
			break;
		}
		case ABSMEM:
		{
			*((unsigned long*)es) += (unsigned long)dd;
			break;
		}
		case ABSSTK:
		{
			*((unsigned long*)es) += (unsigned long)fs;
			break;
		}
		case MOVDA1:
		{
			**((char**)(oes)) = *((char*)es);	
			es -= 2*SZ;
			break;
		}
		case MOVDA2:
		{
			**((short**)(oes)) = *((short*)es);	
			es -= 2*SZ;
			break;
		}
		case MOVDA4:
		{
			**((long**)(oes)) = *((long*)es);	
			es -= 2*SZ;
			break;
		}
		case MOVDA8:
		{
			**((double**)(oes)) = *((double*)es);	
			es -= 2*SZ;
			break;
		}
		case MOVDAX:
		{
#if SUPPORT_LONG_DOUBLE
			**((long double**)(oes)) = *((long double*)es);	
#else
			memcpy(*((void**)(oes)), es, XSZ);
#endif
			es -= 2*SZ;
			break;
		}
		case MOVAA1:
		{
			**((char**)(oes)) = **((char**)es);	
			es -= 2*SZ;
			break;
		}
		case MOVAA2:
		{
			**((short**)(oes)) = **((short**)es);	
			es -= 2*SZ;
			break;
		}
		case MOVAA4:
		{
			**((long**)(oes)) = **((long**)es);	
			es -= 2*SZ;
			break;
		}
		case MOVAA8:
		{
			**((double**)(oes)) = **((double**)es);	
			es -= 2*SZ;
			break;
		}
		case MOVAAX:
		{
#if SUPPORT_LONG_DOUBLE
			**((long double**)(oes)) = **((long double**)es);	
#else
			memcpy(*((void**)(oes)), *((void**)es), XSZ);
#endif
			es -= 2*SZ;
			break;
		}
		case MOVAAC:
		{
			memcpy(*((void**)(es-(2*SZ))), *((void**)(oes)), *((long*)(es)));
			es -= 3*SZ;
			break;
		}
	}
  }/* END: for(;;++pc) */
/* NOT REACHED */
  return 0;
}/* END: bterp_eval() */
/* ====================== END INTERPRETER CODE ===================== */

/* ==================  INITIALIZATION CODE BELOW THIS POINT ================ */
static Piv tiv;	/* temporary storage of iv whilst calling oxlink */

int 
bterp_setup_functhunk(FE entry, struct nlist *nl)
{/* Called from the dynamic linker */
Pft ft;

	ft = (void*)(entry->data_start_address + nl->n_value);

	if(ft->fmods & Fextern)
	{/* store a pointer to the function name string */
		if(!(ft->fmods & Fthunked))
		{
			ft->funcaddr = (long)(entry->strings + nl->n_un.n_strx);
		}
		return 0;
	}
	else if(!(ft->fmods & Fthunked))
	{/* export a useful address */
		nl->n_value = (long)make_callback_thunk(tiv, 0, ft);
		ft->fmods |= Fthunked;
	}
	return 1;
}
void
bterp_setup_switch(FE entry, struct nlist *nl)
{/* Called from the dynamic linker */
unsigned long key[2];
long value;

	if(tiv->swtable == 0)
		tiv->swtable = calloc(1, SWITCHMOD*sizeof(void*));

	key[0] = nl->n_desc<<11;
	key[1] = nl->n_un.n_strx;
	value = (long)(entry->text_start_address + nl->n_value);
	saveswitch(tiv, key, value);	
}

/* ====================== THE MAIN PROGRAM =============================== */

static char *