mal_interpreter.mx

一个内存数据库的源代码这是服务器端还有客户端

	InstrPtr p= flow[first].p;
#ifdef DEBUG_FLOW
		stream_printf(GDKout,"#adjust %d ",first);
		printInstruction(GDKout,mb,p, 0);
#endif
	for(j=0; j<p->retc; j++)
		pending[getArg(p,j)]= 0;

	for(i=first+1; i<last; i++){
		flow[i].cost=  MALflowCost(mb, stk,flow[i].p);
		flow[i].pending= 0;
		for(j=flow[i].p->retc; j< flow[i].p->argc; j++){
			flow[i].pending+= pending[getArg(flow[i].p,j)];
		}
#ifdef DEBUG_FLOW
		stream_printf(GDKout,"#adjust %d cost %d ",i,flow[i].cost);
		stream_printf(GDKout,"pending %d",flow[i].pending);
		printInstruction(GDKout,mb,flow[i].p, 0);
#endif
	}
}
@-
We simply move a cheap instruction into the front of the queue.
@c
void
nxtMALflowStep(FlowStep flow, int first, int last, MalBlkPtr mb){
	int i;
	FlowStepRec f;

	for( i= first; i<last; i++)
	if( flow[i].pending == 0 && flow[first].cost > flow[i].cost){
		f= flow[first];
		flow[first]= flow[i];
		flow[i]= f;
	}
#ifdef DEBUG_FLOW
	stream_printf(GDKout,"#next instruction %d: cost %d pending %d\n",
		first, flow[first].cost,flow[first].pending);
	printInstruction(GDKout,mb,flow[first].p, 0);
#endif
}


str runMALdataflow( Client cntxt, MalBlkPtr mb, int startpc, 
		int stoppc, MalStkPtr stk, MalStkPtr env, InstrPtr pcicaller)
{   
	ValPtr lhs,rhs,v;
	int stkpc,i,k,n; 
	InstrPtr pci=0; 
	int exceptionVar, exceptionPC;
	str ret=0;
	int stamp= -1;
	int backup[MAXARG];
	str sbackup[MAXARG];
	lng oldtimer=0;
	struct mallinfo oldMemory;
#ifdef HAVE_SYS_RESOURCE_H
	int oldinblock=0;
	int oldoublock=0;
	struct rusage oldResource;
#endif
	@:performanceVariables@
@-
First step is to collect all instructions into a multistack.
The instructions are sorted by dependency on enabled input
arguments.
@c
	FlowStep flow;
	char *pending;

	(void) env;
	(void)pcicaller;

	assert(stoppc > startpc);
	flow= (FlowStep) alloca(sizeof(FlowStepRec) * (stoppc-startpc+1));
	pending= (char*) alloca(sizeof(mb->vtop));
	memset((char*) pending, 0, sizeof(mb->vtop));

	for(n=0, i= startpc+1; i<stoppc; i++,n++)
		addMALflowStep(flow,n,pending, mb,stk,getInstrPtr(mb,i));

	if( cntxt->flags & timerFlag)
		oldtimer= cntxt->timer= GDKusec();
	oldMemory.arena= 0;
@-
Construct the flow relation ship and collect
the eligible instructions. [TODO]
@c
	/* select the first eligible instruction */
	stkpc= -1;
	exceptionPC = exceptionVar = -1;
	(void)exceptionPC; /* TODO maybe we should use this variable somewhere*/
	while( ++stkpc < n ){
		nxtMALflowStep(flow, stkpc,n,mb);
		pci = flow[stkpc].p;
		if( stk->cmd  ) {
			lng t=0;
			if( oldtimer)
				t= GDKusec();
			mdbStep(cntxt,mb,stk,getPC(mb,pci));
			if( stk->cmd == 'x') {
				stkpc= mb->stop;
				continue;
			}
			if( oldtimer ) {
				/* ignore debugger waiting time*/
				t= GDKusec()-t;
				oldtimer += t;
#ifdef HAVE_SYS_RESOURCE_H
				getrusage(RUSAGE_SELF, &oldResource);
#endif
				oldMemory= MT_mallinfo();
			}
		}

		@:beginProfile@
		ret = 0;
@-
The number of instructions allowed is severely
limited.
@c
		switch( pci->token){
		case ASSIGNsymbol: @:assignStmt@ break;
		case PATcall: @:patterncall@ break;
		case CMDcall: @:commandcall@ break;
		case FACcall: @:factorycall@ break;
		case FCNcall: @:functioncall@ break;
		}
		/* we don't allow sequential flow control here */
		dropMALflowStep(flow,stkpc,n,pending,mb,stk);
		@:endProfile@
	}
	@:MALwrapup@
	return ret;
}
@-
@= MALwrapup
	if( exceptionVar >= 0) {
		if (ret) {
			ret = createScriptException(mb, mb->stop-1,
					getExceptionType(getVarName(mb,exceptionVar)),
					ret, "Exception not catched");
		} else {
			if (stk->stk[exceptionVar].vtype == TYPE_str) {
				ret = createScriptException(mb, mb->stop-1, MAL,
						stk->stk[exceptionVar].val.sval,
						"Exception not catched");
			} else {
				ret = createScriptException(mb, mb->stop-1, MAL,
						NULL, "Exception not catched");
			}
		}
	}
