kaya 0.4.4-6.2 / usr / lib / kaya / VM.h

#ifndef _VM_H // -*-C++-*-
#define _VM_H

/**
    Kaya run-time system
    Copyright (C) 2004, 2005 Edwin Brady

    This file is distributed under the terms of the GNU Lesser General
    Public Licence. See COPYING for licence.
*/

using namespace std;

#include "Heap.h"

#include <setjmp.h>
#include <math.h>
#include <wchar.h>

//#include "stdfuns.h"
#include "Array.h"
#include "ValueFuns.h"
#include "Closure.h"
#include <iostream>
#include <stack>

class VMState;

//extern VMState* vm;

#define STARTFN int tmp;

#define DECLARE(x) Value *x = NEWVAL; x->setInt(0);
// Args get initialised immediately anyway
#define DECLAREARG(x) Value stack_##x(NULL,KVT_INT);
#define DECLAREQUICK(x) Value stack_##x(NULL,KVT_INT); Value* x = &stack_##x;
#define HEAPVAL(x) if (x==&stack_##x) { x = MKPVAL(vm->getVPool(),stack_##x.getRaw(), stack_##x.getFunTable()); }
// cout << "Made heap val of " << &stack_##x << " -> " << x << endl; cout << x->getRaw() << endl; }

//#define DECLAREQUICK(x) Value *x = new Value(NULL,inttable);
#define TMPINT(x) int x
#define TMPREAL(x) double x
//#define ARRAY(x) x=new Value(ARRAY);
#define MKINT(x) mkint2(vm,(void*)(x))
//&(Value((void*)x,inttable))
#define MKREAL(x) (MKPVAL(vm->getVPool(),(void*)(NEWPREAL(vm->getRPool(),x)),KVT_REAL))
#define MKCHAR(x) (MKPVAL(vm->getVPool(),(void*)((int)x),KVT_INT))
#define MKFUN(x,i) (MKPVAL(vm->getVPool(),(void*)(new Closure(vm,x,0,i,false)),KVT_FUNC))
#define MKSTR(x) mkstr2(vm,x)
#define EMPTYSTR (MKPVAL(vm->getVPool(),(void*)(NEWPSTRING(vm->getSPool(),(wchar_t*)NULL)),KVT_STRING))
//doesn't work any more
//#define MKUNION(x) (MKVAL((void*)x,KVT_UNION))
#define MKCON(t,a) vm->push(MKPVAL(vm->getVPool(),new(vm->getUPool()) Union(vm,a),KVT_UNION+t));
#define MKCONRV(t,a) vm->pushrv((void*)(new(vm->getUPool()) Union(vm,a)),KVT_UNION+t);
#define MKNEWEXCEPT(e,a) vm->pushrv((void*)(new Exception(vm,e,a)),KVT_EXCEPTION)
#define MKCONZERO(t) { vm->push(MKPVAL(vm->getVPool(),(void*)t,KVT_CUNION)); }
#define MKCONZERORV(t) { vm->pushrv((void*)t,KVT_CUNION); }
#define MKEXCEPT vm->push(MKPVAL(vm->getVPool(),(void*)(new Exception(vm)),KVT_EXCEPTION))
//#define SET(x,i,y) x->setIdxPtr(y,i);
#define MKARRAYVAL(x) mkarrayval((void*)(x))

#define TOINDEX vm->goToIndex();
#define TOFIELD(i) vm->goToField(i);

#define MKARRAY(i) vm->mkArray(i)
#define MKARRAY2(s,i) vm->mkArray(s,i)
#define CALL(x) (x(vm)); 
//vm->push(vm->getReturnVal());
#define CALLFUN(x) (x->runClosure(vm)); 
//vm->push(vm->getReturnVal());
#define TAILCALL(x) (x(vm))
#define TAILCALLFUN(x) (x->runClosure(vm))
#define CALLTOP (vm->doPop()->runClosure(vm)); 
//vm->push(vm->getReturnVal());
#define TAILCALLTOP (vm->doPop()->runClosure(vm))

#define CLOSURE(x,i,tot,lam) vm->push(MKPVAL(vm->getVPool(),(void*)(new Closure(vm,x,i,tot,lam)),KVT_FUNC))
#define CLOSURELOC(x,i,lam) vm->push(x->clone()->addClosureArgs(vm,i,lam));
#define CLOSURETOP(i,lam) vm->push(vm->doPop()->clone()->addClosureArgs(vm,i,lam));

