BSInterp *mknative_interp(bpc_arg_t *arglist, int nargs) {
BSInterp *i;
int k;
i = bsInterpCreate();
/* create substitution variables */
for (k = 0; k < nargs; k++) {
char str[80];
BSObject *o;
snprintf(str,80,"(bsObjGetStringPtr(objv[%d]))",k+1);
bsSet(i,NULL,arglist[k].name,(o = bsObjString(str,-1,BS_S_VOLATILE)));
bsObjDelete(o);
}
return i;
}
void BSVMC_CompileStatement(BSVM_SVMCState *ctx, dytf l)
{
char tb[256];
byte *ip0, *ip1;
dytf c, ct, cv, t, n, u, v, n1;
char *s, *s1, *s2, *s3, *s4;
s64 li, lj;
int i, j, k;
t=l;
l=BSVMC_ReduceExpr(ctx, l);
if(BSVMC_DebugP(ctx))
{
dyPrintf("stmt: ");
dyPrint(dytfUnwrap(t));
dyPrintf(" -> ");
dyPrint(dytfUnwrap(l));
dyPrintf("\n");
}
//references/literals are useless in statement position
if(!dytfConsP(l))
{
if(!l)return; //empty statement
dyPrintf("useless expression in statement position\n");
return;
}
l=BSVMC_ProcessFlagsExpr(ctx, l, tb);
if(tb[0])ctx->cs_fl=dysymbol(tb);
else ctx->cs_fl=NULL;
if(dytfFormIsP(l, "module"))
{
// ctx->mname=dytfCadr(l);
return;
}
if(dytfFormIsP(l, "import"))
{
i=BSVMC_IndexLit(ctx, dytfCadr(l));
j=BSVMC_IndexLit(ctx, ctx->cs_fl);
BSVMC_EmitOp(ctx, BSVM_SOP_IMPORT);
BSVMC_EncIDX(ctx, i);
BSVMC_EncIDX(ctx, j);
ctx->pcap++;
return;
}
if(dytfFormIsP(l, "dbgmark"))
{
i=BSVMC_IndexLit(ctx, dytfCadr(l));
j=dytfIntv(dytfCaddr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_DBGMARK);
BSVMC_EncIDX(ctx, i);
BSVMC_EncIDX(ctx, j);
return;
}
if(dytfFormIsP(l, "linenum"))
{
i=dytfIntv(dytfCadr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_LN);
BSVMC_EncIDX(ctx, i);
return;
}
if(dytfFormIsP(l, "switch"))
{
BSVMC_CompileSwitch(ctx, l);
return;
}
if(dytfFormIsP(l, "class") ||
dytfFormIsP(l, "interface") ||
dytfFormIsP(l, "struct"))
{
BSVMC_CompileClass(ctx, l);
BSVMC_EmitOp(ctx, BSVM_SOP_POP);
return;
}
if(dytfFormIsP(l, "package"))
{
BSVMC_CompilePackage(ctx, l);
// BSVMC_EmitOp(ctx, BSVM_SOP_POP);
return;
}
if(dytfFormIsP(l, "goto"))
{
BSVMC_CompileGoto(ctx, l);
return;
}
if(dytfFormIsP(l, "label"))
{
BSVMC_EmitLabel(ctx,
dytfSymbolv(dytfCadr(l)), ctx->ip);
return;
}
if(dytfFormIsP(l, "continue"))
{
s=ctx->contstack[ctx->contstackpos-1];
BSVMC_EmitOp(ctx, BSVM_SOP_JMP);
BSVMC_EncWord(ctx, 0);
BSVMC_EmitGoto(ctx, s, ctx->ip);
return;
}
if(dytfFormIsP(l, "break"))
{
s=ctx->breakstack[ctx->breakstackpos-1];
BSVMC_EmitOp(ctx, BSVM_SOP_JMP);
BSVMC_EncWord(ctx, 0);
BSVMC_EmitGoto(ctx, s, ctx->ip);
return;
}
if(dytfFormIsP(l, "return"))
{
// n=BSVMC_ReduceExpr(ctx, dytfCadr(l));
// t=BSVMC_InferExpr(ctx, n);
// BSVMC_CompileExpr(ctx, n);
BSVMC_CompileExprCast(ctx, dytfCadr(l), dytfWrap(ctx->cf_ty));
// BSVMC_CompileExpr(ctx, dytfCadr(l));
if(!(ctx->i_cap))
BSVMC_EmitOp(ctx, BSVM_SOP_CLEARENV);
//#ifdef BSVM_USE_BVT
#if 0
if(BSVMC_TypeSmallIntP(ctx, ctx->cf_ty))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XI);
if(BSVMC_TypeLongP(ctx, ctx->cf_ty))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XL);
if(BSVMC_TypeFloatP(ctx, ctx->cf_ty))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XF);
if(BSVMC_TypeDoubleP(ctx, ctx->cf_ty))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XD);
#endif
BSVMC_EmitOp(ctx, BSVM_SOP_RET);
return;
}
if(dytfFormIsP(l, "set!"))
{
t=dytfCadr(l);
c=ctx->lenv; ct=ctx->tenv; cv=ctx->venv;
i=0; j=0;
while(dytfConsP(c))
{
if(c==ctx->llenv)i=1;
if(dytfCar(c)==t)break;
c=dytfCdr(c); ct=dytfCdr(ct); cv=dytfCdr(cv);
j++;
}
if(dytfConsP(c) && i)ctx->cap++;
if(dytfConsP(c))
{
t=BSVMC_InferExpr(ctx, dytfCaddr(l));
n=dytfCar(ct);
#if 0
if((n!=DYTF_NULL) && (t==DYTF_NULL))
{
i=BSVMC_IndexLit(ctx, n);
BSVMC_EmitOp(ctx, BSVM_SOP_CAST_S);
BSVMC_EncIDX(ctx, i);
t=n;
}
if((n!=DYTF_NULL) && (t!=n))
{
dyPrintf("warn: inferencer violation\n");
dysetcar(ct, NULL);
}
#endif
dysetcar(cv, NULL);
#ifdef BSVM_USE_BVT
i=-1;
if(BSVMC_TypeSmallIntP(ctx, n))
i=BSVM_SOP_LSTORE_XI;
if(BSVMC_TypeLongP(ctx, n))
i=BSVM_SOP_LSTORE_XL;
if(BSVMC_TypeFloatP(ctx, n))
i=BSVM_SOP_LSTORE_XF;
if(BSVMC_TypeDoubleP(ctx, n))
i=BSVM_SOP_LSTORE_XD;
if(i>=0)
{
BSVMC_CompileExprCast(ctx, dytfCaddr(l), n);
BSVMC_EmitOp(ctx, i);
BSVMC_EncByte(ctx, j);
return;
}
#endif
// if((t==dykeyword("int")) || (t==dykeyword("float")))
if(BSVMC_TypeSmallFixRealP(ctx, t))
{
BSVMC_CompileExpr(ctx, dytfCaddr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_LSTORE_F);
BSVMC_EncByte(ctx, j);
return;
}
BSVMC_CompileExpr(ctx, dytfCaddr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_LSTORE);
BSVMC_EncByte(ctx, j);
return;
}
BSVMC_CompileExpr(ctx, dytfCaddr(l));
i=BSVMC_IndexLit(ctx, dytfCadr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_STORE);
BSVMC_EncIDX(ctx, i);
return;
}
if((dytfFormIsP(l, "setindex!")) || (dytfFormIsP(l, "vector-set!")))
{
BSVMC_CompileSetIndexStmt(ctx, l);
return;
#if 0
BSVMC_CompileExpr(ctx, dytfCadddr(l));
// BSVMC_CompileExpr(ctx, dytfCaddr(l));
// BSVMC_CompileExpr(ctx, dytfCadr(l));
BSVMC_CompileExpr(ctx, dytfCadr(l));
BSVMC_CompileExpr(ctx, dytfCaddr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_STOREINDEX);
return;
#endif
}
if(dytfFormIsP(l, "preinc!") || dytfFormIsP(l, "predec!") ||
dytfFormIsP(l, "postinc!") || dytfFormIsP(l, "postdec!"))
{
t=BSVMC_ReduceExpr(ctx, dytfCadr(l));
u=BSVMC_InferExpr(ctx, t);
i=BSVM_OPR_DEC;
if(dytfFormIsP(l, "preinc!") || dytfFormIsP(l, "postinc!"))
i=BSVM_OPR_INC;
// if(dytfSymbolP(t) && (u==dykeyword("int")))
if(dytfSymbolP(t))
{
c=ctx->lenv; ct=ctx->tenv; cv=ctx->venv;
k=0; j=0;
while(dytfConsP(c))
{
if(c==ctx->llenv)k=1;
if(dytfCar(c)==t)break;
c=dytfCdr(c); ct=dytfCdr(ct); cv=dytfCdr(cv);
j++;
}
if(dytfConsP(c))
{
t=dytfCar(ct);
dysetcar(cv, NULL);
if(k)ctx->cap++;
#ifdef BSVM_USE_BVT
if(BSVMC_TypeSmallIntP(ctx, t))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XI);
if(BSVMC_TypeLongP(ctx, t))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XL);
if(BSVMC_TypeFloatP(ctx, t))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XF);
if(BSVMC_TypeDoubleP(ctx, t))
BSVMC_EmitOp(ctx, BSVM_SOP_PF_HINT_XD);
#endif
// if(i==BSVM_OPR_INC)BSVMC_EmitOp(ctx, BSVM_SOP_LINC_FN);
// else BSVMC_EmitOp(ctx, BSVM_SOP_LDEC_FN);
if(i==BSVM_OPR_INC)BSVMC_EmitOp(ctx, BSVM_SOP_LINC);
else BSVMC_EmitOp(ctx, BSVM_SOP_LDEC);
// BSVMC_EncByte(ctx, j);
BSVMC_EncIDX(ctx, j);
return;
}
}
if(dytfSymbolP(t))
{
if(i==BSVM_OPR_INC)BSVMC_EmitOp(ctx, BSVM_SOP_INC_S);
else BSVMC_EmitOp(ctx, BSVM_SOP_DEC_S);
BSVMC_EncIndexLit(ctx, t);
return;
}
#if 0
if(dytfSymbolP(t))
{
BSVMC_CompileExpr(ctx, t);
if(u==dykeyword("int"))
{
if(i==BSVM_OPR_INC)BSVMC_EmitOp(ctx, BSVM_SOP_INC_FN);
else BSVMC_EmitOp(ctx, BSVM_SOP_DEC_FN);
}else
{
BSVMC_EmitOp(ctx, BSVM_SOP_UNARYOP);
BSVMC_EncByte(ctx, i);
}
BSVMC_CompileAssign(ctx, t);
return;
}
#endif
if(1)
{
BSVMC_CompileExpr(ctx, t);
if(u==dykeyword("int"))
{
if(i==BSVM_OPR_INC)BSVMC_EmitOp(ctx, BSVM_SOP_INC_FN);
else BSVMC_EmitOp(ctx, BSVM_SOP_DEC_FN);
}else
{
BSVMC_EmitOp(ctx, BSVM_SOP_UNARYOP);
BSVMC_EncByte(ctx, i);
}
BSVMC_CompileAssign(ctx, t);
return;
}
return;
}
if(dytfFormIsP(l, "define"))
{
if(!dytfConsP(dytfCadr(l)))
{
BSVMC_CompileExpr(ctx, dytfCaddr(l));
i=BSVMC_IndexLit(ctx, dytfCadr(l));
if(ctx->lvl)BSVMC_EmitOp(ctx, BSVM_SOP_LEXBIND);
else BSVMC_EmitOp(ctx, BSVM_SOP_BIND);
BSVMC_EncIDX(ctx, i);
return;
}
n=dytfCaadr(l);
// if(dytfFormIsP(n, "cast"))
// n=dytfCaddr(n);
// t=dytfCons(dytfSymbol("lambda"), dytfCons(dytfCdadr(l), dytfCddr(l)));
t=dytfCons3s("rlambda", n, dytfCdadr(l), dytfCddr(l));
BSVMC_CompileExpr(ctx, t);
// n=dytfCaadr(l);
if(dytfFormIsP(n, "cast"))
n=dytfCaddr(n);
#if 1
s=BSVMC_InferArgsBaseSig(dytfCadr(l));
u=dytfSymbol(s);
i=BSVMC_IndexLit(ctx, n);
j=BSVMC_IndexLit(ctx, u);
k=BSVMC_IndexLit(ctx, ctx->cs_fl);
if(ctx->lvl)
{ BSVMC_EmitOp(ctx, BSVM_SOP_TYLEXBIND); }
else
{ BSVMC_EmitOp(ctx, BSVM_SOP_TYBIND); }
BSVMC_EncIDX(ctx, i);
BSVMC_EncIDX(ctx, j);
BSVMC_EncIDX(ctx, k);
#endif
return;
}
#if 0
if(dytfFormIsP(l, "defvar"))
{
if(!dytfConsP(dytfCadr(l)))
{
BSVMC_CompileExpr(ctx, dytfCaddr(l));
i=BSVMC_IndexLit(ctx, dytfCadr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_DYNBIND);
BSVMC_EncIDX(ctx, i);
return;
}
t=dytfCons(dytfSymbol("lambda"), dytfCons(dytfCdadr(l), dytfCddr(l)));
BSVMC_CompileExpr(ctx, t);
i=BSVMC_IndexLit(ctx, dytfCaadr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_DYNBIND);
BSVMC_EncIDX(ctx, i);
return;
}
#endif
if(dytfFormIsP(l, "vars"))
{
// c=dytfCaddr(l);
// t=dytfCadr(l);
c=dytfCadr(l);
t=DYTF_NULL;
while(dytfConsP(c))
{
n=dytfCar(c);
v=DYTF_NULL; t=DYTF_NULL;
if(dytfFormIsP(n, "set!"))
{
v=dytfCaddr(n);
n=dytfCadr(n);
}
if(dytfFormIsP(n, "cast"))
{
t=dytfCadr(n);
n=dytfCaddr(n);
}
BSVMC_CompileEmitVar(ctx, dytfCar(c));
if(ctx->lvl)
{
n1=DYTF_NULL;
if(!BSVMC_IsExpr(v))n1=v;
bsSet(ctx->lenv, dytfCons(n, ctx->lenv));
bsSet(ctx->tenv, dytfCons(t, ctx->tenv));
bsSet(ctx->venv, dytfCons(n1, ctx->venv));
}else if(!ctx->olvl)
{
n1=DYTF_NULL;
if(!BSVMC_IsExpr(v))n1=v;
bsSet(ctx->mlenv, dytfCons(n, ctx->mlenv));
bsSet(ctx->mtenv, dytfCons(t, ctx->mtenv));
bsSet(ctx->mvenv, dytfCons(n1, ctx->mvenv));
}
c=dytfCdr(c);
}
return;
}
#if 0
if(dytfFormIsP(l, "defun"))
{
if(!ctx->lvl && !ctx->olvl)
{
t=BSVMC_CompileBlock(ctx,
dytfList2(dytfCadr(l), dytfCaddr(l)),
dytfCadddr(l), dytfCddddr(l));
i=BSVMC_IndexLit(ctx, t);
BSVMC_EmitOp(ctx, BSVM_SOP_PUSH);
BSVMC_EncIDX(ctx, i);
bsSet(ctx->mfcns, dytfCons(t, ctx->mfcns));
i=BSVMC_IndexLit(ctx, dytfCaddr(l));
BSVMC_EmitOp(ctx, BSVM_SOP_BIND);
BSVMC_EncIDX(ctx, i);
return;
}
// t=CONS2S("lambda", dytfCadddr(l), dytfCddddr(l));
t=dytfCons3s("rlambda", dytfList2(dytfCadr(l), dytfCaddr(l)),
dytfCadddr(l), dytfCddddr(l));
// BSVM_TY_PrintLN(t);
BSVMC_CompileExpr(ctx, t);
i=BSVMC_IndexLit(ctx, dytfCaddr(l));
if(ctx->lvl)BSVMC_EmitOp(ctx, BSVM_SOP_LEXBIND);
else BSVMC_EmitOp(ctx, BSVM_SOP_BIND);
BSVMC_EncIDX(ctx, i);
return;
}
#endif
if(dytfFormIsP(l, "if"))
{
t=BSVMC_ReduceExpr(ctx, dytfCadr(l));
#if 0
i=BSVMC_BoolExpr(ctx, t);
if(i==1)
{
BSVMC_CompileStatement(ctx, dytfCaddr(l));
return;
}
if(i==0)
{
if(dytfConsP(dytfCdddr(l)))
BSVMC_CompileStatement(ctx, dytfCadddr(l));
return;
}
#endif
dyPrintf("if: ");
dyPrint(t);
dyPrintf("\n");
BSVMC_CompileJCF(ctx, t);
ip0=ctx->ip;
BSVMC_CompileStatement(ctx, dytfCaddr(l));
if(dytfConsP(dytfCdddr(l)))
{
BSVMC_EmitOp(ctx, BSVM_SOP_JMP);
BSVMC_EncWord(ctx, 0);
ip1=ctx->ip;
i=ctx->ip-ip0;
*(ip0-2)=i&0xFF;
*(ip0-1)=(i>>8)&0xFF;
BSVMC_CompileStatement(ctx, dytfCadddr(l));
ip0=ip1;
}
i=ctx->ip-ip0;
*(ip0-2)=i&0xFF;
*(ip0-1)=(i>>8)&0xFF;
return;
}