@+ Safeguarding
The physical stack for each thread is an operating system parameter.
We do not want recursive programs crashing the server, so once in
a while we check whether we are running dangerously low on available
stack space.

This situation can be detected by calling upon the GDK functionality
of by limiting the depth of a function calls.
@-
@= safeguardStack
/* Expensive? 70 msec for 1M calls another solution is needed.*/
	if (stk->stkdepth > 50 * 1024 && THRhighwater()) {
		showScriptException(mb,0,MAL,
			"interpret: running out of physical stack space!\n");
		return createScriptException(mb, 0, STKOF, "Interpreter", NULL,
				"stack depth: %d", stk->stkdepth);
	}

@+ The interpreter loop
The interpreter is geared towards execution a MAL procedure together
with all its decendant invocations. As such, it provides the 
MAL abtract machine processor.

The value-stack frame of the surrounding scope is needed to resolve
binding values.  Getting (putting) a value from (into) a surrounding
scope should be guarded with the exclusive access lock.
This situation is encapsulated by a bind() function call, whose parameters
contain the access mode required.

The formal procedure arguments are assumed to always occupy the first
elements in the value stack.
@+ The major switch

@= MALinterpret
	ret = 0;
	switch( pci->token){
	case ASSIGNsymbol: @:assignStmt@ break;
	case PATcall: @:patterncall@ break;
	case CMDcall: @:commandcall@ break;
	case FACcall: @:factorycall@ break;
	case FCNcall: @:functioncall@ break;
	case NOOPsymbol:
	case REMsymbol:
		break;
	case ENDsymbol: 
		if( getInstrPtr(mb,0)->token == FACTORYsymbol)
			ret= shutdownFactory(mb);
		if( oldtimer)
			cntxt->timer= oldtimer;
		if( pcicaller && garbageControl(getInstrPtr(mb,0)) )
			garbageCollector(mb, stk, TRUE);
		@:endProfile@
		stkpc= mb->stop;
		continue;
	default:
		ret = createScriptException(mb, stkpc,MAL,
				NULL, "unkown operation");
		@:endProfile@
		stkpc= mb->stop;
		continue;
	}