//#define GETFUN(x) (x->getFunc())
#define GETVAL(t) (t=vm->doPop()->getInt())
#define TOPINT vm->topItem()->getInt()
#define PUSHGETVAL(x,t) t=x->getInt()
#define GETRVAL(t) (t=vm->doPop()->getReal())
#define INTGETRVAL(t) t=vm->topint2real();
#define PUSHGETRVAL(x,t) t=x->getReal()
#define GETINDEX vm->getindex(); 
#define INTINFIX(t,op,x,y) t=(x op y)
#define ADDINPLACE(t,x) t->addInt(x);
#define SUBINPLACE(t,x) t->addInt(-x);
#define INTDIV(t,x,y) if (y==0) { vm->divideByZero(); } else { t=(x/y); }
#define REALINFIX(t,op,x,y) t=(x op y)
#define REALDIV(t,x,y) if (y==0) { vm->divideByZero(); } else { t=(x/y); }
#define REALINFIXBOOL(op,x,y) vm->push(mkint2(vm,(void*)(x op y)))
// CIM: optimise infix jumps
#define INFIXJFALSE(op,x,y,l) if ((x op y)==0) goto l
#define INFIXJTRUE(op,x,y,l) if ((x op y)!=0) goto l
#define UNARYJFALSE(op,x,l) if ((op x)==0) goto l
#define UNARYJTRUE(op,x,l) if ((op x)!=0) goto l
#define INTUNARY(t,op,x) t=(op x)
#define REALUNARY(t,op,x) t=(op x)
#define INTPOWER(t,x,y) t=intpower(x,y);
#define REALPOWER(t,x,y) t=realpower(x,y);
#define APPEND vm->doAppend();
#define APPENDINT(x) vm->doAppendChar(x);
#define APPENDSTR(x) vm->doAppendStr(x);
#define EQEXCEPT vm->doEqExcept(false);
#define NEEXCEPT vm->doEqExcept(true);
#define EQSTRING vm->doEqString();
#define NESTRING vm->doNeString();
#define EQSTRINGW(x) vm->doEqString(x);
#define NESTRINGW(x) vm->doNeString(x);
#define JEQSTRING(l) if(vm->doPop()->getString()->eq(vm->doPop()->getString())) goto l
#define JNESTRING(l) if(!vm->doPop()->getString()->eq(vm->doPop()->getString())) goto l
#define JEQSTRINGW(l,x) if(vm->doPop()->getString()->eq(x)) goto l
#define JNESTRINGW(l,x) if(!vm->doPop()->getString()->eq(x)) goto l
#define TOPSTREQ(x) vm->doTopStrEq(x)
//#define TOPEXCEQ(x) vm->doTopExcEq(x)
#define PRINTINT cout << vm->doPop()->getInt();
#define PRINTSTR vm->writestdout();
#define PRINTEXC vm->doPop()->getExcept()->dumpBacktrace();
#define NEWLINE cout << endl
#define LABEL(x) x:
#define JUMP(x) goto x
#define JZ(x,y) if ((x->getInt())==0) goto y
#define JNZ(x,y) if ((x->getInt())!=0) goto y
#define JNEG(x,y) if ((x->getInt())<0) goto y
#define JPOS(x,y) if ((x->getInt())>0) goto y
#define JFALSE(x) if (vm->doPop()->getInt()==0) goto x
#define JTRUE(x) if (vm->doPop()->getInt()!=0) goto x
#define JTFALSE(t,x) if (t==0) goto x
#define JTTRUE(t,x) if (t!=0) goto x
#define JEXNE(ex,l) if (vm->topItem()->getExcept()->tag != ex) goto l

#define PUSH(x) vm->push(x)
#define PUSH2(x,y) vm->push2(x,y)
#define PUSH3(x,y,z) vm->push3(x,y,z)
#define PUSH4(x,y,z,w) vm->push4(x,y,z,w)
#define TMPSETTOP(t) vm->tmpsettop(t)
#define PUSHSETTOP(x) vm->pushsettop(x);
#define PUSHGETINDEX(x) vm->pushgetindex(x);
#define SETLOOKUP(i,x) vm->setlookup(i,x);
#define PUSHTOINDEX(x) vm->pushToIndex(x);
#define DUMMY vm->push(MKVAL(0,KVT_INT))
#define POP(x) x->setPtr(vm->doPop())
#define POPARG(x) x=vm->doPop()
//#define POPANDCOPYARG(x) x=vm->doPop()
//#define POPANDCOPYARG(x) x=new Value(vm->topItem()->getRaw(),
//                                 vm->topItem()->getFunTable()); vm->doPop();
//#define POPANDCOPYARG(x) memcpy(&(stack_##x),(vm->doPop()),8);
#define POPANDCOPYARG(x) stack_##x.setPtr(vm->doPop());
#define COPYARG(x) stack_##x.setPtr(x); x = &stack_##x;
#define NOTEVAR(x) Value* remem_##x = x; 
#define REMEMBER(x) remem_##x->setPtr(x);
#define DISCARD vm->discardPop()
#define STACKINT(x,i) stack_##x.setInt(i); vm->push(x);
#define STACKREAL(x,r) stack_##x.setReal(r); vm->push(x);
// doesn't quite work yet
#define STACKSTR(x,s) stack_##x.setString(new(vm->getSPool()) String(s)); vm->push(x);
#define STACKRAW(x,i) stack_##x.setPtr((void*)(i), KVT_INT); vm->push(x);

