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; }