@-
After the expression has been evaluated we should check for a
possible change in the control flow. 
@= MALflowofcontrol
switch(pci->barrier){
	case BARRIERsymbol:
		@:barrierControl@ stkpc++;
		break;
	case LEAVEsymbol:
	case REDOsymbol:
		v= &stk->stk[getDestVar(pci)];
		/* skip to end of barrier, depending on the type */
		switch(v->vtype){
			case TYPE_bit:
				if( v->val.cval[0] == TRUE && v->val.cval[0] != bit_nil)
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_chr:
				if( v->val.cval[0] )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_str:
				if( v->len > 0 && v->val.pval!= str_nil )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_sht:
				if( v->val.shval >= 0 && v->val.shval!= sht_nil )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_bat:
				if( v->val.bval > 0 )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_int:
				if( v->val.ival >= 0 && v->val.ival!= int_nil )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_wrd:
				if( v->val.wval >= 0 && v->val.wval!= wrd_nil )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_bte:
				if( v->val.btval >= 0 && v->val.btval!= bte_nil )
					stkpc= pci->jump; 
				else stkpc++;
				break;
			case TYPE_lng:
				if( v->val.lval >= 0 && v->val.lval!= lng_nil)
					stkpc= pci->jump; 
				else 
			default:
					stkpc++;
		}
		break;
	case CATCHsymbol:
		/* catch blocks are skipped unless 
		   searched for explicitly*/
		if(exceptionVar < 0) { 
			stkpc= pci->jump; 
			break;
		}
		exceptionVar = -1;
		stkpc++; 
		break;
	case EXITsymbol:
		if( getDestVar(pci) == exceptionVar) 
			exceptionVar = -1; 
		stkpc++; 
		break;
	case RAISEsymbol:
		exceptionPC = stkpc;
		exceptionVar = getDestVar(pci);
		if (getVarType(mb, getDestVar(pci)) == TYPE_str) {
			ret = createScriptException(mb, stkpc, MAL, NULL,
				stk->stk[getDestVar(pci)].val.sval);
		} else
			ret = createScriptException(mb, stkpc, MAL, NULL,
					"Exception raised");
		@:skipToCatch(exceptionVar)@
		break;
	case YIELDsymbol: /* to be defined */
		if( oldtimer)
			cntxt->timer= oldtimer;
		return yieldFactory( mb, pci, stkpc);
	case RETURNsymbol:
		/* Return from factory involves cleanup */

		if( getInstrPtr(mb,0)->token == FACTORYsymbol){
			yieldResult(mb,pci,stkpc);
			shutdownFactory(mb);
		} else
			/* a fake multi-assignment */
			if( env != NULL && pcicaller != NULL){
				InstrPtr pp=pci;
				@:endProfile@
				pci= pcicaller;
				for(i=0;i < pci->retc; i++){
					rhs = &stk->stk[pp->argv[i]];
					lhs = &env->stk[pci->argv[i]];
					VALcopy2(lhs,rhs);
					if( lhs->vtype == TYPE_bat )
						BBPincref(lhs->val.br.id, TRUE); 
				}
				if( garbageControl(getInstrPtr(mb,0)) )
					garbageCollector(mb, stk, TRUE);
				/* reset the clock */
				if( oldtimer)
					cntxt->timer= oldtimer;
			} else { 
				@:endProfile@
			}
		stkpc= mb->stop;
		continue;
	default:
		stkpc++; 
}

@+ Assignment command
The assignment statement copies values around on the stack frame,
including multiple assignments.

Pushing constants/initial values onto the stack is a separate operation.
It takes the constant value discovered at compile time and stored in the
symbol table and moves it to the stackframe location. This activity
is made part of the start-up procedure.

The before after calls should be reconsidered here, because
their. They seem superflous and the way they are used will
cause errors in multi-assignment statements.
@-
@= assignStmt
{	
	@:safeTarget@
	for(k=0, i=pci->retc; k<pci->retc && i<pci->argc; i++,k++){
		lhs = &stk->stk[pci->argv[k]];
		rhs = &stk->stk[pci->argv[i]];
		VALcopy2(lhs,rhs);
		if( lhs->vtype == TYPE_bat)
			BBPincref(lhs->val.br.id, TRUE);
	}
	@:restoreTarget@
	ret = 0;
	@:exceptionHndlr@
}
@}
@-
@node MAL API, Exception Handling, The MAL Interpreter, The MAL Interpreter

@+ MAL API
The linkage between MAL interpreter and compiled C-routines
is kept as simple as possible.
Basically we distinguish four kinds of calling conventions:
CMDcall, FCNcall, FACcall, and  PATcall.
The FCNcall indicates calling a MAL procedure, which leads
to a recursive call to the interpreter. 

CMDcall initiates calling a linked function, passing pointers 
to the parameters and result variable, i.e.  f(ptr a0,..., ptr aN)
The function returns a MAL-SUCCEED upon success and a pointer
to an exception string upon failure.
Failure leads to raise-ing an exception in the interpreter loop,
by either looking up the relevant exception message in the module
administration or construction of a standard string.

The PATcall initiates a call which contains the MAL context,
i.e. f(MalBlkPtr mb, MalStkPtr stk, InstrPtr pci)
The mb provides access to the code definitions. It is primarilly
used by routines intended to manipulate the code base itself, such
as the optimizers. The Mal stack frame pointer provides access
to the values maintained. The arguments passed are offsets
into the stack frame rather than pointers to the actual value.

