From 1da5706eeb083689ca10aae6810db378f80a01d2 Mon Sep 17 00:00:00 2001 From: sbosse Date: Mon, 16 Mar 2026 11:11:28 +0100 Subject: [PATCH] Mon 16 Mar 11:09:06 CET 2026 --- src/vm.c | 539 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 539 insertions(+) create mode 100644 src/vm.c diff --git a/src/vm.c b/src/vm.c new file mode 100644 index 0000000..0e94d4f --- /dev/null +++ b/src/vm.c @@ -0,0 +1,539 @@ +#include "config.h" +#include "types.h" +#include "error.h" +#include "lexer.h" +#include "ops.h" +#include "mem.h" +#include "stack.h" +#include "reg.h" +#include "context.h" +#include "event.h" +#include "utils.h" +#include "debug.h" +#include "vm.h" +#include "printf.h" +#include "ccall.h" +#include "tokens.h" +#include "str.h" +#include "io.h" +#include "log.h" + +#define millis MILLIS + +// #define STACKCHECKUNDERFLOW +// #define STACKCHECKOVERFLOW + +/* + Main VM loop + Returns: -1: More ops, but state is interrupted/suspended, 0: END or Error , 1: more ops, still ready +*/ +int Run(context_t *C) { + stack_t *DS=C->DS; + stack_t *FS=C->FS; + mem_t *M=C->M; + reg_t *R=C->R; + number_t nx; + index_t ix,ia,ib,status; + address_t addr,saddr; + op_t * op; + address_t _pc; + ccall_t *ccall; + index_t steps=R->steps; + char *data; + context_t *ctx; + + /* Get instruction operation including optional arguments */ +loop_next_op: + if (R->state&PEVENTPEND) { + HandleEvents(C); + } + + if (!RUNNABLE1(R)) return 0; + + _pc=R->pc; + op = OPT(M,R->pc); + INCR(R->pc,ops_s[op->command]+1); + +#if PROFILE>0 + R->opcount++; +#endif + +#if DEBUG > 0 + log (LOGDEBUG2,"Run C%d[pc=%d] DS[%d] FS[%d] (step %d) ",CONTEXTID(C),_pc,DS->sp,FS->sp,steps); + if (log_level<=LOGDEBUG2) PrintOp(op,_pc); else log(LOGDEBUG2,"\n",NULL); +#endif + + + switch (op->command) { + // expressions + case ADD: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx+NTH(DS,1); + DECR(DS->sp,1); + break; + case AND: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx&NTH(DS,1); + DECR(DS->sp,1); + break; + case CMPS: + STACKUNDERFLOW(DS,2,R); + addr=POP(DS); saddr=POP(DS); // two null-terminated strings, eithe rin code or heap segment + PUSH(DS,string_cmp(&M->data[addr],&M->data[saddr],0)); + break; + case DIV: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx/NTH(DS,1); + DECR(DS->sp,1); + break; + case MOD: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx % NTH(DS,1); + DECR(DS->sp,1); + break; + case MUL: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx*NTH(DS,1); + DECR(DS->sp,1); + break; + case NEG: + STACKUNDERFLOW(DS,1,R); + NTH(DS,1)=-NTH(DS,1); + break; + case NOT: + STACKUNDERFLOW(DS,1,R); + NTH(DS,1)=NTH(DS,1)?0:1; + break; + case OR: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx|NTH(DS,1); + DECR(DS->sp,1); + break; + case SUB: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx-NTH(DS,1); + DECR(DS->sp,1); + break; + case EQ: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx==NTH(DS,1)?1:0; + DECR(DS->sp,1); + break; + case NEQ: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx!=NTH(DS,1)?1:0; + DECR(DS->sp,1); + break; + case LT: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nxsp,1); + break; + case GT: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx>NTH(DS,1)?1:0; + DECR(DS->sp,1); + break; + case LE: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx<=NTH(DS,1)?1:0; + DECR(DS->sp,1); + break; + case GE: + STACKUNDERFLOW(DS,2,R); + nx=NTH(DS,2); NTH(DS,2)=nx>=NTH(DS,1)?1:0; + DECR(DS->sp,1); + break; + + // Stack operations + case DROPD: + STACKUNDERFLOW(DS,op->ix,R); + DECR(DS->sp,op->ix); + break; + case DROPF: + STACKUNDERFLOW(FS,op->ix,R); + DECR(FS->sp,op->ix); + break; + case NTHD: + STACKUNDERFLOW(DS,op->ix,R); + nx=NTH(DS,op->ix); PUSH(DS,nx); + break; + case NTHF: + STACKUNDERFLOW(FS,op->ix,R); + nx=NTH(FS,op->ix); PUSH(DS,nx); + break; + case PUSHD: + if (SFULL(DS)) { R->error=ESTACK; return 0; }; + PUSH(DS,op->nx); + break; + case PUSHF: + if (SFULL(FS)) { R->error=ESTACK; return 0; }; + PUSH(FS,op->nx); + break; + case TOF: + if (SFULLN(FS,op->ix)|| SEMPTYN(DS,op->ix)) { R->error=ESTACK; return 0; }; + for(ix=op->ix;ix>0;ix--) { nx=NTH(DS,ix); PUSH(FS,nx); } + DECR(DS->sp,op->ix); + break; + case SETF: + STACKUNDERFLOW(DS,1,R); + nx=POP(DS); NTH(FS,op->ix)=nx; + break; + + case STRING: + if (SFULL(DS)) { R->error=ESTACK; return 0; }; + // store string address (code address) on data stack + PUSH(DS,(number_t)R->pc); + // jump over string content + INCR(R->pc,op->ix+1); + break; + + /* + Flow control + + ix contains absolute (positive) address + 1000: op1 + 1002: op2 + 1003: JMP 1000 + 1006: op3 + 1007: JMP 1012 + 1012: op4 + + Negative "addresses" refernce the nth F-Stack element containing the new pc value. + */ + case JMP: + if (op->ix<0) R->pc=(address_t)NTH(FS,-op->ix); else R->pc=(address_t)op->ix; + break; + case JNZ: + STACKUNDERFLOW(DS,1,R); + nx=POP(DS); if (nx!=0) { if (op->ix<0) R->pc=(address_t)NTH(FS,-op->ix); else R->pc=(address_t)op->ix; } + break; + case JZ: + STACKUNDERFLOW(DS,1,R); + nx=POP(DS); if (nx==0) { if (op->ix<0) R->pc=(address_t)NTH(FS,-op->ix); else R->pc=(address_t)op->ix; } + break; + case TESTRANGE: + ix=INDEX(M,R->pc); INCR(R->pc,index_s); + if (NTH(DS,1)ix || NTH(DS,1)>ix) { R->error=ERANGE; return 0; }; + break; + case LOOP: + // Counting loop, loop variable is on FS + // FS (i=a,b,step,loop start,loop end) -- + if (NTH(FS,5)pc=(address_t)NTH(FS,2); + } else { + DECR(FS->sp,5); + } + break; + // Read from and write to heap memory + case DATA: + R->data=R->pc; + R->pc+=op->ix; + break; + case READ: + if (SFULL(DS)) { R->error=ESTACK; return 0; }; + if (op->ax>=0) { + // global variable, ax is heap address + PUSH(DS,NUMBER(M,op->ax)); + } else if (op->ax==-1) { + // global variable, heap address from stack + addr=(address_t)POP(DS); PUSH(DS,NUMBER(M,addr)); + } +#if HAS_FUNC > 0 + else { + // local variable on stack + // -2, -3, ... is stack address ... 0, 1, .. RELATIVE to frame pointer + addr=(address_t)(-op->ax)-2+R->fp; PUSH(DS,NUMBER(DS,addr)); + } +#endif + break; + case WRITE: + STACKUNDERFLOW(DS,1,R); + nx=POP(DS); + if (op->ax>=0) { + // global variable, ax is heap address + NUMBER(M,op->ax)=nx; + } else if (op->ax==-1) { + // global variable, heap address from stack + addr=(address_t)POP(DS); NUMBER(M,addr)=nx; + } +#if HAS_FUNC > 0 + else { + // local variable on stack + // -2, -3, ... is stack address ... 0, 1, .. RELATIVE to frame pointer + addr=(address_t)(-op->ax)-2+R->fp; + NUMBER(DS,addr)=nx; + } +#endif + break; + case WRITES: + STACKUNDERFLOW(DS,3,R); + if (op->ax>=0) { + addr=op->ax; + data=(char*)&M->data[addr]; + } else if (op->ax==-1) { + addr=(address_t)POP(DS); + data=(char*)&M->data[addr]; + } +#if HAS_FUNC > 0 + else { + addr=(address_t)(-op->ax)-2+R->fp; + data=(char*)&DS->data; + } +#endif + ix = (index_t)POP(DS); + saddr = (address_t)POP(DS); // source string is always in code/heap area + string_copy(data,&M->data[saddr],ix); + break; + + case INTERRUPT: + // stop or delay + if (R->state & PHANDLER) { R->error=ERUN; return 0; }; // interrupt in event handler is forbidden + // SUSPEND VM + if (op->ix>0) { + // direct timeout + R->timeout=millis()+op->ix; + R->state |= (PTIMEOUT|PINTERRUPT); + } else if (op->ix<0) { + // indirect timeout value on stack + if (SEMPTY(DS)) { R->error=ESTACK; return 0; } + R->timeout=millis()+(time_t)POP(DS); + R->state |= (PTIMEOUT|PINTERRUPT);; + } else if (op->ix==0 && !(R->state&PAWAIT)) { + R->state |= PSUSPENDED; // stop + } else if (op->ix==0 && R->state&PAWAIT) { + // printf("INTERRUPT PAWAIT\n"); + // in-line event awaiting + // await was handled in EVENT, R->state is already modified! + if (!(R->state&PINTERRUPT)) { + // latched event, event already fired, continue! + R->state &= ~PAWAIT; + break; + } + R->state |= PSUSPENDED; + } + R->state &= ~PRUNNING; + R->event = -1; + return -1; + break; + case CALL: +#if HAS_FUNC > 0 + /* + Stack Frame [DS.sp,fp,pc,TCALL] + */ + if (SFULLN(FS,4)) { R->error=ERUN; return 0; }; + PUSH(FS,(number_t)DS->sp); + PUSH(FS,(number_t)R->fp); + PUSH(FS,(number_t)R->pc); + PUSH(FS,(number_t)TCALL); + R->fp = DS->sp; +#else + /* + Stack Frame [pc,TCALL] + */ + if (SFULLN(FS,2)) { R->error=ERUN; return 0; }; + PUSH(FS,(number_t)R->pc); + PUSH(FS,(number_t)TCALL); +#endif + R->pc=op->ax; + break; + case CCALL: + ccall=&ccalls[op->ix]; + ccall->foo(Context[R->context]); + break; + case END: + // clean-up + CodeCleanUp(C); + EventCleanUp(C); + R->state=PIDLE; + return 0; + break; +#if HAS_FUNC > 0 + case FUNC: +#endif + case PROC: + R->pc+=op->ax; // length of proc body + break; + case RESUME: + // go go(context) + if (op->ix==-1) { + if (R->state&PSUSPENDED) { + R->state &= ~PSUSPENDED; + R->state |= PRUNNING; + }; + } else { + context_t *c; + // context on stack + if (op->ix==-2) { + STACKUNDERFLOW(DS,1,R); + ix=POP(DS); // token + } else ix=op->ix; + c=Context[ix]; + if (c->R->state&PSUSPENDED || c->R->state==PIDLE) { + c->R->state &= ~PSUSPENDED; + c->R->state |= PRUNNING; + }; + } + break; + case RETURN: +#if HAS_FUNC > 0 + STACKUNDERFLOW(FS,4,R); +#else + STACKUNDERFLOW(FS,2,R); +#endif + ix=POP(FS); // token + if (ix!=TEVENT && ix!=TCALL) { R->error=ECALL; return 0; } + R->pc=(address_t)POP(FS); // get pc return address +#if HAS_FUNC > 0 + if (op->ix==1) nx=POP(DS); // save function return value + R->fp=(address_t)POP(FS); // restore frame pointer + DS->sp=(address_t)POP(FS); // restore stack pointer (can contain local variables) + if (op->ix==1) PUSH(DS,nx); +#endif + if (ix==TEVENT) { + R->state &= ~PHANDLER; // return from handler + R->event = -1; + } + break; +#if MAXTASKS > 1 + case FORK: + // We allocate context incrementally using ContextTop! + // Push task ids to new and old task (assignment to local variable) + if (ContextTop==MAXTASKS) { R->error=ETASK; return 0; }; + ctx=ContextInit(NULL,M,NULL,NULL,NULL); + StackCopy(C->DS,ctx->DS); + StackCopy(C->FS,ctx->FS); + PUSH(DS,CONTEXTID(C)); + ctx->R->pc=C->R->pc; + ctx->S=C->S; +#if HAS_FUNC > 0 + ctx->R->fp=C->R->fp; +#endif + ctx->R->state=PRUNNING; + ctx->R->steps=C->R->steps; + PUSH(ctx->DS,CONTEXTID(ctx)); + break; +#endif +#if HAS_FUNC > 0 + case INCSP: + DS->sp+=op->ix; + break; + case SETSP: + DS->sp=op->ix; + break; +#endif + case YIELD: + return 1; + break; +#if HAS_LOCK > 0 + case LOCK: + if (M->data[op->ax]) { R->pc=_pc; return 1; } + M->data[op->ax]=1; + break; + case UNLOCK: + M->data[op->ax]=0; + break; +#endif + case ENV: + // get system info + switch ((char)op->ix) { + case 'E': PUSH(DS,R->event); break; + } + break; + case ERR: + // install error handler TODO + break; + case EVENT: + // install event handler + //// [devid,evname] + //// [timeout,devid,evname] + // TODO prevent race-condition if event is triggered now (and RaiseEvent is called) + // [timeout?,evindex] + + // STACKUNDERFLOW(DS,2+(op->ax==-1?1:0),R); + STACKUNDERFLOW(DS,1+(op->ax==-1?1:0),R); + if (op->ax==-1) { + // in-line await event() delay + R->state &= ~PRUNNING; + R->state |= PTIMEOUT; + R->timeout = millis()+POP(DS); + } + if (op->ax<=0) { + // in-line await event delay? + R->state |= PINTERRUPT; + R->state |= PAWAIT; + op->ax=0; + } + //// device/channel id + // event index + ix=(index_t)POP(DS); + //// event name + // saddr=(address_t)POP(DS); + //if (op->ax>=0) ix=OnEvent (&M->data[saddr],ix,op->ax,C); + //else OffEvent (&M->data[saddr],ix,C); + + if (op->ax>=0) ix=OnEventIndex (ix,op->ax,C); + else ix=OffEventIndex (ix,C); + + if (ix<0) { + R->error=EEVENT; return 0; + }; + if (op->ax==0) R->state |= PAWAIT;// R->event=ix; else R->event=-1; + break; + + case EMIT: + // Send or emit event? + if (op->ix>0) RaiseEventIndex(op->ix-1); + else SendEventIndex(-op->ix-1); + break; + /* + IO operations (handled in io.c) + */ + case INARRAY: + case INNUMBER: + case INSTRING: + case OUTCHAR: + case OUTNUMBER: + case OUTSTRING: + status=RunIO(C,op); + // 1: success, -1:suspended/blocked (no data avail), 0: error + if (R->error || status==0) return 0; + if (status==-1 && (R->state&PHANDLER)){ + // not allowed; error + R->error=EWOULDBLOCK; + return 0; + } + if (status==-1) return -1; // suspended + break; + + default: + R->error=EOP; + return 0; + } + // Event handlers must be processed at once, no stepping allowed! + if (--steps && RUNNABLE(R)) goto loop_next_op; + return RUNNABLE(R)?1:-1; +} + + +void CodeCleanUp(context_t *C) { + ReleaseSegment(C->M,C->S); +} + +int Start(context_t *C) { + C->R->state=PRUNNING; + C->DS->sp=0; + C->FS->sp=0; +#if HAS_FUNC > 0 + C->R->fp=0; +#endif +}; + +int Stop(context_t *C) { + C->R->state=PIDLE; +}; + +int Suspend(context_t *C, index_t type, index_t io, index_t timeout) { + +};