void Std_Atan2(VM* vm) { double y = PopNumber(vm); double x = PopNumber(vm); PushNumber(vm, atan2(y, x)); }
void Std_GetByte(VM* vm) { ByteArray* ba = PopNative(vm); size_t i = (size_t)PopNumber(vm); PushNumber(vm, ba->bytes[i]); }
/* * Manual page at function.def */ INT16 CGEN_PROTECTED CFunction::OnType() { FNC_DELEGATE OnType(); const char* lpsTypecode = GetNextToken(TRUE); INT16 nTypecode = dlp_get_type_code(lpsTypecode); if (nTypecode<=0) return IERROR(this,FNC_INVALID,"elementary type name",lpsTypecode,0); PushNumber(CMPLX(nTypecode)); return O_K; }
void Std_Sqrt(VM* vm) { double num = PopNumber(vm); PushNumber(vm, sqrt(num)); }
void Std_Cos(VM* vm) { double num = PopNumber(vm); PushNumber(vm, cos(num)); }
void Std_Sin(VM* vm) { double num = PopNumber(vm); PushNumber(vm, sin(num)); }
void Std_Ceil(VM* vm) { double num = PopNumber(vm); PushNumber(vm, ceil(num)); }
/* STANDARD LIBRARY */ void Std_Floor(VM* vm) { double num = PopNumber(vm); PushNumber(vm, floor(num)); }
void lua_pushinteger (lua_State *L, lua_Integer n) { PushNumber( L, static_cast<lua_Number>(n) ); }
void Std_Clockspersec(VM* vm) { PushNumber(vm, (double)CLOCKS_PER_SEC); }
void Std_Clock(VM* vm) { clock_t start = clock(); PushNumber(vm, (double)start); }
void Std_Rand(VM* vm) { PushNumber(vm, (int)rand()); }
void Std_Getc(VM* vm) { FILE* file = PopNative(vm); PushNumber(vm, getc(file)); }
void Std_Tonumber(VM* vm) { const char* string = PopString(vm); PushNumber(vm, strtod(string, NULL)); }
void ExecuteCycle(VM* vm) { if(vm->pc == -1) return; if(vm->debug) printf("pc %i: ", vm->pc); if(vm->stackSize < vm->numGlobals) printf("Global(s) were removed from the stack!\n"); switch(vm->program[vm->pc]) { case OP_PUSH_NULL: { if(vm->debug) printf("push_null\n"); ++vm->pc; PushObject(vm, &NullObject); } break; case OP_PUSH_NUMBER: { if(vm->debug) printf("push_number\n"); ++vm->pc; int index = ReadInteger(vm); PushNumber(vm, vm->numberConstants[index]); } break; case OP_PUSH_STRING: { if(vm->debug) printf("push_string\n"); ++vm->pc; int index = ReadInteger(vm); PushString(vm, vm->stringConstants[index]); } break; case OP_PUSH_FUNC: { if(vm->debug) printf("push_func\n"); Word hasEllipsis = vm->program[++vm->pc]; Word isExtern = vm->program[++vm->pc]; Word numArgs = vm->program[++vm->pc]; ++vm->pc; int index = ReadInteger(vm); PushFunc(vm, index, hasEllipsis, isExtern, numArgs); } break; case OP_PUSH_DICT: { if(vm->debug) printf("push_dict\n"); ++vm->pc; PushDict(vm); } break; case OP_CREATE_DICT_BLOCK: { if(vm->debug) printf("create_dict_block\n"); ++vm->pc; int length = ReadInteger(vm); Object* obj = PushDict(vm); if(length > 0) { // stack (before dict) is filled with key-value pairs (backwards, key is higher on stack) for(int i = 0; i < length * 2; i += 2) DictPut(&obj->dict, vm->stack[vm->stackSize - i - 2]->string.raw, vm->stack[vm->stackSize - i - 3]); vm->stackSize -= length * 2; vm->stack[vm->stackSize - 1] = obj; } } break; case OP_CREATE_ARRAY: { if(vm->debug) printf("create_array\n"); ++vm->pc; int length = (int)PopNumber(vm); PushArray(vm, length); } break; case OP_CREATE_ARRAY_BLOCK: { if(vm->debug) printf("create_array_block\n"); ++vm->pc; int length = ReadInteger(vm); Object* obj = PushArray(vm, length); if(length > 0) { for(int i = 0; i < length; ++i) obj->array.members[length - i - 1] = vm->stack[vm->stackSize - 2 - i]; vm->stackSize -= length; vm->stack[vm->stackSize - 1] = obj; } } break; case OP_LENGTH: { if(vm->debug) printf("length\n"); ++vm->pc; Object* obj = PopObject(vm); if(obj->type == OBJ_STRING) PushNumber(vm, strlen(obj->string.raw)); else if(obj->type == OBJ_ARRAY) PushNumber(vm, obj->array.length); else { fprintf(stderr, "Attempted to get length of %s\n", ObjectTypeNames[obj->type]); exit(1); } } break; case OP_ARRAY_PUSH: { if(vm->debug) printf("array_push\n"); ++vm->pc; Object* obj = PopArrayObject(vm); Object* value = PopObject(vm); while(obj->array.length + 1 >= obj->array.capacity) { obj->array.capacity *= 2; obj->array.members = erealloc(obj->array.members, obj->array.capacity * sizeof(Object*)); } obj->array.members[obj->array.length++] = value; } break; case OP_ARRAY_POP: { if(vm->debug) printf("array_pop\n"); ++vm->pc; Object* obj = PopArrayObject(vm); if(obj->array.length <= 0) { fprintf(stderr, "Cannot pop from empty array\n"); exit(1); } PushObject(vm, obj->array.members[--obj->array.length]); } break; case OP_ARRAY_CLEAR: { if(vm->debug) printf("array_clear\n"); ++vm->pc; Object* obj = PopArrayObject(vm); obj->array.length = 0; } break; case OP_DICT_SET: { if(vm->debug) printf("dict_set\n"); ++vm->pc; Object* obj = PopDict(vm); const char* key = PopString(vm); Object* value = PopObject(vm); DictPut(&obj->dict, key, value); } break; case OP_DICT_GET: { if(vm->debug) printf("dict_get\n"); ++vm->pc; Object* obj = PopDict(vm); const char* key = PopString(vm); Object* value = DictGet(&obj->dict, key); if(value) PushObject(vm, value); else PushObject(vm, &NullObject); } break; case OP_DICT_PAIRS: { if(vm->debug) printf("dict_pairs\n"); ++vm->pc; Object* obj = PopDict(vm); Object* aobj = PushArray(vm, obj->dict.numEntries); int len = 0; for(int i = 0; i <= obj->dict.capacity; ++i) { DictNode* node = obj->dict.buckets[i]; while(node) { Object* pair = PushArray(vm, 2); Object* key = NewObject(vm, OBJ_STRING); key->string.raw = estrdup(node->key); pair->array.members[0] = key; pair->array.members[1] = node->value; aobj->array.members[len++] = PopObject(vm); node = node->next; } } } break; #define BIN_OP_TYPE(op, operator, type) case OP_##op: { if(vm->debug) printf("%s\n", #op); Object* val2 = PopObject(vm); Object* val1 = PopObject(vm); PushNumber(vm, (type)val1->number operator (type)val2->number); ++vm->pc; } break; #define BIN_OP(op, operator) BIN_OP_TYPE(op, operator, double) BIN_OP(ADD, +) BIN_OP(SUB, -) BIN_OP(MUL, *) BIN_OP(DIV, /) BIN_OP_TYPE(MOD, %, int) BIN_OP_TYPE(OR, |, int) BIN_OP_TYPE(AND, &, int) BIN_OP(LT, <) BIN_OP(LTE, <=) BIN_OP(GT, >) BIN_OP(GTE, >=) BIN_OP_TYPE(LOGICAL_AND, &&, int) BIN_OP_TYPE(LOGICAL_OR, ||, int) #define CBIN_OP(op, operator) case OP_##op: { ++vm->pc; if(vm->debug) printf("%s\n", #op); Object* b = PopObject(vm); Object* a = PopObject(vm); a->number operator b->number; } break; CBIN_OP(CADD, +=) CBIN_OP(CSUB, -=) CBIN_OP(CMUL, *=) CBIN_OP(CDIV, /=) case OP_EQU: { ++vm->pc; Object* o2 = PopObject(vm); Object* o1 = PopObject(vm); if(o1->type != o2->type) PushNumber(vm, 0); else { if(o1->type == OBJ_STRING) { PushNumber(vm, strcmp(o1->string.raw, o2->string.raw) == 0); } else if(o1->type == OBJ_NUMBER) { PushNumber(vm, o1->number == o2->number); } else PushNumber(vm, o1 == o2); } } break; case OP_NEQU: { ++vm->pc; Object* o2 = PopObject(vm); Object* o1 = PopObject(vm); if(o1->type != o2->type) PushNumber(vm, 1); else { if(o1->type == OBJ_STRING) { PushNumber(vm, strcmp(o1->string.raw, o2->string.raw) != 0); } else if(o1->type == OBJ_NUMBER) { PushNumber(vm, o1->number != o2->number); } else PushNumber(vm, o1 != o2); } } break; case OP_NEG: { if(vm->debug) printf("neg\n"); ++vm->pc; Object* obj = PopObject(vm); PushNumber(vm, -obj->number); } break; case OP_LOGICAL_NOT: { if(vm->debug) printf("not\n"); ++vm->pc; Object* obj = PopObject(vm); PushNumber(vm, !obj->number); } break; case OP_SETINDEX: { ++vm->pc; Object* obj = PopObject(vm); Object* indexObj = PopObject(vm); Object* value = PopObject(vm); if(vm->debug) printf("setindex\n"); if(obj->type == OBJ_ARRAY) { if(indexObj->type != OBJ_NUMBER) { fprintf(stderr, "Attempted to index array with a %s (expected number)\n", ObjectTypeNames[indexObj->type]); exit(1); } int index = (int)indexObj->number; int arrayLength = obj->array.length; Object** members = obj->array.members; if(index >= 0 && index < arrayLength) members[index] = value; else { fprintf(stderr, "Invalid array index %i\n", index); exit(1); } } else if(obj->type == OBJ_STRING) { if(indexObj->type != OBJ_NUMBER) { fprintf(stderr, "Attempted to index string with a %s (expected number)\n", ObjectTypeNames[indexObj->type]); exit(1); } if(value->type != OBJ_NUMBER) { fprintf(stderr, "Attempted to assign a %s to an index of a string '%s' (expected number/character)\n", ObjectTypeNames[value->type], obj->string.raw); exit(1); } obj->string.raw[(int)indexObj->number] = (char)value->number; } else if(obj->type == OBJ_DICT) { if(indexObj->type != OBJ_STRING) { fprintf(stderr, "Attempted to index dict with a %s (expected string)\n", ObjectTypeNames[indexObj->type]); exit(1); } DictPut(&obj->dict, indexObj->string.raw, value); } else { fprintf(stderr, "Attempted to index a %s\n", ObjectTypeNames[obj->type]); exit(1); } } break; case OP_GETINDEX: { ++vm->pc; Object* obj = PopObject(vm); Object* indexObj = PopObject(vm); if(obj->type == OBJ_ARRAY) { if(indexObj->type != OBJ_NUMBER) { fprintf(stderr, "Attempted to index array with a %s (expected number)\n", ObjectTypeNames[indexObj->type]); exit(1); } int index = (int)indexObj->number; int arrayLength = obj->array.length; Object** members = obj->array.members; if(index >= 0 && index < arrayLength) { if(members[index]) PushObject(vm, members[index]); else { fprintf(stderr, "attempted to index non-existent value in array\n"); exit(1); } if(vm->debug) printf("getindex %i\n", index); } else { fprintf(stderr, "Invalid array index %i\n", index); exit(1); } } else if(obj->type == OBJ_STRING) { if(indexObj->type != OBJ_NUMBER) { fprintf(stderr, "Attempted to index string with a %s (expected number)\n", ObjectTypeNames[indexObj->type]); exit(1); } PushNumber(vm, obj->string.raw[(int)indexObj->number]); } else if(obj->type == OBJ_DICT) { if(indexObj->type != OBJ_STRING) { fprintf(stderr, "Attempted to index dict with a %s (expected string)\n", ObjectTypeNames[indexObj->type]); exit(1); } Object* val = (Object*)DictGet(&obj->dict, indexObj->string.raw); if(val) PushObject(vm, val); else PushObject(vm, &NullObject); } else { fprintf(stderr, "Attempted to index a %s\n", ObjectTypeNames[obj->type]); exit(1); } } break; case OP_SET: { ++vm->pc; int index = ReadInteger(vm); Object* top = PopObject(vm); vm->stack[index] = top; if(vm->debug) { if(top->type == OBJ_NUMBER) printf("set %i to %g\n", index, top->number); else if(top->type == OBJ_STRING) printf("set %i to %s\n", index, top->string); } } break; case OP_GET: { ++vm->pc; int index = ReadInteger(vm); if(vm->stack[index]) PushObject(vm, (vm->stack[index])); else PushObject(vm, &NullObject); if(vm->debug) printf("get %i\n", index); } break; case OP_WRITE: { if(vm->debug) printf("write\n"); Object* top = PopObject(vm); WriteObject(vm, top); printf("\n"); ++vm->pc; } break; case OP_READ: { if(vm->debug) printf("read\n"); char* string = ReadStringFromStdin(); PushString(vm, string); free(string); ++vm->pc; } break; case OP_GOTO: { ++vm->pc; int pc = ReadInteger(vm); vm->pc = pc; if(vm->debug) printf("goto %i\n", vm->pc); } break; case OP_GOTOZ: { ++vm->pc; int pc = ReadInteger(vm); Object* top = PopObject(vm); if(top->number == 0) { vm->pc = pc; if(vm->debug) printf("gotoz %i\n", vm->pc); } } break; case OP_CALL: { Word nargs = vm->program[++vm->pc]; ++vm->pc; int index = ReadInteger(vm); if(vm->debug) printf("call %s\n", vm->functionNames[index]); PushIndir(vm, nargs); vm->pc = vm->functionPcs[index]; } break; case OP_CALLP: { Word hasEllipsis, isExtern, numArgs; Word nargs = vm->program[++vm->pc]; ++vm->pc; int id = PopFunc(vm, &hasEllipsis, &isExtern, &numArgs); if(vm->debug) printf("callp %s%s\n", isExtern ? "extern " : "", isExtern ? vm->externNames[id] : vm->functionNames[id]); if(isExtern) vm->externs[id](vm); else { if(!hasEllipsis) { if(nargs != numArgs) { fprintf(stderr, "Function '%s' expected %i args but recieved %i args\n", vm->functionNames[id], numArgs, nargs); exit(1); } } else { if(nargs < numArgs) { fprintf(stderr, "Function '%s' expected at least %i args but recieved %i args\n", vm->functionNames[id], numArgs, nargs); exit(1); } } if(!hasEllipsis) PushIndir(vm, nargs); else { // runtime collapsing of arguments: // the concrete arguments (known during compilation) are on the top of // the stack. We create an array (by pushing it and then decrementing the // stack pointer) and fill it up with the ellipsed arguments (behind the // concrete arguments). We then place this array just before the concrete // arguments in the stack so that it can be accessed as an argument "args". // The indirection info is pushed onto the indirection stack (the concrete and // non-concrete [aside from the one that the 'args' array replaces] are still // present on the stack, so all of the arguments are to be removed) /*printf("args:\n"); for(int i = 0; i < nargs; ++i) { WriteObject(vm, vm->stack[vm->stackSize - i - 1]); printf("\n"); } printf("end\n");*/ //printf("members:\n"); Object* obj = PushArray(vm, nargs - numArgs); vm->stackSize -= 1; for(int i = 0; i < obj->array.length; ++i) { obj->array.members[i] = vm->stack[vm->stackSize - numArgs - 1 - i]; /*WriteObject(vm, obj->array.members[i]); printf("\n");*/ } //printf("end\n"); vm->stack[vm->stackSize - numArgs - 1] = obj; /*printf("final args:\n"); for(int i = 0; i < numArgs + 1; ++i) { WriteObject(vm, vm->stack[vm->stackSize - i - 1]); printf("\n"); } printf("end\n");*/ PushIndir(vm, nargs); } vm->pc = vm->functionPcs[id]; } } break; case OP_RETURN: { if(vm->debug) printf("ret\n"); PopIndir(vm); } break; case OP_RETURN_VALUE: { if(vm->debug) printf("retval\n"); Object* returnValue = PopObject(vm); PopIndir(vm); PushObject(vm, returnValue); } break; case OP_CALLF: { ++vm->pc; int index = ReadInteger(vm); if(vm->debug) printf("callf %s\n", vm->externNames[index]); vm->externs[index](vm); } break; case OP_GETLOCAL: { ++vm->pc; int index = ReadInteger(vm); PushObject(vm, GetLocal(vm, index)); if(vm->debug) printf("getlocal %i (fp: %i, stack size: %i)\n", index, vm->fp, vm->stackSize); } break; case OP_SETLOCAL: { if(vm->debug) printf("setlocal\n"); ++vm->pc; int index = ReadInteger(vm); SetLocal(vm, index, PopObject(vm)); } break; case OP_HALT: { if(vm->debug) printf("halt\n"); vm->pc = -1; } break; default: printf("Invalid instruction %i\n", vm->program[vm->pc]); break; } }
/* * Manual page at function.def */ INT16 CGEN_PUBLIC CFunction::OnGet() { // Delegate to running function // ------------------------------------ FNC_DELEGATE OnGet(); // Use a weird macro (see function.def) // Initialize // ------------------------------------ CDlpObject* iCont = GetActiveInstance(); // Determine field container const char* lpsId = GetNextToken(TRUE); // Determine field name // Validate // ------------------------------------ DLPASSERT(iCont); // Check set target if (!dlp_strlen(lpsId)) // If no field name committed return IERROR(this,FNC_EXPECT,"field identifier after -get",0,0); // Error SWord* lpWrd = iCont->FindWord(lpsId,WL_TYPE_FIELD); // Find field in container if (!lpWrd) // If not found { // >> iCont = this; // Use this instance as container lpWrd = FindWord(lpsId,WL_TYPE_FIELD); // And seek again } // << if (!lpWrd) return IERROR(this,ERR_NOTFIELD,lpsId,0,0); // If still not found --> Error // Push field value // ------------------------------------ switch (lpWrd->ex.fld.nType) // Branch for field variable type { // >> case T_BOOL : { PushLogic ( *( BOOL*)lpWrd->lpData); break; }// - Boolean case T_UCHAR : { PushNumber (CMPLX(*( UINT8*)lpWrd->lpData)); break; }// - Unsigned character case T_CHAR : { PushNumber (CMPLX(*( INT8*)lpWrd->lpData)); break; }// - Signed character case T_USHORT : { PushNumber (CMPLX(*( UINT16*)lpWrd->lpData)); break; }// - Unsigned short integer case T_SHORT : { PushNumber (CMPLX(*( INT16*)lpWrd->lpData)); break; }// - Signed short integer case T_UINT : { PushNumber (CMPLX(*( UINT32*)lpWrd->lpData)); break; }// - Unsigned integer case T_INT : { PushNumber (CMPLX(*( INT32*)lpWrd->lpData)); break; }// - Signed integer case T_ULONG : { PushNumber (CMPLX(*( UINT64*)lpWrd->lpData)); break; }// - Unsigned long integer case T_LONG : { PushNumber (CMPLX(*( INT64*)lpWrd->lpData)); break; }// - Signed long integer case T_FLOAT : { PushNumber (CMPLX(*( FLOAT32*)lpWrd->lpData)); break; }// - Single precision floating point case T_DOUBLE : { PushNumber (CMPLX(*( FLOAT64*)lpWrd->lpData)); break; }// - Double precision floating point case T_COMPLEX : { PushNumber ( *(COMPLEX64*)lpWrd->lpData); break; }// - Double precision complex floating point case T_INSTANCE: { PushInstance(*(CDlpObject**) lpWrd->lpData); break; }// - Instance case T_TEXT : /* Fall through */ // - Text (deprecated type!) case T_CSTRING : /* Fall through */ // - Constant string case T_STRING : { PushString(*(char**) lpWrd->lpData); break; }// - String default : { // - Other types if (lpWrd->ex.fld.nType > 0 && lpWrd->ex.fld.nType <= 256) // Character array? PushString((char*)lpWrd->lpData); // Push value else // Type unknown! DLPASSERT(FMSG("Unknown field type")); // Error } // << } // << return O_K; // Done. }
void Std_BytesLength(VM* vm) { ByteArray* ba = PopNative(vm); PushNumber(vm, ba->length); }
void lua_pushnumber(lua_State *L, lua_Number n) { PushNumber(L, n); }