@{
BAT parameters require some care. Ideally, a BAT should not be kept
around long. This would mean that each time we access a BAT it has to be
pinned in memory and upon leaving the function, it is unpinned.
This degrades performance significantly. 
After the parameters are fixed, we can safely free the destination
variable and re-initialize it to nil.

The policy implemented here is to make pin/unpin decisions part of
the bind(namespace, batname, mode) operation. [todo]

@= safeTarget
#ifdef STACKTRACE
	printf("safeTarget %d\n", needsCleanup(pci));
	printInstruction(GDKout,mb,pci, LIST_MAL_ALL);
#endif
	if( needsCleanup(pci) ){ 
		for(i=0; i<pci->retc; i++) {
			sbackup[i]= 0;  
			backup[i]= 0;  
			if( stk->stk[getArg(pci,i)].vtype == TYPE_bat){
				backup[i]= stk->stk[getArg(pci,i)].val.br.id;
				stamp= BBPcurstamp();
			} else if( stk->stk[getArg(pci,i)].vtype == TYPE_str){
					backup[i]= stk->stk[getArg(pci,i)].len;
					sbackup[i]= stk->stk[getArg(pci,i)].val.sval;
			} 
		}
	} 
@= batpropcheck
{
	if (@1->H != @1->T) {
		BATpropcheck(BATmirror(@1), BATPROPS_QUICK);
	}
	BATpropcheck(@1, BATPROPS_QUICK);
}
@= restoreTarget
#ifdef STACKTRACE
	printf("restoreTarget %d\n", needsCleanup(pci));
#endif
	if( needsCleanup(pci) ){ 
		for(i=0; i<pci->retc; i++)
		if( stk->stk[getArg(pci,i)].vtype == TYPE_bat){
			if( backup[i] ){
				if( backup[i]== stk->stk[getArg(pci,i)].val.br.id){
				/* target and source are identical, which means its
				   logical reference count is one too high . */
					BBPreleaselref(backup[i]);
				} else /* possible garbage collect the variable */
					BBPdecref(backup[i],TRUE);
			} 
		} else 
		if( stk->stk[getArg(pci,i)].vtype == TYPE_str){
			int a= getArg(pci,i);
			if( sbackup[i] && sbackup[i]!= stk->stk[a].val.sval){
				if( backup[i] > 0) 
					GDKfree(sbackup[i]);
				backup[i]=0;
				sbackup[i]=0;
			} 
		} 
	}
	/* Provide debugging support */
	if( GDKdebug & 10 ){
		BAT *b;
		str oldmsg =0;

		for( i=0; i< pci->retc; i++)
		if( stk->stk[getArg(pci,i)].vtype == TYPE_bat &&
				stk->stk[getArg(pci,i)].val.br.id ){
			b= BATdescriptor(stk->stk[getArg(pci,i)].val.br.id);
			if( b == NULL)
				continue;
			if( cntxt->errbuf && cntxt->errbuf[0]){
				oldmsg= GDKstrdup(cntxt->errbuf);
				*cntxt->errbuf= 0;
			}
			if( b->batStamp <= stamp){
				if( GDKdebug & 8)
					@:batpropcheck(b)@
			} else
				if( GDKdebug & 2)
					@:batpropcheck(b)@
			BBPunfix(b->batCacheid);
			if( cntxt->errbuf && cntxt->errbuf[0]) {
				if( oldmsg){
					strcpy(cntxt->errbuf,oldmsg);
					GDKfree(oldmsg);
				}
				throw(MAL, "mal.propertyCheck", "Errors found");
			}
			if( oldmsg){
				*cntxt->errbuf = *oldmsg;
				GDKfree(oldmsg);
			}
		}
	}
@-
@= commandcall
{	
	@:safeTarget
	/* improve performance with 20 ms/1M calls*/
	switch(pci->argc){
	case 0 : ret = (str) (*pci->fcn)(); break;
	case 1 : ret = (str) (*pci->fcn)(
			(ptr) getArgReference(stk,pci,0)); break;
	case 2 : ret = (str) (*pci->fcn)(
			(ptr) getArgReference(stk,pci,0),
			(ptr) getArgReference(stk,pci,1)); 
			 break;
	case 3 : ret = (str) (*pci->fcn)(
			(ptr) getArgReference(stk,pci,0),
			(ptr) getArgReference(stk,pci,1),
			(ptr) getArgReference(stk,pci,2)); 
			 break;
	case 4 : ret = (str) (*pci->fcn)(
			(ptr) getArgReference(stk,pci,0),
			(ptr) getArgReference(stk,pci,1),
			(ptr) getArgReference(stk,pci,2),
			(ptr) getArgReference(stk,pci,3)); 
			 break;
	case 5 : ret = (str) (*pci->fcn)(
			(ptr) getArgReference(stk,pci,0),
			(ptr) getArgReference(stk,pci,1),
			(ptr) getArgReference(stk,pci,2),
			(ptr) getArgReference(stk,pci,3), 
			(ptr) getArgReference(stk,pci,4)); 
			 break;
	case 6 : ret = (str) (*pci->fcn)(