Perl_yyparse (pTHX_ int gramtype)
#endif
{
dVAR;
int yystate;
int yyn;
int yyresult;
/* Lookahead token as an internal (translated) token number. */
int yytoken = 0;
yy_parser *parser; /* the parser object */
yy_stack_frame *ps; /* current parser stack frame */
#define YYPOPSTACK parser->ps = --ps
#define YYPUSHSTACK parser->ps = ++ps
/* The variable used to return semantic value and location from the
action routines: ie $$. */
YYSTYPE yyval;
#ifndef PERL_IN_MADLY_C
# ifdef PERL_MAD
if (PL_madskills)
return madparse(gramtype);
# endif
#endif
YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
parser = PL_parser;
ENTER; /* force parser state cleanup/restoration before we return */
SAVEPPTR(parser->yylval.pval);
SAVEINT(parser->yychar);
SAVEINT(parser->yyerrstatus);
SAVEINT(parser->stack_size);
SAVEINT(parser->yylen);
SAVEVPTR(parser->stack);
SAVEVPTR(parser->ps);
/* initialise state for this parse */
parser->yychar = gramtype;
parser->yyerrstatus = 0;
parser->stack_size = YYINITDEPTH;
parser->yylen = 0;
Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
ps = parser->ps = parser->stack;
ps->state = 0;
SAVEDESTRUCTOR_X(S_clear_yystack, parser);
/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate. |
`------------------------------------------------------------*/
yynewstate:
yystate = ps->state;
YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
parser->yylen = 0;
{
size_t size = ps - parser->stack + 1;
/* grow the stack? We always leave 1 spare slot,
* in case of a '' -> 'foo' reduction */
if (size >= (size_t)parser->stack_size - 1) {
/* this will croak on insufficient memory */
parser->stack_size *= 2;
Renew(parser->stack, parser->stack_size, yy_stack_frame);
ps = parser->ps = parser->stack + size -1;
YYDPRINTF((Perl_debug_log,
"parser stack size increased to %lu frames\n",
(unsigned long int)parser->stack_size));
}
}
/* Do appropriate processing given the current state. */
/* Read a lookahead token if we need one and don't already have one. */
/* First try to decide what to do without reference to lookahead token. */
yyn = yypact[yystate];
if (yyn == YYPACT_NINF)
goto yydefault;
/* Not known => get a lookahead token if don't already have one. */
/* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
if (parser->yychar == YYEMPTY) {
YYDPRINTF ((Perl_debug_log, "Reading a token: "));
#ifdef PERL_IN_MADLY_C
parser->yychar = PL_madskills ? madlex() : yylex();
#else
parser->yychar = yylex();
#endif
# ifdef EBCDIC
if (parser->yychar >= 0 && parser->yychar < 255) {
parser->yychar = NATIVE_TO_ASCII(parser->yychar);
}
# endif
}
if (parser->yychar <= YYEOF) {
parser->yychar = yytoken = YYEOF;
YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
}
else {
yytoken = YYTRANSLATE (parser->yychar);
YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
}
/* If the proper action on seeing token YYTOKEN is to reduce or to
detect an error, take that action. */
yyn += yytoken;
if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
goto yydefault;
yyn = yytable[yyn];
if (yyn <= 0) {
if (yyn == 0 || yyn == YYTABLE_NINF)
goto yyerrlab;
yyn = -yyn;
goto yyreduce;
}
if (yyn == YYFINAL)
YYACCEPT;
/* Shift the lookahead token. */
YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
/* Discard the token being shifted unless it is eof. */
if (parser->yychar != YYEOF)
parser->yychar = YYEMPTY;
YYPUSHSTACK;
ps->state = yyn;
ps->val = parser->yylval;
ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
ps->savestack_ix = PL_savestack_ix;
#ifdef DEBUGGING
ps->name = (const char *)(yytname[yytoken]);
#endif
/* Count tokens shifted since error; after three, turn off error
status. */
if (parser->yyerrstatus)
parser->yyerrstatus--;
goto yynewstate;
/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state. |
`-----------------------------------------------------------*/
yydefault:
yyn = yydefact[yystate];
if (yyn == 0)
goto yyerrlab;
goto yyreduce;
/*-----------------------------.
| yyreduce -- Do a reduction. |
`-----------------------------*/
yyreduce:
/* yyn is the number of a rule to reduce with. */
parser->yylen = yyr2[yyn];
/* If YYLEN is nonzero, implement the default value of the action:
"$$ = $1".
Otherwise, the following line sets YYVAL to garbage.
This behavior is undocumented and Bison
users should not rely upon it. Assigning to YYVAL
unconditionally makes the parser a bit smaller, and it avoids a
GCC warning that YYVAL may be used uninitialized. */
yyval = ps[1-parser->yylen].val;
YY_STACK_PRINT(parser);
YY_REDUCE_PRINT (yyn);
switch (yyn) {
#define dep() deprecate("\"do\" to call subroutines")
#ifdef PERL_IN_MADLY_C
# define IVAL(i) (i)->tk_lval.ival
# define PVAL(p) (p)->tk_lval.pval
# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
# define TOKEN_FREE(a) token_free(a)
# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
# define IF_MAD(a,b) (a)
# define DO_MAD(a) a
# define MAD
#else
# define IVAL(i) (i)
# define PVAL(p) (p)
# define TOKEN_GETMAD(a,b,c)
# define TOKEN_FREE(a)
# define OP_GETMAD(a,b,c)
# define IF_MAD(a,b) (b)
# define DO_MAD(a)
# undef MAD
#endif
/* contains all the rule actions; auto-generated from perly.y */
#include "perly.act"
}
{
int i;
for (i=0; i< parser->yylen; i++) {
SvREFCNT_dec(ps[-i].compcv);
}
}
parser->ps = ps -= (parser->yylen-1);
/* Now shift the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
number reduced by. */
ps->val = yyval;
ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
ps->savestack_ix = PL_savestack_ix;
#ifdef DEBUGGING
ps->name = (const char *)(yytname [yyr1[yyn]]);
#endif
yyn = yyr1[yyn];
yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
yystate = yytable[yystate];
else
yystate = yydefgoto[yyn - YYNTOKENS];
ps->state = yystate;
goto yynewstate;
/*------------------------------------.
| yyerrlab -- here on detecting error |
`------------------------------------*/
yyerrlab:
/* If not already recovering from an error, report this error. */
if (!parser->yyerrstatus) {
yyerror ("syntax error");
}
if (parser->yyerrstatus == 3) {
/* If just tried and failed to reuse lookahead token after an
error, discard it. */
/* Return failure if at end of input. */
if (parser->yychar == YYEOF) {
/* Pop the error token. */
SvREFCNT_dec(ps->compcv);
YYPOPSTACK;
/* Pop the rest of the stack. */
while (ps > parser->stack) {
YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
LEAVE_SCOPE(ps->savestack_ix);
if (yy_type_tab[yystos[ps->state]] == toketype_opval
&& ps->val.opval)
{
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
if (ps->compcv != PL_compcv) {
PL_compcv = ps->compcv;
PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
}
op_free(ps->val.opval);
}
SvREFCNT_dec(ps->compcv);
YYPOPSTACK;
}
YYABORT;
}
YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
parser->yychar = YYEMPTY;
}
/* Else will try to reuse lookahead token after shifting the error
token. */
goto yyerrlab1;
/*----------------------------------------------------.
| yyerrlab1 -- error raised explicitly by an action. |
`----------------------------------------------------*/
yyerrlab1:
parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
for (;;) {
yyn = yypact[yystate];
if (yyn != YYPACT_NINF) {
yyn += YYTERROR;
if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
yyn = yytable[yyn];
if (0 < yyn)
break;
}
}
/* Pop the current state because it cannot handle the error token. */
if (ps == parser->stack)
YYABORT;
YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
LEAVE_SCOPE(ps->savestack_ix);
if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
if (ps->compcv != PL_compcv) {
PL_compcv = ps->compcv;
PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
}
op_free(ps->val.opval);
}
SvREFCNT_dec(ps->compcv);
YYPOPSTACK;
yystate = ps->state;
YY_STACK_PRINT(parser);
}
if (yyn == YYFINAL)
YYACCEPT;
YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
YYPUSHSTACK;
ps->state = yyn;
ps->val = parser->yylval;
ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
ps->savestack_ix = PL_savestack_ix;
#ifdef DEBUGGING
ps->name ="<err>";
#endif
goto yynewstate;
/*-------------------------------------.
| yyacceptlab -- YYACCEPT comes here. |
`-------------------------------------*/
yyacceptlab:
yyresult = 0;
for (ps=parser->ps; ps > parser->stack; ps--) {
SvREFCNT_dec(ps->compcv);
}
parser->ps = parser->stack; /* disable cleanup */
goto yyreturn;
/*-----------------------------------.
| yyabortlab -- YYABORT comes here. |
`-----------------------------------*/
yyabortlab:
yyresult = 1;
goto yyreturn;
yyreturn:
LEAVE; /* force parser stack cleanup before we return */
return yyresult;
}
START_MY_CXT
#define fdebug (MY_CXT.x_fdebug)
#define current_idx (MY_CXT.x_current_idx)
static I32
filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
{
dMY_CXT;
SV *my_sv = FILTER_DATA(idx);
char *nl = "\n";
char *p;
char *out_ptr;
int n;
if (fdebug)
warn("**** In filter_call - maxlen = %d, out len buf = %d idx = %d my_sv = %d [%s]\n",
maxlen, SvCUR(buf_sv), idx, SvCUR(my_sv), SvPVX(my_sv) ) ;
while (1) {
/* anything left from last time */
if ((n = SvCUR(my_sv))) {
out_ptr = SvPVX(my_sv) + BUF_OFFSET(my_sv) ;
if (maxlen) {
/* want a block */
if (fdebug)
warn("BLOCK(%d): size = %d, maxlen = %d\n",
idx, n, maxlen) ;
sv_catpvn(buf_sv, out_ptr, maxlen > n ? n : maxlen );
if(n <= maxlen) {
BUF_OFFSET(my_sv) = 0 ;
SET_LEN(my_sv, 0) ;
}
else {
BUF_OFFSET(my_sv) += maxlen ;
SvCUR_set(my_sv, n - maxlen) ;
}
return SvCUR(buf_sv);
}
else {
/* want lines */
if ((p = ninstr(out_ptr, out_ptr + n, nl, nl + 1))) {
sv_catpvn(buf_sv, out_ptr, p - out_ptr + 1);
n = n - (p - out_ptr + 1);
BUF_OFFSET(my_sv) += (p - out_ptr + 1);
SvCUR_set(my_sv, n) ;
if (fdebug)
warn("recycle %d - leaving %d, returning %d [%s]",
idx, n, SvCUR(buf_sv), SvPVX(buf_sv)) ;
return SvCUR(buf_sv);
}
else /* no EOL, so append the complete buffer */
sv_catpvn(buf_sv, out_ptr, n) ;
}
}
SET_LEN(my_sv, 0) ;
BUF_OFFSET(my_sv) = 0 ;
if (FILTER_ACTIVE(my_sv))
{
dSP ;
int count ;
if (fdebug)
warn("gonna call %s::filter\n", PERL_MODULE(my_sv)) ;
ENTER ;
SAVETMPS;
SAVEINT(current_idx) ; /* save current idx */
current_idx = idx ;
SAVESPTR(DEFSV) ; /* save $_ */
/* make $_ use our buffer */
DEFSV = sv_2mortal(newSVpv("", 0)) ;
PUSHMARK(sp) ;
if (CODE_REF(my_sv)) {
/* if (SvROK(PERL_OBJECT(my_sv)) && SvTYPE(SvRV(PERL_OBJECT(my_sv))) == SVt_PVCV) { */
count = perl_call_sv((SV*)PERL_OBJECT(my_sv), G_SCALAR);
}
else {
XPUSHs((SV*)PERL_OBJECT(my_sv)) ;
PUTBACK ;
count = perl_call_method("filter", G_SCALAR);
}
SPAGAIN ;
if (count != 1)
croak("Filter::Util::Call - %s::filter returned %d values, 1 was expected \n",
PERL_MODULE(my_sv), count ) ;
n = POPi ;
if (fdebug)
warn("status = %d, length op buf = %d [%s]\n",
n, SvCUR(DEFSV), SvPVX(DEFSV) ) ;
if (SvCUR(DEFSV))
sv_setpvn(my_sv, SvPVX(DEFSV), SvCUR(DEFSV)) ;
PUTBACK ;
FREETMPS ;
LEAVE ;
}
else
n = FILTER_READ(idx + 1, my_sv, maxlen) ;
if (n <= 0)
{
/* Either EOF or an error */
if (fdebug)
warn ("filter_read %d returned %d , returning %d\n", idx, n,
(SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n);
/* PERL_MODULE(my_sv) ; */
/* PERL_OBJECT(my_sv) ; */
filter_del(filter_call);
/* If error, return the code */
if (n < 0)
return n ;
/* return what we have so far else signal eof */
return (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n;
}
}
}
thStatus thExecuteCode(char *blockname,CODEPTR code, CODEPTR codelimit)
{
#ifdef PHILDEBUG
#ifdef NOTPOSIX
#warning Phil says NOTPOSIX!
#else
#warning Phil says not NOTPOSIX! i.e. POSIX!!
#endif
#ifdef POINTER64
#warning Phil says POINTER64!
#else
#warning Phil says not POINTER64!
#endif
#ifdef USEMEMCPY
#warning Phil says USEMEMCPY!
#else
#warning Phil says not USEMEMCPY!
#endif
#endif
register CODEPTR pc;
CODE rawopcode,opcode,ltype,rtype,lrtypes;
DAINT nargs,result;
register DAINT *sp;
DAINT i,il,ir,*pi;
DAFLOAT f,fl,fr,*pf;
DADOUBLE d,dl,dr,*pd;
DAINT index;
sp = stack;
pc = code;
while(pc < codelimit){
/* printf("PC=%x, Op code %x, Stack=%x, SP=%x\n",pc,*pc,stack,sp);*/
rawopcode = *pc++;
if(rawopcode >= OPLP){ /* New style */
ltype = (rawopcode & OPLEFTTYPEMASK) >> 8;
rtype = (rawopcode & OPRIGHTTYPEMASK) >> 4;
/* lrtypes = opcode & OPLRTYPEMASK;*/
opcode = rawopcode & OPCODEMASK;
switch(opcode & OPGROUPMASK)
{
case OPPUSHGROUP: /* Pushes */
switch(opcode)
{
#ifdef USEMEMCPY
void *tmpptr;
#endif
case OPPUSHINT: /* Float included in pushes */
if((rawopcode & OPRESTYPEMASK) == OPRDOUBLE){
/* printf("sp=%x, pc=%x\n",sp,pc);*/
#ifdef USEMEMCPY
memcpy((void *)&d,((DADOUBLE *)pc)++,sizeof(DADOUBLE));
PUSHDOUBLE(d);
#else
#ifdef __sgi
PUSHDOUBLE(*((DADOUBLE *)pc)); pc++; pc++;
#else
PUSHDOUBLE(*(DADOUBLE *)pc);/*phil*/
pc = (CODEPTR) (DADOUBLE *) ((DADOUBLE *)pc + 1);
#endif
#endif
/* printf("sp=%x, pc=%x\n",sp,pc);*/
} else {
PUSHINT(*pc++);
}
break;
case OPPUSHPINT: /*Push a pointer*/
#ifdef USEMEMCPY
PUSHPOINTER((memcpy(&tmpptr,(((DAINT **)pc)++),sizeof(void *))
,tmpptr));
#else
PUSHPOINTER(*(DAINT **)pc); /*phil*/
pc = (CODEPTR)(DAINT **) ((DAINT **)pc + 1);
#endif
break;
case OPPUSHINTP: /*Push what a pointer points to */
if((rawopcode & OPRESTYPEMASK) == OPRDOUBLE){
#ifdef USEMEMCPY
memcpy(&tmpptr,(((DAINT **)pc)++),sizeof(void *));
d = *(DADOUBLE *) tmpptr;
#else
d = **(DADOUBLE **)pc;/*phil*/
pc = (CODEPTR) (DADOUBLE **) ((DADOUBLE **)pc + 1);
#endif
PUSHDOUBLE(d);/*phil*/
} else {
#ifdef USEMEMCPY
memcpy(&tmpptr,(((DAINT **)pc)++),sizeof(void *));
PUSHINT(*(DAINT *) tmpptr);
#else
PUSHINT(**(DAINT **)pc);/*phil*/
pc = (CODEPTR) (DAINT **) ((DAINT **)pc + 1);
#endif
}
break;
case OPPUSHFUNCTION: /*Push a intrinsic function code */
PUSHINT(*pc++);
break;
}
break;
case OPEOLGROUP:
sp--; /* Should empty the stack */
if(rtype == OPRDOUBLE) sp--; /* Double is two entries on stack */
break;
case OPLINDEXGROUP:
if(opcode==OPLFARG) {
if(rtype==OPRINT) {POPINT(i);}
else if(rtype==OPRFLOAT) {POPFLOAT(f);}/*phil*/
else {POPDOUBLE(d);}/*phil*/
POPINT(index); /* Pop the function code */
switch(index)
{
case 0: /* abs */
if(rtype==OPRINT) {
if(i<0) i = -i;
PUSHINT(i);
} else if(rtype==OPRFLOAT) {
if(f<0.0) f = -f;
PUSHFLOAT(f);/*phil*/
} else {
if(d<0.0) d = -d;
PUSHDOUBLE(d);/*phil*/
}
break;
case 1: /* sqrt */
if(rtype==OPRINT) d = i;
else if(rtype==OPRFLOAT) d = f;
if(d>=0) d = sqrt(d);
else {
fprintf(STDERR,"Test block %s: sqrt(%f)\n",blockname,d);
d = 0;
}
PUSHDOUBLE(d);/*phil*/
break;
case 2: /* exp */
if(rtype==OPRINT) d = i;
else if(rtype==OPRFLOAT) d = f;
d = exp(d);
PUSHDOUBLE(d);/*phil*/
break;
case 3: /* sin */
if(rtype==OPRINT) d = i;
else if(rtype==OPRFLOAT) d = f;
d = sin(d);
PUSHDOUBLE(d);/*phil*/
break;
case 4: /* cos */
if(rtype==OPRINT) d = i;
else if(rtype==OPRFLOAT) d = f;
d = cos(d);
PUSHDOUBLE(d);/*phil*/
break;
case 5: /* tan */
if(rtype==OPRINT) d = i;
else if(rtype==OPRFLOAT) d = f;
d = tan(d);
PUSHDOUBLE(d);/*phil*/
break;
}
break;
}
if(rtype==OPRFLOAT) { /* Floating point index */
POPFLOAT(f);/*phil*/
index = floatToLong(f);
} else if(rtype==OPRDOUBLE) { /* Double */
POPDOUBLE(d);/*phil*/
index = floatToLong(d);
} else {
POPINT(index);
}
index -= ((opcode & 0xF000) == 0x1000 ? 0 : 1);
/* ltype should always be == restype */
if(opcode == OPLINDEX || opcode == OPLINDEXB){
if(ltype == OPRDOUBLE) {
FETCHDARRAY(d);/*phil*/
PUSHDOUBLE(d);/*phil*/
} else if (ltype == OPRFLOAT) {
FETCHFARRAY(f);/*phil*/
PUSHFLOAT(f);/*phil*/
} else {
FETCHIARRAY(i);/*phil*/
PUSHINT(i);
}
} else { /*pointer on stack*/
sp--;
#ifdef POINTER64
sp--;
#endif
if(ltype == OPRDOUBLE) {
/* *((DADOUBLE **)sp)++ = (*((DADOUBLE **)sp)+index);*/
/* The following works better on the alpha */
pd = *((DADOUBLE **)sp);
pd += index;
PUSHPOINTER(pd);/*phil*/
} else { /* Assume INT and FLOAT the same size */
/**((DAINT **)sp)++ = (*((DAINT **)sp)+index);*/
/* The following works better on the alpha */
pi = *((DAINT **)sp);
pi += index;
PUSHPOINTER(pi);/*phil*/
}
}
break;
case OPEQUAL: /* Big ugly matrix of type conversions */
if(rtype==OPRINT) {
POPINT(i);
if(ltype==OPRINT) {
SAVEINT(i); /* Save result in result variable *//*phil*/
PUSHINT(i); /* Put result back on stack */
} else if(ltype==OPRFLOAT) {
f = i; /* Convert to floating */
SAVEFLOAT(f); /* Save variable *//*phil*/
PUSHFLOAT(f); /* Put back on stack *//*phil*/
} else { /* if(ltype==OPRDOUBLE) */
d = i;
SAVEDOUBLE(d);/*phil*/
PUSHDOUBLE(d);/*phil*/
}
} else if(rtype==OPRFLOAT) {
POPFLOAT(f);/*phil*/
if(ltype==OPRINT) {
i = floatToLong(f);
SAVEINT(i); /* Save result in result variable *//*phil*/
*sp++ = i;
} else if(ltype==OPRFLOAT) {
SAVEFLOAT(f); /* Save variable *//*phil*/
*sp++ = *(DAINT *)&f;
} else { /* if(ltype==OPRDOUBLE) */
d = f;
SAVEDOUBLE(d);/*phil*/
PUSHDOUBLE(d);/*phil*/
}
} else { /* if(rtype==OPRDOUBLE) */
POPDOUBLE(d);/*phil*/
if(ltype==OPRINT) {
i = floatToLong(d);
SAVEINT(i); /* Save result in result variable *//*phil*/
*sp++ = i;
} else if(ltype==OPRFLOAT) {
f = d;
SAVEFLOAT(f); /* Save variable *//*phil*/
*sp++ = *(DAINT *)&f;
} else { /* if(ltype==OPRDOUBLE) */
SAVEDOUBLE(d);/*phil*/
PUSHDOUBLE(d);/*phil*/
}
}
break;
case OPLOGGROUP: /* Logic and Bit operations */
case OPSHIFTGROUP: /* Logic and Bit operations */
if(rtype==OPRINT) {
POPINT(ir);
} else if(rtype==OPRFLOAT) {
POPFLOAT(f);/*phil*/
ir = floatToLong(f);
} else {
POPDOUBLE(d);/*phil*/
ir = floatToLong(d);
}
if(ltype==OPRINT) {
POPINT(il);
} else if(ltype==OPRFLOAT) {
POPFLOAT(f);/*phil*/
il = floatToLong(f);
} else {
POPDOUBLE(d);/*phil*/
il = floatToLong(d);
}
switch(opcode)
{
case OPLOGOR:
*sp++ = il || ir;
break;
case OPLOGXOR:
*sp++ = (il != 0) ^ (ir != 0);
break;
case OPLOGAND:
*sp++ = il && ir;
break;
case OPBITOR:
*sp++ = il | ir;
break;
case OPBITXOR:
*sp++ = il ^ ir;
break;
case OPBITAND:
*sp++ = il & ir;
break;
case OPSHL:
*sp++ = il << ir;
break;
case OPSHR:
*sp++ = il >> ir;
break;
}
break;
case OPCOMPGROUP: /* Logic comparisons */
/* Result of Add amd MUL groups should now always be double */
case OPADDGROUP: /* Add and Subtract */
case OPMULGROUP: /* * / and % */
if(rtype==OPRINT) {
POPINT(ir);
dr = ir;
} else if (rtype==OPRFLOAT) {
POPFLOAT(fr);/*phil*/
dr = fr;
} else {
POPDOUBLE(dr);/*phil*/
}
if(ltype==OPRINT) {
POPINT(il);
dl = il;
} else if (ltype==OPRFLOAT) {
POPFLOAT(fl);/*phil*/
dl = fl;
} else {
POPDOUBLE(dl);/*phil*/
}
if(rtype!=OPRINT || ltype!=OPRINT){
switch(opcode)
{
case OPISEQUAL:
*sp++ = dl == dr;
break;
case OPISNOTEQUAL:
*sp++ = dl != dr;
break;
case OPISLT:
*sp++ = dl < dr;
break;
case OPISGT:
*sp++ = dl > dr;
break;
case OPISLE:
*sp++ = dl <= dr;
break;
case OPISGE:
*sp++ = dl >= dr;
break;
case OPADD:
d = dl + dr;
PUSHDOUBLE(d);/*phil*/
break;
case OPSUB:
d = dl - dr;
PUSHDOUBLE(d);/*phil*/
break;
case OPTIMES:
d = dl * dr; /* Need to deal with overflow */
PUSHDOUBLE(d);/*phil*/
break;
case OPIDIV:
/* printf("OP=%x\n",rawopcode);*/
if(dr == 0.0) {
fprintf(STDERR,"Test block %s: %f/0.0\n",blockname,dl);
d = 0.0;
} else {
d = dl / dr; /* Need to deal with overflow and div 0 */
}
*sp++ = floatToLong(d);
break;
case OPDIV:
if(dr == 0.0) {
fprintf(STDERR,"Test block %s: %f/0.0\n",blockname,dl);
d = 0.0;
} else {
d = dl / dr; /* Need to deal with overflow and div 0 */
}
PUSHDOUBLE(d);/*phil*/
break;
case OPMOD:
d = fmod(dl,dr);
PUSHDOUBLE(d);/*phil*/
break;
}
} else { /* Both left and right are int */
switch(opcode)
{
case OPISEQUAL:
*sp++ = il == ir;
break;
case OPISNOTEQUAL:
*sp++ = il != ir;
break;
case OPISLT:
*sp++ = il < ir;
break;
case OPISGT:
*sp++ = il > ir;
break;
case OPISLE:
*sp++ = il <= ir;
break;
case OPISGE:
*sp++ = il >= ir;
break;
case OPADD:
*sp++ = il + ir;
break;
case OPSUB:
*sp++ = il - ir;
break;
case OPTIMES:
*sp++ = il * ir; /* Need to deal with overflow */
break;
case OPIDIV:
/* printf("At OPIDIV all int branch\n");*/
if(ir == 0) {
fprintf(STDERR,"Test block %s: %d/0.0\n",blockname,il);
*sp++ = 0;
} else {
*sp++ = il / ir;
}
break;
case OPDIV:
if(ir == 0) {
fprintf(STDERR,"Test block %s: %d/0.0\n",blockname,il);
d = 0.0;
} else
d = dl / dr; /* Need to deal with overflow and div 0 */
PUSHDOUBLE(d);/*phil*/
break;
case OPMOD:
*sp++ = il % ir; /* Need to deal with overflow and div 0 */
break;
}
}
break;
case OPUNARY: /* Unary Operators */
switch(opcode)
{
case OPNEG:
if(rtype==OPRINT) {
i = -(*--sp);
*sp++ = i;
} else if (rtype==OPRFLOAT) {
f = *(DAFLOAT *)(--sp);
f = -f;
*sp++ = *(DAINT *)&f;
} else {
POPDOUBLE(d);/*phil*/
d = -d;
PUSHDOUBLE(d);/*phil*/
}
break;
case OPNOT:
case OPCOMP:
if(rtype==OPRINT) {
POPINT(i);
} else if(rtype==OPRFLOAT) {
POPFLOAT(f);/*phil*/
i = floatToLong(f);
} else {
POPDOUBLE(d);/*phil*/
i = floatToLong(d);
}
i = (opcode == OPNOT ? !i : ~i);
*sp++ = i;
break;
}
break;
default:
fprintf(STDERR,"Test block %s: Operator %x not yet implimented\n",
blockname,opcode);
break;
} /* Terminates switch */
} else { /* terminates if(rawopcode >=OPLP) *//* Old Style, May not work anymore */
switch(*pc++)