//#define SETVAL(x,y) x->setPtr(new Value((void*)y));
#define SETINT(x,y) x->setInt(y);
#define SETVAR(x,y) x->setPtr(y);
#define SETRV vm->setRV()
#define SETRVREAL(r) vm->setRVreal(r)
#define SETTOP vm->setTop();
#define ADDTOP vm->addTop();
#define SUBTOP vm->subTop();
#define MULTOP vm->mulTop();
#define DIVTOP vm->divTop();
#define APPENDTOP vm->appendTop();
#define APPENDTOPINT vm->appendTopInt();
#define PROJ(x,i) x->fastproject(vm->topItem(),i);
#define PROJARG(a,t) vm->projarg(a,t);
#define SETPROJARG(s,a,t,d) vm->setprojarg(s,a,t,d);
#define EXPROJARG(x,i) x->exceptionproject(vm->topItem(),i);
/* CIM 12/7/05: changed ERROR to KERROR for MinGW compatibility */
#define KERROR cerr << vm->doPop()->getString()->getVal(); exit(-1);

#define PUSHGLOBAL(t,i) vm->push(KAYA_GLOBAL_##i)
//#define PUSHGLOBAL(t,i) vm->pushglobal(t,i)
#define CREATEGLOBAL(x,i) vm->newglobal(x,i)
// definitely don't use MKPVAL here!
#define DECLGLOBAL(i) static Value* KAYA_GLOBAL_##i = MKINITVAL(0, KVT_INT);

#define TAG vm->tag()
#define VMPTR vm->push(MKPVAL(vm->getVPool(),(void*)vm,KVT_INT));
#define STRLENGTH vm->push(MKPVAL(vm->getVPool(),(void*)(vm->doPop()->getString()->length()),KVT_INT))

#define GETLENGTH vm->push(MKPVAL(vm->getVPool(),(void*)(vm->topItem()->length()),KVT_INT))
#define GETFNID vm->push(MKPVAL(vm->getVPool(),(void*)(getFnID(vm->doPop()->getFunc())),KVT_INT))

// Coercions
#define STR2INT vm->str2int();
#define INT2STR vm->int2str();
#define REAL2STR vm->real2str();
#define STR2REAL vm->str2real();
#define STR2CHR vm->str2chr();
#define CHR2STR vm->chr2str();
#define BOOL2STR vm->bool2str();
#define INT2REAL vm->int2real();
#define REAL2INT vm->real2int();
/* CIM 12/7/05: changed VOID to KVOID for MinGW compatibility */
#define KVOID(x) x

// Exceptions
#define TRY(x) \
    vm->newjmp_buf(); \
    if (setjmp(*(vm->top_ex()))==2) goto x; \

#define THROW vm->throw_ex();
#define TRIED vm->tried(); 
#define RESTORE vm->restore();

#define CHECKCACHE(x)
#define STORECACHE0() 
//cache.addEntry(vm->topItem());
#define STORECACHE1(x)
#define STORECACHE2(x,y)
#define STORECACHE3(x,y,z)
#define STORECACHE4(x,y,z,w)
#define RETURN return;
//vm->returnVal(vm->doPop()); return;
#define GETRETURNED vm->push(vm->getReturnVal());
#define NOP
#ifdef NOCHECK
#define LINENO(f,l) 
#define PUSHBT(fn,f,l) 
#define INLAM(f) 
#define POPBT 
/*
#define CHECKCACHE(x) static FnCache cache(vm); \
   static Value* cache_val; \
   if (cache_val = cache.checkCache(x)) { vm->push(cache_val); return; }
*/
#define RTCHECKS 0
#else
//#define LINENO(f,l) vm->memstat(); vm->lineno(f,l)
#define LINENO(f,l) vm->lineno(f,l);
#define PUSHBT(fn,f,l) vm->pushBT(fn,f,l)
#define INLAM(f) vm->pushBT(f,f,-1)
#define POPBT vm->popBT()
#define RTCHECKS 1
/*
#define CHECKCACHE(x) static FnCache cache(vm); \
   static Value* cache_val; \
   if (cache_val = cache.checkCache(x)) { vm->popBT(); vm->push(cache_val); return; }
*/
#endif

VMState* initstack();
void finish(VMState* vm);

Value* mkstr(const wchar_t* str);
Value* mkstr2(VMState* vm,const wchar_t* str);
Value* mkint(void* i);
Value* mkint2(VMState* vm,void* i);
Value* mkarrayval(void* i);

/// Maths operators.
kint intpower(kint x, kint y);
double realpower(double x, double y);

/// Wide char/string conversions
wchar_t* strtowc(const char* str);
void strtovwc(VMState* vm, const char* str);
wchar_t chrtowc(const char str);
char* wctostr(const wchar_t* wc);
char* wcntostr(const wchar_t* wc, kint len);
// must manually ensure that char* target can hold (worst-case)
// 4*len*sizeof(char) bytes when using wcnptostr

void wcnptostr(const wchar_t* wc, kint len, char* target);
char wctochr(const wchar_t* c);

void mkUCS(const char* utf8, wchar_t* dest, kint inlen);
void mkUTF8(const wchar_t* raw, char* c, ukint len);
#endif