struct expr *prefix(char *expect)
{
struct expr *res = NULL;
int toktype = tok->type;
switch (toktype)
{
case IDENTIFIER:
return identexpr(strdup(tok->val));
case LPAREN:
res = expression(0);
eat(RPAREN);
return res;
case PLUS: case MINUS: case NOT:
return unopexpr(toktype, expression(lbp(toktype) - 1));
case REAL:
return expr_from_val(realval(atof(tok->val)));
case INT:
return expr_from_val(intval(atoi(tok->val)));
case CHAR:
return expr_from_val(charval(tok->val[1]));
case STRING:
return expr_from_val(strval(strdup(tok->val)));
case TRUE:
return expr_from_val(boolval(1));
case FALSE:
return expr_from_val(boolval(0));
case NULLKW:
return nullexpr();
default:
syntaxerror("expected %s, not %s", expect, tok->val);
return NULL;
}
}
OrFalse <string> f$tempnam (const string &dir, const string &prefix) {
string prefix_new = f$basename (prefix);
prefix_new.shrink (5);
if (prefix_new.empty()) {
prefix_new.assign ("tmp.", 4);
}
string dir_new;
OrFalse <string> dir_real;
if (dir.empty() || !f$boolval (dir_real = f$realpath (dir))) {
dl::enter_critical_section();//OK
const char *s = getenv ("TMPDIR");
dl::leave_critical_section();
if (s != NULL && s[0] != 0) {
int len = (int)strlen (s);
if (s[len - 1] == '/') {
len--;
}
dir_new.assign (s, len);
} else if (P_tmpdir != NULL) {
dir_new.assign (P_tmpdir, (dl::size_type)strlen (P_tmpdir));
}
if (dir_new.empty()) {
php_critical_error ("can't find directory for temporary file in function tempnam");
return false;
}
dir_real = f$realpath (dir_new);
if (!f$boolval (dir_real)) {
php_critical_error ("wrong directory \"%s\" found in function tempnam", dir_new.c_str());
return false;
}
}
dir_new = dir_real.val();
php_assert (!dir_new.empty());
if (dir_new[dir_new.size() - 1] != '/' && prefix_new[0] != '/') {
dir_new.append (1, '/');
}
dir_new.append (prefix_new);
dir_new.append (6, 'X');
dl::enter_critical_section();//OK
int fd = mkstemp (dir_new.buffer());
if (fd == -1 || close (fd)) {
dl::leave_critical_section();
php_warning ("Can't create temporary file \"%s\" in function tempnam", dir_new.c_str());
return false;
}
dl::leave_critical_section();
return dir_new;
}
int f$fseek (const MyFile &file, int offset, int whence) {
if (eq2 (file, STDOUT) || eq2 (file, STDERR)) {
php_warning ("Can't use fseek with STDERR and STDOUT\n");
return -1;
}
const static int whences[3] = {SEEK_SET, SEEK_END, SEEK_CUR};
if ((unsigned int)whence >= 3u) {
php_warning ("Wrong parameter whence in function fseek\n");
return -1;
}
whence = whences[whence];
OrFalse <string> filename_or_false = full_realpath (file.to_string());
if (!f$boolval (filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", file.to_string().c_str());
return -1;
}
string filename = filename_or_false.val();
if (dl::query_num == opened_files_last_query_num && opened_files->has_key (filename)) {
FILE *f = opened_files->get_value (filename);
dl::enter_critical_section();//OK
int res = fseek (f, (long)offset, whence);
dl::leave_critical_section();
return res;
} else {
php_warning ("File \"%s\" is not opened\n", filename.c_str());
return -1;
}
}
/*
* Evaluate the integer expression contained in the given token_fifo.
* Evaluation is made by precedence of operators, as described in the
* Dragon Book. The unary + and - are distinguished from their binary
* counterparts using the Fortran way: a + or a - is considered unary
* if it does not follow a constant, an identifier or a right parenthesis.
*/
unsigned long eval_expr(struct token_fifo *tf, int *ret, int ew)
{
size_t sart;
ppval r;
emit_eval_warnings = ew;
if (catch(eval_exception)) goto eval_err;
/* first, distinguish unary + and - from binary + and - */
for (sart = tf->art; tf->art < tf->nt; tf->art ++) {
if (tf->t[tf->art].type == PLUS) {
if (sart == tf->art || UNARY(tf->t[tf->art - 1].type))
tf->t[tf->art].type = UPLUS;
} else if (tf->t[tf->art].type == MINUS) {
if (sart == tf->art || UNARY(tf->t[tf->art - 1].type))
tf->t[tf->art].type = UMINUS;
}
}
tf->art = sart;
r = eval_shrd(tf, 0, 1);
if (tf->art < tf->nt) {
error(eval_line, "trailing garbage in constant integral "
"expression");
goto eval_err;
}
*ret = 0;
return boolval(r);
eval_err:
*ret = 1;
return 0;
}
nialptr
to_real(nialptr x)
{
nialptr z,
xi;
nialint i,
t = tally(x);
int v = valence(x);
double r = 0.0;
/* create the result container */
z = new_create_array(realtype, v, 0, shpptr(x, v));
for (i = 0; i < t; i++) {
int k;
xi = fetch_array(x, i);
k = kind(xi);
if (k == realtype)
r = *pfirstreal(xi);
else /* must be boolean or integer */
if (k == inttype)
r = 1.0 * intval(xi);
else
if (k == booltype)
r = 1.0 * boolval(xi);
store_real(z, i, r);
}
return (z);
}
OrFalse <int> f$fpassthru (const MyFile &file) {
if (eq2 (file, STDOUT) || eq2 (file, STDERR)) {
php_warning ("Can't use fpassthru with STDERR and STDOUT\n");
return false;
}
OrFalse <string> filename_or_false = full_realpath (file.to_string());
if (!f$boolval (filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", file.to_string().c_str());
return false;
}
string filename = filename_or_false.val();
if (dl::query_num == opened_files_last_query_num && opened_files->has_key (filename)) {
int result = 0;
FILE *f = opened_files->get_value (filename);
dl::enter_critical_section();//OK
while (!feof (f)) {
clearerr (f);
size_t res_size = fread (&php_buf[0], 1, PHP_BUF_LEN, f);
if (ferror (f)) {
dl::leave_critical_section();
php_warning ("Error happened during fpassthru from file \"%s\"", filename.c_str());
return false;
}
coub->append (php_buf, (dl::size_type)res_size);
result += (int)res_size;
}
dl::leave_critical_section();
return result;
} else {
php_warning ("File \"%s\" is not opened\n", filename.c_str());
return false;
}
}
struct val *parse_val(void)
{
next();
switch (tok->type)
{
case INT: return intval(atoi(tok->val));
case REAL: return realval(atof(tok->val));
case STRING: return strval(tok->val);
case TRUE: return boolval(true);
case FALSE: return boolval(false);
case CHAR: return charval(tok->val[1]);
default:
syntaxerror("expected a value, not %s", tok->val);
return intval(0);
}
}
OrFalse <int> f$fwrite (const MyFile &file, const string &text) {
if (eq2 (file, STDOUT)) {
*coub += text;
return (int)text.size();
}
int res = -1;
if (eq2 (file, STDERR)) {
dl::enter_critical_section();//OK
res = (int)fwrite (text.c_str(), text.size(), 1, stderr);
dl::leave_critical_section();
} else {
OrFalse <string> filename_or_false = full_realpath (file.to_string());
if (!f$boolval (filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", file.to_string().c_str());
return false;
}
string filename = filename_or_false.val();
if (dl::query_num == opened_files_last_query_num && opened_files->has_key (filename)) {
FILE *f = opened_files->get_value (filename);
dl::enter_critical_section();//OK
res = (int)fwrite (text.c_str(), text.size(), 1, f);
dl::leave_critical_section();
}
}
if (res < 0) {
return false;
}
return res;
}
void
iloaddefs(void)
{
nialptr nm,
x = apop();
int mode;
/* get the file name as a Nial array */
if (atomic(x) || kind(x) == chartype)
nm = x;
else if (kind(x) == atype)
nm = fetch_array(x, 0);
else {
buildfault("invalid file name");
freeup(x);
return;
}
mode = 0; /* default to silent mode */
if (kind(x) == atype && tally(x) == 2) {
/* argument has a mode filed, select it */
nialptr it = fetch_array(x, 1);
if (kind(it) == inttype)
mode = intval(it);
if (kind(it) == booltype)
mode = boolval(it);
}
/* try to put filename into gcharbuf */
if (!ngetname(nm, gcharbuf)) {
buildfault("invalid file name");
freeup(x);
}
else
{ /* check the extension as .ndf */
check_ext(gcharbuf, ".ndf",NOFORCE_EXTENSION);
freeup(x); /* do freeup here so file name doesn't show in iusedspace */
/* load the definition file */
if (loaddefs(true, gcharbuf, mode)) {
apush(Nullexpr);
}
else
buildfault(errmsgptr); /* this is safe since call is from iloaddefs */
}
#ifdef DEBUG
memchk();
#endif
}
void
isetprofile()
{
nialptr z;
int tv,
oldprofile = profile; /* old value of profiling switch */
z = apop();
if (kind(z) == inttype)
tv = intval(z);
else if (kind(z) == booltype)
tv = boolval(z);
else {
buildfault("invalid arg to setprofile");
return;
}
if (tv && !oldprofile) { /* turning on profiling */
profile = true;
if (newprofile) {
inittime();
calltree = make_node();
current_node = calltree;
/* initialize first node */
set_opid(calltree, 0); /* doesn't correspond to a defn */
set_start_time(calltree, profile_time());
/*
nprintf(OF_DEBUG,"start time for call tree%f\n",calltree->start_time);
*/
swplace = 0;
#ifdef OLD_BUILD_SYMBOL_TABLE
build_symbol_table();
#endif
newprofile = false;
}
}
else if (oldprofile != false) {
double lasttime = profile_time();
profile = false;
if (current_node != calltree) {
exit_cover(NC_PROFILE_SYNCH_W);
}
set_end_time(calltree, lasttime);
add_time(calltree);
}
apush(createbool(oldprofile));
}
void
isetdebugmessages(void)
{
nialptr x = apop();
int oldstatus = debug_messages_on;
if (atomic(x) && kind(x) == booltype)
debug_messages_on = boolval(x);
else if (atomic(x) && kind(x) == inttype)
debug_messages_on = intval(x);
else {
apush(makefault("?setdebugmessages expects a truth-value"));
freeup(x);
return;
}
apush(createbool(oldstatus));
}
nialptr
testbinfaults(nialptr x, nialptr stdfault, int divflag)
{
nialptr x0 = fetch_array(x, 0),
x1 = fetch_array(x, 1);
switch (kind(x0)) {
case booltype:
case inttype:
case realtype:
freeup(stdfault);
return (x1);
case chartype:
case phrasetype: /* fall out to return stdfault */
break;
case faulttype:
switch (kind(x1)) {
case booltype:
if (divflag && boolval(x1) == 0)
break;
freeup(stdfault);
return (x0);
case inttype:
if (divflag && intval(x1) == 0)
break;
freeup(stdfault);
return (x0);
case realtype:
if (divflag && realval(x1) == 0.0)
break;
freeup(stdfault);
return (x0);
case chartype:
case phrasetype:
break;
case faulttype:
if (x0 == x1) {
freeup(stdfault);
return (x0);
}
break;
}
}
return (stdfault);
}
void
isetinterrupts()
{
nialptr x;
int oldstatus;
oldstatus = nouserinterrupts;
x = apop();
if (atomic(x) && kind(x) == booltype) {
nouserinterrupts = !boolval(x);
apush(createbool(!oldstatus));
}
else if (atomic(x) && kind(x) == inttype) {
nouserinterrupts = (intval(x) != 1);
apush(createbool(!oldstatus));
}
else
buildfault("setinterrupts expects a boolean");
}
bool f$fclose (const MyFile &file) {
if (eq2 (file, STDOUT) || eq2 (file, STDERR)) {
return true;
}
OrFalse <string> filename_or_false = full_realpath (file.to_string());
if (!f$boolval (filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", file.to_string().c_str());
return false;
}
string filename = filename_or_false.val();
if (dl::query_num == opened_files_last_query_num && opened_files->has_key (filename)) {
dl::enter_critical_section();//NOT OK: opened_files
fclose (opened_files->get_value (filename));
opened_files->unset (filename);
dl::leave_critical_section();
return true;
}
return false;
}
static nialptr
to_int(nialptr x)
{
nialptr z,
xi;
nialint i,
t = tally(x);
int v = valence(x);
/* create the result container */
z = new_create_array(inttype, v, 0, shpptr(x, v));
for (i = 0; i < t; i++) {
xi = fetch_array(x, i);
if (kind(xi) == inttype) {
copy1(z, i, xi, 0);
}
else /* type must be boolean */
store_int(z, i, boolval(xi));
}
return (z);
}
OrFalse <int> f$ftell (const MyFile &file) {
if (eq2 (file, STDOUT) || eq2 (file, STDERR)) {
php_warning ("Can't use ftell with STDERR and STDOUT\n");
return false;
}
OrFalse <string> filename_or_false = full_realpath (file.to_string());
if (!f$boolval (filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", file.to_string().c_str());
return false;
}
string filename = filename_or_false.val();
if (dl::query_num == opened_files_last_query_num && opened_files->has_key (filename)) {
FILE *f = opened_files->get_value (filename);
dl::enter_critical_section();//OK
int result = (int)ftell (f);
dl::leave_critical_section();
return result;
} else {
php_warning ("File \"%s\" is not opened\n", filename.c_str());
return false;
}
}
MyFile f$fopen (const string &filename, const string &mode) {
if (dl::query_num != opened_files_last_query_num) {
new (opened_files_storage) array <FILE *>();
opened_files->set_value (STDOUT, stdout);
opened_files->set_value (STDERR, stderr);
opened_files_last_query_num = dl::query_num;
}
if (eq2 (filename, STDOUT) || eq2 (filename, STDOUT)) {
php_warning ("Can't open STDERR or STDOUT");
return false;
}
OrFalse <string> real_filename_or_false = full_realpath (filename);
if (!f$boolval (real_filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", filename.c_str());
return false;
}
string real_filename = real_filename_or_false.val();
if (opened_files->has_key (real_filename)) {
php_warning ("File \"%s\" already opened. Closing previous one.", real_filename.c_str());
f$fclose (MyFile (real_filename));
}
dl::enter_critical_section();//NOT OK: opened_files
FILE *file = fopen (real_filename.c_str(), mode.c_str());
if (file != NULL) {
opened_files->set_value (real_filename, file);
dl::leave_critical_section();
return MyFile (real_filename);
} else {
dl::leave_critical_section();
return MyFile (false);
}
}
OrFalse <string> f$fread (const MyFile &file, int length) {
if (eq2 (file, STDOUT) || eq2 (file, STDERR)) {
php_warning ("Can't use fread with STDERR and STDOUT\n");
return false;
}
if (length <= 0) {
php_warning ("Parameter length in function fread must be positive\n");
return false;
}
OrFalse <string> filename_or_false = full_realpath (file.to_string());
if (!f$boolval (filename_or_false)) {
php_warning ("Wrong file \"%s\" specified", file.to_string().c_str());
return false;
}
string filename = filename_or_false.val();
string res (length, false);
if (dl::query_num == opened_files_last_query_num && opened_files->has_key (filename)) {
FILE *f = opened_files->get_value (filename);
dl::enter_critical_section();//OK
clearerr (f);
size_t res_size = fread (&res[0], 1, length, f);
if (ferror (f)) {
dl::leave_critical_section();
php_warning ("Error happened during fread from file \"%s\"", filename.c_str());
return false;
}
dl::leave_critical_section();
res.shrink ((dl::size_type)res_size);
return res;
} else {
php_warning ("File \"%s\" is not opened\n", filename.c_str());
return false;
}
}
ERROR recursive_interpret(FUNCTION_PTR function, STACK_PTR stack)
{
// fprintf(stderr,"Zavolana funkce: %d\n",function);
LIST_NODE_PTR instr_node = function->instructions.begin;
ERROR err = E_OK;
// ----- Priprava promenych ------
INSTRUCTION_PTR instruction = NULL;
int str_from,str_to,tmp_count;
STRING tmp_string;
STACK_PTR tmp_stack;
tmp_stack = gcMalloc(sizeof(struct STACK));
stackInit(tmp_stack);
// NULL SYMBOL
ITEMPTR null_item;
null_item = gcMalloc(sizeof(struct ITEM));
null_item->type = TYPE_NULL;
SYMBOL* null_symbol;
null_symbol = gcMalloc(sizeof(struct SYMBOL));
null_symbol->type = TYPE_NULL;
null_symbol->items = null_item;
// TMP SYMBOL
ITEMPTR tmp_item;
SYMBOL* tmp_symbol;
SYMBOL* op1 = NULL;
SYMBOL* op2 = NULL;
SYMBOL* op3 = NULL;
FUNCTION_PTR tmp_function = NULL;
while(instr_node != NULL && err == E_OK)
{
instruction = instr_node->value;
tmp_item = gcMalloc(sizeof(struct ITEM));
tmp_symbol = gcMalloc(sizeof(struct SYMBOL));
tmp_symbol->items = tmp_item;
op1 = (SYMBOL*) instruction->operand1;
op2 = (SYMBOL*) instruction->operand2;
op3 = (SYMBOL*) instruction->destionation;
fprintf(stderr,"while interpret : %d (%s)\n",instruction->type, debugInstruction(instruction->type));
switch(instruction->type)
{
case INSTRUCTION_NOP:
break;
case INSTRUCTION_MOV:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
data_copy(op2, op1);
op1->filgy = true;
break;
case INSTRUCTION_LOAD_NULL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'O')) != E_OK)
return err;
if ((err = op_check(op3,'O')) != E_OK)
return err;
data_copy(null_symbol,op1);
data_copy(null_symbol,op2);
data_copy(null_symbol,op3);
op1->filgy = true;
op2->filgy = true;
op3->filgy = true;
break;
case INSTRUCTION_ADDITION:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->type = TYPE_DIGIT_INT;
tmp_symbol->items->value.valInt = op2->items->value.valInt + op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valInt + op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble + op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble + op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->type = TYPE_STRING;
strConcatenate(&tmp_symbol->items->value.valString, &op2->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op3->items->value.valString);
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_DIGIT_INT)
{
STRING new_string;
char* new_char_string = gcMalloc(sizeof(char*));;
sprintf(new_char_string, "%d", op3->items->value.valInt);
strInitRaw(&new_string, new_char_string);
tmp_symbol->items->type = TYPE_STRING;
strConcatenate(&tmp_symbol->items->value.valString, &op2->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op3->items->value.valString);
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_DIGIT_DOUBLE)
{
STRING new_string;
char* new_char_string = gcMalloc(sizeof(char*));
sprintf(new_char_string, "%lf", op3->items->value.valDouble);
strInitRaw(&new_string, new_char_string);
tmp_symbol->items->type = TYPE_STRING;
strConcatenate(&tmp_symbol->items->value.valString, &op2->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op3->items->value.valString);
data_copy(tmp_symbol,op1); // from, to
}
else
return E_SEMANTIC_TYPE_MISMATCH;
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_SUBSTRACTION:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->type = TYPE_DIGIT_INT;
tmp_symbol->items->value.valInt = op2->items->value.valInt - op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valInt - op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble - op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble - op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else
return E_SEMANTIC_TYPE_MISMATCH;
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_MULTIPLICATION:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->type = TYPE_DIGIT_INT;
tmp_symbol->items->value.valInt = op2->items->value.valInt * op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = ((double)op2->items->value.valInt) * op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble * ((double)op3->items->value.valInt);
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble * op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else
return E_SEMANTIC_TYPE_MISMATCH;
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_DIVISION:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
if(op3->items->value.valInt == 0)
return E_SEMANTIC_ZERO_DIV;
tmp_symbol->items->type = TYPE_DIGIT_INT;
tmp_symbol->items->value.valInt = op2->items->value.valInt / op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_DOUBLE)
{
if(op3->items->value.valDouble == 0.0)
return E_SEMANTIC_ZERO_DIV;
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valInt / op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_INT)
{
if(op3->items->value.valInt == 0)
return E_SEMANTIC_ZERO_DIV;
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble / op3->items->value.valInt;
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
if(op3->items->value.valDouble == 0.0)
return E_SEMANTIC_ZERO_DIV;
tmp_symbol->items->type = TYPE_DIGIT_DOUBLE;
tmp_symbol->items->value.valDouble = op2->items->value.valDouble / op3->items->value.valDouble;
data_copy(tmp_symbol,op1); // from, to
}
else
return E_SEMANTIC_TYPE_MISMATCH;
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_LESS:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_BOOL;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->value.valBool = op2->items->value.valInt < op3->items->value.valInt;
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->value.valBool = op2->items->value.valDouble < op3->items->value.valDouble;
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->value.valBool = op2->items->value.valString.used < op3->items->value.valString.used;
}
else
return E_SEMANTIC_TYPE_MISMATCH;
data_copy(tmp_symbol,op1);
tmp_symbol = NULL;
break;
case INSTRUCTION_GREATER:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_BOOL;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->value.valBool = op2->items->value.valInt > op3->items->value.valInt;
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->value.valBool = op2->items->value.valDouble > op3->items->value.valDouble;
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->value.valBool = op2->items->value.valString.used > op3->items->value.valString.used;
}
else
return E_SEMANTIC_TYPE_MISMATCH;
data_copy(tmp_symbol,op1);
tmp_symbol = NULL;
break;
case INSTRUCTION_LESS_EQUAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_BOOL;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->value.valBool = op2->items->value.valInt <= op3->items->value.valInt;
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->value.valBool = op2->items->value.valDouble <= op3->items->value.valDouble;
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->value.valBool = op2->items->value.valString.used <= op3->items->value.valString.used;
}
else
return E_SEMANTIC_TYPE_MISMATCH;
data_copy(tmp_symbol,op1);
tmp_symbol = NULL;
break;
case INSTRUCTION_GREATER_EQUAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_BOOL;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->value.valBool = op2->items->value.valInt >= op3->items->value.valInt;
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->value.valBool = op2->items->value.valDouble >= op3->items->value.valDouble;
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->value.valBool = op2->items->value.valString.used >= op3->items->value.valString.used;
}
else
return E_SEMANTIC_TYPE_MISMATCH;
data_copy(tmp_symbol,op1);
tmp_symbol = NULL;
break;
case INSTRUCTION_EQUAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_BOOL;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->value.valBool = op2->items->value.valInt == op3->items->value.valInt;
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->value.valBool = op2->items->value.valDouble == op3->items->value.valDouble;
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->value.valBool = op2->items->value.valString.used == op3->items->value.valString.used;
}
else
tmp_symbol->items->value.valBool = false;
data_copy(tmp_symbol,op1);
tmp_symbol = NULL;
break;
case INSTRUCTION_NOT_EQUAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_BOOL;
if(op2->items->type == TYPE_DIGIT_INT && op3->items->type == TYPE_DIGIT_INT)
{
tmp_symbol->items->value.valBool = op2->items->value.valInt != op3->items->value.valInt;
}
else if(op2->items->type == TYPE_DIGIT_DOUBLE && op3->items->type == TYPE_DIGIT_DOUBLE)
{
tmp_symbol->items->value.valBool = op2->items->value.valDouble != op3->items->value.valDouble;
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->value.valBool = op2->items->value.valString.used != op3->items->value.valString.used;
if(!tmp_symbol->items->value.valBool)
{
tmp_symbol->items->value.valBool = !strCompare(op2->items->value.valString, op3->items->value.valString.data);
}
}
else
tmp_symbol->items->value.valBool = false;
data_copy(tmp_symbol,op1);
tmp_symbol = NULL;
break;
case INSTRUCTION_PUSH:
// printf("ahoj %d\n",op1->filgy);
if ((err = op_check(op1,'I')) != E_OK)
return err;
stackPush(stack,op1);
break;
case INSTRUCTION_POP:
if ((err = op_check(op1,'O')) != E_OK)
return err;
tmp_symbol = stackPop(stack);
if(tmp_symbol == NULL){
tmp_symbol = gcMalloc(sizeof(SYMBOL));
tmp_symbol->items = gcMalloc(sizeof(ITEM));
tmp_symbol->items->type = TYPE_NULL;
tmp_symbol->filgy = true;
}
data_copy(tmp_symbol,op1);
op1->filgy = true;
break;
case INSTRUCTION_CALL:
if(op1 == NULL)
return E_COMPILATOR;
tmp_function = function;
function = (FUNCTION_PTR)op1;
err=recursive_interpret(function,stack);
if (err != E_OK)
return err;
function = tmp_function;
break;
case INSTRUCTION_RETURN:
return err;
break;
case INSTRUCTION_JUMP:
if(op3 == NULL)
return E_COMPILATOR;
instr_node = function->instructions.begin;
while(instr_node != (LIST_NODE_PTR)op3)
{
if(instr_node->next == NULL)
{
fprintf(stderr,"NENALEZENO!!!\n");
fprintf(stderr,"NENALEZENO!!!\n");
fprintf(stderr,"NENALEZENO!!!\n");
break;
}
instr_node = instr_node->next;
}
continue;
break;
case INSTRUCTION_IF_JUMP:
// if ((err = op_check(op2,'I')) != E_OK)
// return err;
if(op3 == NULL)
return E_COMPILATOR;
if(op2->items->type == TYPE_BOOL)
{
if(!op2->items->value.valBool)
{
instr_node = function->instructions.begin;
while(instr_node != (LIST_NODE_PTR)op3)
{
if(instr_node->next == NULL)
break;
instr_node = instr_node->next;
}
continue;
}
}
// if(op2->items->type == TYPE_DIGIT_INT)
// {
// printf("AHOJ\n");
// if(!op2->items->value.valInt)
// {
// instr_node = function->instructions.begin;
// while(instr_node != (LIST_NODE_PTR)op3)
// {
// if(instr_node->next == NULL)
// break;
// instr_node = instr_node->next;
// }
// continue;
// }
// }
break;
case INSTRUCTION_LABEL:
break;
case INSTRUCTION_BOOLVAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
tmp_symbol = stackPop(stack);
tmp_symbol->items = boolval(*tmp_symbol->items);
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_DOUBLEVAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
tmp_symbol = stackPop(stack);
tmp_symbol->items = doubleval(*tmp_symbol->items);
if(tmp_symbol->items == NULL)
return E_SEMANTIC_DOUBLEVAL;
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_INTVAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
op1 = stackPop(stack);
if ((err = op_check(op1,'I')) != E_OK)
return err;
tmp_symbol->items = intval(*op1->items);
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_STRVAL:
if ((err = op_check(op1,'O')) != E_OK)
return err;
tmp_symbol = stackPop(stack);
tmp_symbol->items = strval(*tmp_symbol->items);
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_GET_STRING:
if ((err = op_check(op1,'O')) != E_OK)
return err;
tmp_string = get_string();
tmp_symbol->items->type = TYPE_STRING;
strInit(&tmp_symbol->items->value.valString);
strCopy(&tmp_string, &tmp_symbol->items->value.valString);
data_copy(tmp_symbol, op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_CONCATE:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if ((err = op_check(op2,'I')) != E_OK)
return err;
if ((err = op_check(op3,'I')) != E_OK)
return err;
if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_STRING)
{
tmp_symbol->items->type = TYPE_STRING;
strInit(&tmp_symbol->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op2->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op3->items->value.valString);
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_DIGIT_INT)
{
STRING new_string;
char* new_char_string = gcMalloc(sizeof(char*));
sprintf(new_char_string, "%d", op3->items->value.valInt);
strInitRaw(&new_string, new_char_string);
tmp_symbol->items->type = TYPE_STRING;
strConcatenate(&tmp_symbol->items->value.valString, &op2->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op3->items->value.valString);
data_copy(tmp_symbol,op1); // from, to
}
else if(op2->items->type == TYPE_STRING && op3->items->type == TYPE_DIGIT_DOUBLE)
{
STRING new_string;
char* new_char_string = gcMalloc(sizeof(char*));
sprintf(new_char_string, "%lf", op3->items->value.valDouble);
strInitRaw(&new_string, new_char_string);
tmp_symbol->items->type = TYPE_STRING;
strConcatenate(&tmp_symbol->items->value.valString, &op2->items->value.valString);
strConcatenate(&tmp_symbol->items->value.valString, &op3->items->value.valString);
data_copy(tmp_symbol,op1); // from, to
}
else
return E_SEMANTIC_TYPE_MISMATCH;
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_PUT_STRING:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if (op2 == NULL)
return E_COMPILATOR;
// DODELAT VRACENI POCTU VYPSANYCH! DO OP1
tmp_count = *((int*)op2);
for(int i=0;i<tmp_count;i++)
{
tmp_symbol = stackPop(stack);
if ((err = op_check(tmp_symbol,'I')) != E_OK)
return err;
stackPush(tmp_stack,tmp_symbol);
}
for(int i=0;i<tmp_count;i++)
{
tmp_symbol = stackPop(tmp_stack);
if(tmp_symbol->items->type == 2)
printf("%d",tmp_symbol->items->value.valInt);
else if(tmp_symbol->items->type == 3)
printf("%lf",tmp_symbol->items->value.valDouble);
else if(tmp_symbol->items->type == 4)
printf("%s",tmp_symbol->items->value.valString.data);
}
tmp_symbol = NULL;
break;
case INSTRUCTION_STRLEN:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if (op2 == NULL)
return E_COMPILATOR;
tmp_count = *((int*)op2);
if (tmp_count != 1)
return E_COMPILATOR;
op1 = stackPop(stack);
if ((err = op_check(op1,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_DIGIT_INT;
tmp_symbol->items->value.valInt = my_strlen(op1->items->value.valString);
data_copy(tmp_symbol, op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_GET_SUBSTRING:
if ((err = op_check(op1,'O')) != E_OK)
return err;
if (op2 == NULL)
return E_COMPILATOR;
tmp_count = *((int*)op2);
if (tmp_count != 3)
return E_COMPILATOR;
// TO
tmp_symbol = stackPop(stack);
if ((err = op_check(tmp_symbol,'I')) != E_OK)
return err;
str_to = tmp_symbol->items->value.valInt;
// FROM
tmp_symbol = stackPop(stack);
if ((err = op_check(tmp_symbol,'I')) != E_OK)
return err;
str_from = tmp_symbol->items->value.valInt;
// STRING
tmp_symbol = stackPop(stack);
if ((err = op_check(tmp_symbol,'I')) != E_OK)
return err;
tmp_string = get_substring(tmp_symbol->items->value.valString,str_from,str_to,&err);
if(err != E_OK)
return err;
tmp_symbol->items->type = TYPE_STRING;
strCopy(&tmp_symbol->items->value.valString,&tmp_string);
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_FIND_STRING:
if ((err = op_check(op1,'O')) != E_OK)
return err;
op2 = stackPop(stack);
if ((err = op_check(op2,'I')) != E_OK)
return err;
op3 = stackPop(stack);
if ((err = op_check(op1,'I')) != E_OK)
return err;
tmp_symbol->items->type = TYPE_DIGIT_INT;
tmp_symbol->items->value.valInt = find_string(op3->items->value.valString, op2->items->value.valString);
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
case INSTRUCTION_SORT_STRING:
if ((err = op_check(op1,'O')) != E_OK)
return err;
tmp_symbol = stackPop(stack);
if ((err = op_check(tmp_symbol,'I')) != E_OK)
return err;
sort_string(tmp_symbol->items->value.valString);
data_copy(tmp_symbol,op1);
op1->filgy = true;
tmp_symbol = NULL;
break;
default:
return E_OK;
break;
}
instr_node = instr_node->next;
}
return err;
}
/*
* Perform the hard work of evaluation.
*
* This function works because:
* -- all unary operators are right to left associative, and with
* identical precedence
* -- all binary operators are left to right associative
* -- there is only one non-unary and non-binary operator: the quest-colon
*
* If do_eval is 0, the evaluation of operators is not done. This is
* for sequence point operators (&&, || and ?:).
*/
static ppval eval_shrd(struct token_fifo *tf, int minprec, int do_eval)
{
ppval top;
struct ucpp_token *ct;
top.sign = 1;
if (tf->art == tf->nt) goto trunc_err;
ct = tf->t + (tf->art ++);
if (ct->type == LPAR) {
top = eval_shrd(tf, 0, do_eval);
if (tf->art == tf->nt) goto trunc_err;
ct = tf->t + (tf->art ++);
if (ct->type != RPAR) {
error(eval_line, "a right parenthesis was expected");
throw(eval_exception);
}
} else if (ct->type == NUMBER || ct->type == CHAR) {
top = pp_strtoconst(ct->name);
} else if (OP_UN(ct->type)) {
top = eval_opun(ct->type, eval_shrd(tf,
op_prec(ct->type), do_eval));
goto eval_loop;
} else if (ttOP(ct->type)) goto rogue_op_err;
else {
goto invalid_token_err;
}
eval_loop:
if (tf->art == tf->nt) {
return top;
}
ct = tf->t + (tf->art ++);
if (OP_BIN(ct->type)) {
int bp = op_prec(ct->type);
if (bp > minprec) {
ppval tr;
if ((ct->type == LOR && boolval(top))
|| (ct->type == LAND && !boolval(top))) {
tr = eval_shrd(tf, bp, 0);
if (do_eval) {
top.sign = 1;
if (ct->type == LOR)
top.u.sv = big_s_fromint(1);
if (ct->type == LAND)
top.u.sv = big_s_fromint(0);
}
} else {
tr = eval_shrd(tf, bp, do_eval);
if (do_eval)
top = eval_opbin(ct->type, top, tr);
}
goto eval_loop;
}
} else if (ct->type == QUEST) {
int bp = op_prec(QUEST);
ppval r1, r2;
if (bp >= minprec) {
int qv = boolval(top);
r1 = eval_shrd(tf, bp, qv ? do_eval : 0);
if (tf->art == tf->nt) goto trunc_err;
ct = tf->t + (tf->art ++);
if (ct->type != COLON) {
error(eval_line, "a colon was expected");
throw(eval_exception);
}
r2 = eval_shrd(tf, bp, qv ? 0 : do_eval);
if (do_eval) {
if (qv) top = r1; else top = r2;
}
goto eval_loop;
}
}
tf->art --;
return top;
trunc_err:
error(eval_line, "truncated constant integral expression");
throw(eval_exception);
rogue_op_err:
error(eval_line, "rogue operator '%s' in constant integral "
"expression", operators_name[ct->type]);
throw(eval_exception);
invalid_token_err:
error(eval_line, "invalid token in constant integral expression");
throw(eval_exception);
}
