mpsl_c.c

   1 /*
   2
   3     MPSL - Minimum Profit Scripting Language
   4     Copyright (C) 2003/2007 Angel Ortega <angel@triptico.com>
   5
   6     mpsl_c.c - Minimum Profit Scripting Language Core
   7
   8     This program is free software; you can redistribute it and/or
   9     modify it under the terms of the GNU General Public License
  10     as published by the Free Software Foundation; either version 2
  11     of the License, or (at your option) any later version.
  12
  13     This program is distributed in the hope that it will be useful,
  14     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16     GNU General Public License for more details.
  17
  18     You should have received a copy of the GNU General Public License
  19     along with this program; if not, write to the Free Software
  20     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21
  22     http://www.triptico.com
  23
  24 */
  25
  26 #include "config.h"
  27
  28 #include <stdio.h>
  29 #include <wchar.h>
  30 #include "mpdm.h"
  31 #include "mpsl.h"
  32
  33 /*******************
  34         Data
  35 ********************/
  36
  37 /* instruction execution tracing flag */
  38 int mpsl_trace = 0;
  39
  40 /* global abort flag */
  41 int mpsl_abort = 0;
  42
  43 /* temporary storage for the local symbol table */
  44 static mpdm_t local_symbol_table = NULL;
  45
  46 /* temporary storage for the opcode table
  47    (only usable while compiling) */
  48 mpdm_t mpsl_opcodes = NULL;
  49
  50 /* flag to control calls to mpdm_sweep() from inside mpsl_exec_i() */
  51 static int sweep_on_exec_i = 1;
  52
  53 /*******************
  54         Code
  55 ********************/
  56
  57 /**
  58  * mpsl_is_true - Tests if a value is true.
  59  * @v: the value
  60  *
  61  * If @v is a valid MPSL 'false' value (NULL, "" or the "0" string),
  62  * returns zero, or nonzero otherwise.
  63  */
  64 int mpsl_is_true(mpdm_t v)
  65 {
  66         /* if value is NULL, it's false */
  67         if (v == NULL)
  68                 return 0;
  69
  70         /* if it's a printable string... */
  71         if (v->flags & MPDM_STRING) {
  72                 wchar_t * ptr = (wchar_t *)v->data;
  73
  74                 /* ... and it's "" or the "0" string, it's false */
  75                 if(*ptr == L'\0' || (*ptr == L'0' && *(ptr + 1) == L'\0'))
  76                         return 0;
  77         }
  78
  79         /* any other case is true */
  80         return 1;
  81 }
  82
  83
  84 /**
  85  * mpsl_boolean - Returns 'true' or 'false' MPSL stock values.
  86  * @b: boolean selector
  87  *
  88  * Returns MPSL's 'false' or 'true' values depending on the value in @b.
  89  */
  90 mpdm_t mpsl_boolean(int b)
  91 {
  92         return b ? mpdm_hget_s(mpdm_root(), L"TRUE") : NULL;
  93 }
  94
  95
  96 static mpdm_t find_local_symbol_table(mpdm_t s, mpdm_t l)
  97 /* finds the local symbol table hash that holds l */
  98 {
  99         int n;
 100         mpdm_t v = NULL;
 101
 102         /* no local symbol table? nothing to find */
 103         if(l == NULL)
 104                 return NULL;
 105
 106         /* if s is multiple, take just the first element */
 107         if(MPDM_IS_ARRAY(s))
 108                 s = mpdm_aget(s, 0);
 109
 110         /* travel the local symbol table trying to find it */
 111         for (n = mpdm_size(l) - 1; n >= 0; n--) {
 112                 mpdm_t h = mpdm_aget(l, n);
 113
 114                 if (mpdm_exists(h, s)) {
 115                         v = h;
 116                         break;
 117                 }
 118         }
 119
 120         return v;
 121 }
 122
 123
 124 static void set_local_symbols(mpdm_t s, mpdm_t v, mpdm_t l)
 125 /* sets (or creates) a list of local symbols with a list of values */
 126 {
 127         mpdm_t h;
 128
 129         if (s == NULL || l == NULL)
 130                 return;
 131
 132         /* gets the top local variable frame */
 133         h = mpdm_aget(l, -1);
 134
 135         if (MPDM_IS_ARRAY(s)) {
 136                 int n;
 137
 138                 for (n = 0; n < mpdm_size(s); n++)
 139                         mpdm_hset(h, mpdm_aget(s, n), mpdm_aget(v, n));
 140         }
 141         else
 142                 mpdm_hset(h, s, v);
 143 }
 144
 145
 146 static mpdm_t get_symbol(mpdm_t s, mpdm_t l)
 147 /* gets a symbol from a local symbol table, or the global */
 148 {
 149         return mpdm_sget(find_local_symbol_table(s, l), s);
 150 }
 151
 152
 153 static mpdm_t set_symbol(mpdm_t s, mpdm_t v, mpdm_t l)
 154 /* sets a symbol in a local symbol table, or the global */
 155 {
 156         mpdm_sset(find_local_symbol_table(s, l), s, v);
 157         return v;
 158 }
 159
 160
 161 /**
 162  * mpsl_set_symbol - Sets value to a symbol.
 163  * @s: symbol name
 164  * @v: value
 165  *
 166  * Assigns the value @v to the @s symbol. If the value exists as
 167  * a local symbol, it's assigned to it; otherwise, it's set as a global
 168  * symbol (and created if it does not exist).
 169  *
 170  * This function is only meant to be executed from inside an MPSL
 171  * program; from outside, it's exactly the same as calling mpdm_sset()
 172  * (as the local symbol table won't exist).
 173  */
 174 mpdm_t mpsl_set_symbol(mpdm_t s, mpdm_t v)
 175 {
 176         return set_symbol(s, v, local_symbol_table);
 177 }
 178
 179
 180 /**
 181  * mpsl_get_symbol - Gets the value of a symbol.
 182  * @s: symbol name
 183  *
 184  * Gets the value of a symbol. The symbol can be local or global
 185  * (if the symbol exists in both tables, the local value will be returned).
 186  *
 187  * This function is only meant to be executed from inside an MPSL
 188  * program; from outside, it's exactly the same as calling mpdm_sget()
 189  * (as the local symbol table won't exist).
 190  */
 191 mpdm_t mpsl_get_symbol(mpdm_t s)
 192 {
 193         return get_symbol(s, local_symbol_table);
 194 }
 195
 196
 197 /**
 198  * mpsl_error - Generates an error.
 199  * @err: the error message
 200  *
 201  * Generates an error. The @err error message is stored in the ERROR
 202  * mpsl variable and the mpsl_abort global flag is set, so no further
 203  * mpsl code can be executed until reset.
 204  */
 205 mpdm_t mpsl_error(mpdm_t err)
 206 {
 207         /* abort further execution */
 208         mpsl_abort = 1;
 209
 210         /* set the error */
 211         return mpdm_hset_s(mpdm_root(), L"ERROR", err);
 212 }
 213
 214 /** opcodes **/
 215
 216 #define O_TYPE static mpdm_t
 217 #define O_ARGS mpdm_t c, mpdm_t a, mpdm_t l, int * f
 218
 219 O_TYPE mpsl_exec_i(O_ARGS);
 220
 221 #define C(n) mpdm_aget(c, n)
 222 #define C0 C(0)
 223 #define C1 C(1)
 224
 225 #define M(n) mpsl_exec_i(C(n), a, l, f)
 226 #define M1 M(1)
 227 #define M2 M(2)
 228 #define M3 M(3)
 229
 230 #define R(x) mpdm_rval(x)
 231 #define I(x) mpdm_ival(x)
 232
 233 #define RM1 mpdm_rval(M(1))
 234 #define RM2 mpdm_rval(M(2))
 235 #define IM1 mpdm_ival(M(1))
 236 #define IM2 mpdm_ival(M(2))
 237
 238 #define GET(m) get_symbol(m, l)
 239 #define SET(m, v) set_symbol(m, v, l)
 240 #define BOOL mpsl_boolean
 241 #define ISTRU mpsl_is_true
 242
 243 #define RF(v) mpdm_ref(v)
 244 #define UF(v) mpdm_unref(v)
 245
 246 O_TYPE O_literal(O_ARGS) { return mpdm_clone(C1); }
 247 O_TYPE O_multi(O_ARGS) { mpdm_t v = RF(M1); if (!*f) v = M2; else UF(v); return v; }
 248 O_TYPE O_symval(O_ARGS) { return GET(M1); }
 249 O_TYPE O_assign(O_ARGS) { mpdm_t v = RF(M1); mpdm_t r = SET(v, M2); UF(v); return r; }
 250 O_TYPE O_if(O_ARGS) { return ISTRU(M1) ? M2 : M3; }
 251 O_TYPE O_local(O_ARGS) { set_local_symbols(M1, NULL, l); return NULL; }
 252 O_TYPE O_uminus(O_ARGS) { return MPDM_R(-RM1); }
 253 O_TYPE O_add(O_ARGS) { return MPDM_R(RM1 + RM2); }
 254 O_TYPE O_sub(O_ARGS) { return MPDM_R(RM1 - RM2); }
 255 O_TYPE O_mul(O_ARGS) { return MPDM_R(RM1 * RM2); }
 256 O_TYPE O_div(O_ARGS) { return MPDM_R(RM1 / RM2); }
 257 O_TYPE O_mod(O_ARGS) { return MPDM_I(IM1 % IM2); }
 258 O_TYPE O_not(O_ARGS) { return BOOL(! ISTRU(M1)); }
 259 O_TYPE O_and(O_ARGS) { mpdm_t r = M1; return ISTRU(r) ? M2 : r; }
 260 O_TYPE O_or(O_ARGS) { mpdm_t r = M1; return ISTRU(r) ? r : M2; }
 261 O_TYPE O_bitand(O_ARGS) { return MPDM_I(IM1 & IM2); }
 262 O_TYPE O_bitor(O_ARGS) { return MPDM_I(IM1 | IM2); }
 263 O_TYPE O_bitxor(O_ARGS) { return MPDM_I(IM1 ^ IM2); }
 264 O_TYPE O_numlt(O_ARGS) { return BOOL(RM1 < RM2); }
 265 O_TYPE O_numle(O_ARGS) { return BOOL(RM1 <= RM2); }
 266 O_TYPE O_numgt(O_ARGS) { return BOOL(RM1 > RM2); }
 267 O_TYPE O_numge(O_ARGS) { return BOOL(RM1 >= RM2); }
 268 O_TYPE O_strcat(O_ARGS) { mpdm_t v = RF(M1); mpdm_t r = mpdm_strcat(v, M2); UF(v); return r; }
 269 O_TYPE O_streq(O_ARGS) { mpdm_t v = RF(M1); mpdm_t r = BOOL(mpdm_cmp(v, M2) == 0); UF(v); return r; }
 270 O_TYPE O_immpinc(O_ARGS) { mpdm_t s=M1; return SET(s, MPDM_R(R(GET(s)) + 1)); }
 271 O_TYPE O_immpdec(O_ARGS) { mpdm_t s=M1; return SET(s, MPDM_R(R(GET(s)) - 1)); }
 272 O_TYPE O_immadd(O_ARGS) { mpdm_t s = RF(M1); mpdm_t r = SET(s, MPDM_R(R(GET(s)) + RM2)); UF(s); return r; }
 273 O_TYPE O_immsub(O_ARGS) { mpdm_t s = RF(M1); mpdm_t r = SET(s, MPDM_R(R(GET(s)) - RM2)); UF(s); return r; }
 274 O_TYPE O_immmul(O_ARGS) { mpdm_t s = RF(M1); mpdm_t r = SET(s, MPDM_R(R(GET(s)) * RM2)); UF(s); return r; }
 275 O_TYPE O_immdiv(O_ARGS) { mpdm_t s = RF(M1); mpdm_t r = SET(s, MPDM_R(R(GET(s)) / RM2)); UF(s); return r; }
 276 O_TYPE O_immmod(O_ARGS) { mpdm_t s = RF(M1); mpdm_t r = SET(s, MPDM_R(I(GET(s)) % IM2)); UF(s); return r; }
 277 O_TYPE O_immsinc(O_ARGS) { mpdm_t s = M1; mpdm_t v = GET(s); SET(s, MPDM_R(R(v) + 1)); return v; }
 278 O_TYPE O_immsdec(O_ARGS) { mpdm_t s = M1; mpdm_t v = GET(s); SET(s, MPDM_R(R(v) - 1)); return v; }
 279 O_TYPE O_numeq(O_ARGS) { mpdm_t v1 = RF(M1); mpdm_t v2 = M2; UF(v1); return BOOL((v1 == NULL || v2 == NULL) ? (v1 == v2) : (R(v1) == R(v2))); }
 280 O_TYPE O_break(O_ARGS) { *f = 1; return NULL; }
 281 O_TYPE O_return(O_ARGS) { mpdm_t v = M1; *f = -1; return v; }
 282
 283 O_TYPE O_execsym(O_ARGS)
 284 /* executes the value of a symbol */
 285 {
 286         mpdm_t s, v, r = NULL;
 287
 288         /* gets the symbol name */
 289         s = RF(M1);
 290
 291         /* gets the symbol value */
 292         v = GET(s);
 293
 294         if (!MPDM_IS_EXEC(v)) {
 295                 /* not found or NULL value? error */
 296                 mpdm_t t;
 297                 char tmp[128];
 298
 299                 t = mpdm_join(MPDM_LS(L"."), s);
 300                 t = MPDM_2MBS((wchar_t *) t->data);
 301
 302                 snprintf(tmp, sizeof(tmp), "Undefined function %s()",
 303                         (char *)t->data);
 304
 305                 mpsl_error(MPDM_MBS(tmp));
 306         }
 307         else {
 308                 local_symbol_table = l;
 309
 310                 /* executes */
 311                 r = mpdm_exec(v, M2);
 312
 313                 local_symbol_table = NULL;
 314         }
 315
 316         UF(s);
 317
 318         return r;
 319 }
 320
 321
 322 O_TYPE O_while(O_ARGS)
 323 /* while loop */
 324 {
 325         mpdm_t r = NULL;
 326
 327         while (! *f && ISTRU(M1)) {
 328                 UF(r);
 329                 r = RF(M2);
 330         }
 331
 332         if (*f == 1)
 333                 *f = 0;
 334
 335         return UF(r);
 336 }
 337
 338
 339 O_TYPE O_foreach(O_ARGS)
 340 /* foreach loop */
 341 {
 342         mpdm_t s = RF(M1);
 343         mpdm_t v = RF(M2);
 344         mpdm_t r = NULL;
 345         int n;
 346
 347         for (n = 0; n < mpdm_size(v) && ! *f; n++) {
 348                 SET(s, mpdm_aget(v, n));
 349                 UF(r);
 350                 r = RF(M3);
 351         }
 352
 353         if (*f == 1)
 354                 *f = 0;
 355
 356         UF(s); UF(v);
 357
 358         return UF(r);
 359 }
 360
 361
 362 O_TYPE O_range(O_ARGS)
 363 /* build list from range of two numeric values */
 364 {
 365         double n;
 366         double v1 = RM1;
 367         double v2 = RM2;
 368         mpdm_t ret = MPDM_A(0);
 369
 370         if (v1 < v2)
 371                 for (n = v1; n <= v2; n++)
 372                         mpdm_push(ret, MPDM_R(n));
 373         else
 374                 for (n = v1; n >= v2; n--)
 375                         mpdm_push(ret, MPDM_R(n));
 376
 377         return ret;
 378 }
 379
 380
 381 O_TYPE O_list(O_ARGS)
 382 /* build list from instructions */
 383 {
 384         mpdm_t ret = RF(mpdm_size(c) == 2 ? MPDM_A(0) : M(2));
 385
 386         mpdm_push(ret, M(1));
 387         return UF(ret);
 388 }
 389
 390
 391 O_TYPE O_hash(O_ARGS)
 392 /* build hash from instructions */
 393 {
 394         mpdm_t k, v;
 395         mpdm_t ret = RF(mpdm_size(c) == 3 ? MPDM_H(0) : M(3));
 396
 397         k = RF(M(1)); v = RF(M(2));
 398         mpdm_hset(ret, UF(k), UF(v));
 399         return UF(ret);
 400 }
 401
 402
 403 O_TYPE O_blkframe(O_ARGS)
 404 /* runs an instruction under a (block) frame */
 405 {
 406         mpdm_t ret;
 407
 408         /* if l is NULL (usually for subroutine frames),
 409            create a new array for holding local symbol tables */
 410         if (l == NULL)
 411                 l = MPDM_A(0);
 412
 413         /* create a new local symbol table */
 414         mpdm_push(l, MPDM_H(0));
 415
 416         /* creates the arguments (if any) as local variables */
 417         set_local_symbols(M2, a, l);
 418
 419         /* execute instruction */
 420         ret = M1;
 421
 422         /* destroy the local symbol table */
 423         mpdm_pop(l);
 424
 425         return(ret);
 426 }
 427
 428
 429 O_TYPE O_subframe(O_ARGS)
 430 /* runs an instruction inside a subroutine frame */
 431 {
 432         /* don't propagate the local symbol table,
 433            triggering a new subroutine frame */
 434         return O_blkframe(c, a, NULL, f);
 435 }
 436
 437
 438 static struct mpsl_op_s {
 439         wchar_t * name;
 440         int foldable;
 441         mpdm_t (* func)(O_ARGS);
 442 } op_table[] = {
 443         { L"LITERAL",   0,      O_literal },    /* *must* be the zeroth */
 444         { L"MULTI",     0,      O_multi },
 445         { L"SYMVAL",    0,      O_symval },
 446         { L"ASSIGN",    0,      O_assign },
 447         { L"EXECSYM",   0,      O_execsym },
 448         { L"IF",        0,      O_if },
 449         { L"WHILE",     0,      O_while },
 450         { L"FOREACH",   0,      O_foreach },
 451         { L"SUBFRAME",  0,      O_subframe },
 452         { L"BLKFRAME",  0,      O_blkframe },
 453         { L"BREAK",     0,      O_break },
 454         { L"RETURN",    0,      O_return },
 455         { L"LOCAL",     0,      O_local },
 456         { L"LIST",      1,      O_list },
 457         { L"HASH",      1,      O_hash },
 458         { L"RANGE",     1,      O_range },
 459         { L"UMINUS",    1,      O_uminus },
 460         { L"ADD",       1,      O_add },
 461         { L"SUB",       1,      O_sub },
 462         { L"MUL",       1,      O_mul },
 463         { L"DIV",       1,      O_div },
 464         { L"MOD",       1,      O_mod },
 465         { L"SINC",      0,      O_immsinc },
 466         { L"SDEC",      0,      O_immsdec },
 467         { L"PINC",      0,      O_immpinc },
 468         { L"PDEC",      0,      O_immpdec },
 469         { L"IADD",      0,      O_immadd },
 470         { L"ISUB",      0,      O_immsub },
 471         { L"IMUL",      0,      O_immmul },
 472         { L"IDIV",      0,      O_immdiv },
 473         { L"IMOD",      0,      O_immmod },
 474         { L"NOT",       1,      O_not },
 475         { L"AND",       1,      O_and },
 476         { L"OR",        1,      O_or },
 477         { L"NUMEQ",     1,      O_numeq },
 478         { L"NUMLT",     1,      O_numlt },
 479         { L"NUMLE",     1,      O_numle },
 480         { L"NUMGT",     1,      O_numgt },
 481         { L"NUMGE",     1,      O_numge },
 482         { L"STRCAT",    1,      O_strcat },
 483         { L"STREQ",     1,      O_streq },
 484         { L"BITAND",    1,      O_bitand },
 485         { L"BITOR",     1,      O_bitor },
 486         { L"BITXOR",    1,      O_bitxor },
 487         { NULL,         0,      NULL }
 488 };
 489
 490
 491 O_TYPE mpsl_exec_i(O_ARGS)
 492 /* Executes one MPSL instruction in the MPSL virtual machine. Called
 493    from mpsl_exec() (which holds the flow control status variable) */
 494 {
 495         mpdm_t ret = NULL;
 496
 497         /* if aborted, do nothing */
 498         if (mpsl_abort)
 499                 return NULL;
 500
 501         /* reference code, arguments and local symbol table */
 502         mpdm_ref(c);
 503         mpdm_ref(a);
 504         mpdm_ref(l);
 505
 506         if (c != NULL) {
 507                 int op;
 508
 509                 /* gets the opcode */
 510                 op = mpdm_ival(C0);
 511
 512                 /* if it's a valid opcode... */
 513                 if (op >= 0 && op < sizeof(op_table) / sizeof(struct mpsl_op_s)) {
 514                         struct mpsl_op_s * o = &op_table[op];
 515
 516                         /* and call it if existent */
 517                         if (o->func != NULL)
 518                                 ret = mpdm_ref(o->func(c, a, l, f));
 519                 }
 520         }
 521
 522         if(mpsl_trace)
 523                 printf("** %ls: %ls\n", mpdm_string(C0), mpdm_string(ret));
 524
 525         /* unreference */
 526         mpdm_unref(l);
 527         mpdm_unref(a);
 528         mpdm_unref(c);
 529
 530         /* sweep some values */
 531         if (sweep_on_exec_i)
 532                 mpdm_sweep(0);
 533
 534         return mpdm_unref(ret);
 535 }
 536
 537
 538 mpdm_t mpsl_exec_p(mpdm_t c, mpdm_t a)
 539 /* executes an MPSL instruction stream */
 540 {
 541         int f = 0;
 542
 543         /* execute first instruction with a new flow control variable */
 544         return mpsl_exec_i(c, a, local_symbol_table, &f);
 545 }
 546
 547
 548 static mpdm_t constant_fold(mpdm_t i)
 549 /* tries to fold complex but constant expressions into a literal */
 550 {
 551         int n;
 552
 553         /* get the number opcode */
 554         n = mpdm_ival(mpdm_aget(i, 0));
 555
 556         if (op_table[n].foldable) {
 557                 /* test if all arguments are literal (opcode 0) */
 558                 for (n = 1; n < mpdm_size(i); n++) {
 559                         mpdm_t t = mpdm_aget(i, n);
 560
 561                         /* if it's not LITERAL, abort immediately */
 562                         if (mpdm_ival(mpdm_aget(t, 0)) != 0)
 563                                 return i;
 564                 }
 565
 566                 /* avoid sweeping */
 567                 sweep_on_exec_i = 0;
 568
 569                 /* execute the instruction and convert to LITERAL */
 570                 i = mpsl_exec_p(i, NULL);
 571                 i = mpsl_mkins(L"LITERAL", 1, i, NULL, NULL);
 572
 573                 /* sweep again */
 574                 sweep_on_exec_i = 1;
 575         }
 576
 577         return i;
 578 }
 579
 580
 581 mpdm_t mpsl_mkins(wchar_t * opcode, int args, mpdm_t a1, mpdm_t a2, mpdm_t a3)
 582 /* creates an instruction */
 583 {
 584         mpdm_t o;
 585         mpdm_t v;
 586
 587         v = MPDM_A(args + 1);
 588
 589         /* inserts the opcode */
 590         o = mpdm_hget_s(mpsl_opcodes, opcode);
 591         mpdm_aset(v, o, 0);
 592
 593         switch (args) {
 594         case 3:         mpdm_aset(v, a3, 3);
 595         case 2:         mpdm_aset(v, a2, 2);
 596         case 1:         mpdm_aset(v, a1, 1);
 597         }
 598
 599         v = constant_fold(v);
 600
 601         return v;
 602 }
 603
 604
 605 mpdm_t mpsl_build_opcodes(void)
 606 /* builds the table of opcodes */
 607 {
 608         int n;
 609         mpdm_t r = MPDM_H(0);
 610
 611         for (n = 0; op_table[n].name != NULL; n++) {
 612                 mpdm_t v = MPDM_LS(op_table[n].name);
 613                 v->ival = n;
 614                 v->flags |= MPDM_IVAL;
 615
 616                 /* keys and values are the same */
 617                 mpdm_hset(r, v, v);
 618         }
 619
 620         return r;
 621 }