mpsl_c.c

   1 /*
   2
   3     MPSL - Minimum Profit Scripting Language
   4     Copyright (C) 2003/2010 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 <math.h>
  31 #include "mpdm.h"
  32 #include "mpsl.h"
  33
  34
  35 /** data **/
  36
  37 /* global abort flag */
  38 int mpsl_abort = 0;
  39
  40 /* temporary storage for the opcode table
  41    (only usable while compiling) */
  42 mpdm_t mpsl_opcodes = NULL;
  43
  44 /* pointer to a trap function */
  45 static mpdm_t mpsl_trap_func = NULL;
  46
  47
  48 /** code **/
  49
  50 /**
  51  * mpsl_is_true - Tests if a value is true.
  52  * @v: the value
  53  *
  54  * If @v is a valid MPSL 'false' value (NULL, "" or the "0" string),
  55  * returns zero, or nonzero otherwise.
  56  */
  57 int mpsl_is_true(mpdm_t v)
  58 {
  59     /* if value is NULL, it's false */
  60     if (v == NULL)
  61         return 0;
  62
  63     /* if it's a printable string... */
  64     if (v->flags & MPDM_STRING) {
  65         wchar_t *ptr = (wchar_t *) v->data;
  66
  67         /* ... and it's "" or the "0" string, it's false */
  68         if (*ptr == L'\0' || (*ptr == L'0' && *(ptr + 1) == L'\0'))
  69             return 0;
  70     }
  71
  72     /* any other case is true */
  73     return 1;
  74 }
  75
  76
  77 /**
  78  * mpsl_boolean - Returns 'true' or 'false' MPSL stock values.
  79  * @b: boolean selector
  80  *
  81  * Returns MPSL's 'false' or 'true' values depending on the value in @b.
  82  */
  83 mpdm_t mpsl_boolean(int b)
  84 {
  85     return b ? mpdm_hget_s(mpdm_root(), L"TRUE") : NULL;
  86 }
  87
  88
  89 static mpdm_t find_local_symtbl(mpdm_t s, mpdm_t l)
  90 /* finds the local symbol table hash that holds l */
  91 {
  92     int n;
  93     mpdm_t v = NULL;
  94
  95     /* no local symbol table? nothing to find */
  96     if (l == NULL)
  97         return NULL;
  98
  99     /* if s is multiple, take just the first element */
 100     if (MPDM_IS_ARRAY(s))
 101         s = mpdm_aget(s, 0);
 102
 103     /* travel the local symbol table trying to find it */
 104     for (n = mpdm_size(l) - 1; n >= 0; n--) {
 105         mpdm_t h = mpdm_aget(l, n);
 106
 107         if (mpdm_exists(h, s)) {
 108             v = h;
 109             break;
 110         }
 111     }
 112
 113     return v;
 114 }
 115
 116
 117 static void set_local_symbols(mpdm_t s, mpdm_t v, mpdm_t l)
 118 /* sets (or creates) a list of local symbols with a list of values */
 119 {
 120     if (l != NULL) {
 121         mpdm_t h;
 122
 123         mpdm_ref(s);
 124         mpdm_ref(v);
 125         mpdm_ref(l);
 126
 127         /* gets the top local variable frame */
 128         h = mpdm_aget(l, -1);
 129
 130         if (MPDM_IS_ARRAY(s) || MPDM_IS_ARRAY(v)) {
 131             int n;
 132             mpdm_t a;
 133
 134             for (n = 0; n < mpdm_size(s); n++)
 135                 mpdm_hset(h, mpdm_aget(s, n), mpdm_aget(v, n));
 136
 137             if (n < mpdm_size(v)) {
 138                 /* store the rest of arguments into _ */
 139                 a = mpdm_hset_s(h, L"_", MPDM_A(0));
 140
 141                 for (; n < mpdm_size(v); n++)
 142                     mpdm_push(a, mpdm_aget(v, n));
 143             }
 144         }
 145         else
 146             mpdm_hset(h, s, v);
 147
 148         mpdm_unref(l);
 149         mpdm_unref(v);
 150         mpdm_unref(s);
 151     }
 152 }
 153
 154
 155 /**
 156  * mpsl_set_symbol - Sets value to a symbol.
 157  * @s: symbol name
 158  * @v: value
 159  * @l: local symbol table
 160  *
 161  * Assigns the value @v to the @s symbol. If the value exists as
 162  * a local symbol, it's assigned to it; otherwise, it's set as a global
 163  * symbol (and created if it does not exist).
 164  */
 165 mpdm_t mpsl_set_symbol(mpdm_t s, mpdm_t v, mpdm_t l)
 166 {
 167     mpdm_t r;
 168
 169     mpdm_ref(s);
 170     mpdm_ref(v);
 171     mpdm_ref(l);
 172
 173     r = mpdm_sset(find_local_symtbl(s, l), s, v);
 174
 175     mpdm_unref(l);
 176     mpdm_unref(v);
 177     mpdm_unref(s);
 178
 179     return r;
 180 }
 181
 182
 183 mpdm_t mpsl_get_symbol_i(mpdm_t s, mpdm_t l, int i)
 184 {
 185     mpdm_t r;
 186
 187     mpdm_ref(s);
 188     mpdm_ref(l);
 189
 190     r = mpdm_sget_i(find_local_symtbl(s, l), s, i);
 191
 192     mpdm_unref(l);
 193     mpdm_unref(s);
 194
 195     return r;
 196 }
 197
 198
 199 /**
 200  * mpsl_get_symbol - Gets the value of a symbol.
 201  * @s: symbol name
 202  * @l: local symbol table
 203  *
 204  * Gets the value of a symbol. The symbol can be local or global
 205  * (if the symbol exists in both tables, the local value will be returned).
 206  */
 207 mpdm_t mpsl_get_symbol(mpdm_t s, mpdm_t l)
 208 {
 209     return mpsl_get_symbol_i(s, l, 0);
 210 }
 211
 212
 213 /**
 214  * mpsl_error - Generates an error.
 215  * @err: the error message
 216  *
 217  * Generates an error. The @err error message is stored in the ERROR
 218  * mpsl variable and the mpsl_abort global flag is set, so no further
 219  * mpsl code can be executed until reset.
 220  */
 221 mpdm_t mpsl_error(mpdm_t err)
 222 {
 223     /* abort further execution */
 224     mpsl_abort = 1;
 225
 226     /* set the error */
 227     return mpdm_hset_s(mpdm_root(), L"ERROR", err);
 228 }
 229
 230
 231 /** opcode macro helpers **/
 232
 233 #define O_TYPE static mpdm_t
 234 #define O_ARGS mpdm_t c, mpdm_t a, mpdm_t l, int * f
 235
 236 O_TYPE mpsl_exec_i(O_ARGS);
 237
 238 #define C(n) mpdm_aget(c, n)
 239 #define C0 C(0)
 240 #define C1 C(1)
 241
 242 #define M(n) mpsl_exec_i(C(n), a, l, f)
 243 #define M1 M(1)
 244 #define M2 M(2)
 245 #define M3 M(3)
 246 #define M4 M(4)
 247
 248 #define R(x) mpdm_rval(x)
 249 #define I(x) mpdm_ival(x)
 250
 251 #define RM1 mpdm_rval(M(1))
 252 #define RM2 mpdm_rval(M(2))
 253 #define IM1 mpdm_ival(M(1))
 254 #define IM2 mpdm_ival(M(2))
 255
 256 #define GET(m) mpsl_get_symbol(m, l)
 257 #define SET(m, v) mpsl_set_symbol(m, v, l)
 258 #define BOOL mpsl_boolean
 259
 260 #define RF(v) mpdm_ref(v)
 261 #define UF(v) v = mpdm_unref(v)
 262 #define UFND(v) mpdm_unrefnd(v)
 263
 264 static int is_true_uf(mpdm_t v)
 265 {
 266     int r;
 267
 268     RF(v);
 269     r = mpsl_is_true(v);
 270     UF(v);
 271
 272     return r;
 273 }
 274
 275 /** opcodes **/
 276
 277 O_TYPE O_literal(O_ARGS)
 278 {
 279     return mpdm_clone(C1);
 280 }
 281
 282 O_TYPE O_multi(O_ARGS)
 283 {
 284     mpdm_t v = M1;
 285
 286     if (!*f) {
 287         mpdm_void(v);
 288         v = M2;
 289     }
 290
 291     return v;
 292 }
 293
 294 O_TYPE O_imulti(O_ARGS)
 295 {
 296     mpdm_t v = RF(M1);
 297
 298     if (!*f)
 299         mpdm_void(M2);
 300
 301     return UFND(v);
 302 }
 303
 304 O_TYPE O_symval(O_ARGS)
 305 {
 306     return GET(M1);
 307 }
 308
 309 O_TYPE O_assign(O_ARGS)
 310 {
 311     return SET(M1, M2);
 312 }
 313
 314 O_TYPE O_if(O_ARGS)
 315 {
 316     return is_true_uf(M1) ? M2 : M3;
 317 }
 318
 319 O_TYPE O_local(O_ARGS)
 320 {
 321     set_local_symbols(M1, NULL, l);
 322
 323     return NULL;
 324 }
 325
 326 O_TYPE O_uminus(O_ARGS)
 327 {
 328     return MPDM_R(-mpdm_rval(M1));
 329 }
 330
 331 O_TYPE O_add(O_ARGS)
 332 {
 333     return MPDM_R(RM1 + RM2);
 334 }
 335
 336 O_TYPE O_sub(O_ARGS)
 337 {
 338     return MPDM_R(RM1 - RM2);
 339 }
 340
 341 O_TYPE O_mul(O_ARGS)
 342 {
 343     return MPDM_R(RM1 * RM2);
 344 }
 345
 346 O_TYPE O_div(O_ARGS)
 347 {
 348     return MPDM_R(RM1 / RM2);
 349 }
 350
 351 O_TYPE O_mod(O_ARGS)
 352 {
 353     return MPDM_I(IM1 % IM2);
 354 }
 355
 356 O_TYPE O_not(O_ARGS)
 357 {
 358     return BOOL(!is_true_uf(M1));
 359 }
 360
 361 O_TYPE O_and(O_ARGS)
 362 {
 363     mpdm_t v = M1;
 364     mpdm_t r;
 365
 366     if (mpsl_is_true(v)) {
 367         mpdm_void(v);
 368         r = M2;
 369     }
 370     else
 371         r = v;
 372
 373     return r;
 374 }
 375
 376 O_TYPE O_or(O_ARGS)
 377 {
 378     mpdm_t v = M1;
 379     mpdm_t r;
 380
 381     if (!mpsl_is_true(v)) {
 382         mpdm_void(v);
 383         r = M2;
 384     }
 385     else
 386         r = v;
 387
 388     return r;
 389 }
 390
 391 O_TYPE O_bitand(O_ARGS)
 392 {
 393     return MPDM_I(IM1 & IM2);
 394 }
 395
 396 O_TYPE O_bitor(O_ARGS)
 397 {
 398     return MPDM_I(IM1 | IM2);
 399 }
 400
 401 O_TYPE O_bitxor(O_ARGS)
 402 {
 403     return MPDM_I(IM1 ^ IM2);
 404 }
 405
 406 O_TYPE O_shl(O_ARGS)
 407 {
 408     return MPDM_I(IM1 << IM2);
 409 }
 410
 411 O_TYPE O_shr(O_ARGS)
 412 {
 413     return MPDM_I(IM1 >> IM2);
 414 }
 415
 416 O_TYPE O_pow(O_ARGS)
 417 {
 418     return MPDM_R(pow(RM1, RM2));
 419 }
 420
 421 O_TYPE O_numlt(O_ARGS)
 422 {
 423     return BOOL(RM1 < RM2);
 424 }
 425
 426 O_TYPE O_numle(O_ARGS)
 427 {
 428     return BOOL(RM1 <= RM2);
 429 }
 430
 431 O_TYPE O_numgt(O_ARGS)
 432 {
 433     return BOOL(RM1 > RM2);
 434 }
 435
 436 O_TYPE O_numge(O_ARGS)
 437 {
 438     return BOOL(RM1 >= RM2);
 439 }
 440
 441 O_TYPE O_strcat(O_ARGS)
 442 {
 443     return mpdm_strcat(M1, M2);
 444 }
 445
 446 O_TYPE O_streq(O_ARGS)
 447 {
 448     return BOOL(mpdm_cmp(M1, M2) == 0);
 449 }
 450
 451 O_TYPE O_numeq(O_ARGS)
 452 {
 453     mpdm_t v1 = RF(M1);
 454     mpdm_t v2 = RF(M2);
 455
 456     mpdm_t r = BOOL((v1 == NULL || v2 == NULL) ?
 457                     (v1 == v2) : (R(v1) == R(v2))
 458         );
 459
 460     UF(v2);
 461     UF(v1);
 462
 463     return r;
 464 }
 465
 466 O_TYPE O_break(O_ARGS)
 467 {
 468     *f = 1;
 469
 470     return NULL;
 471 }
 472
 473 O_TYPE O_return(O_ARGS)
 474 {
 475     mpdm_t v = M1;
 476
 477     *f = -1;
 478
 479     return v;
 480 }
 481
 482 O_TYPE execsym(O_ARGS, int th)
 483 {
 484     mpdm_t s, v, r = NULL;
 485
 486     /* gets the symbol name */
 487     s = RF(M1);
 488
 489     /* gets the symbol value */
 490     v = GET(s);
 491
 492     if (!MPDM_IS_EXEC(v)) {
 493         /* not found or NULL value? error */
 494         mpdm_t t, w;
 495         char tmp[128];
 496
 497         w = RF(mpdm_join_s(s, L"."));
 498         t = RF(MPDM_2MBS((wchar_t *) w->data));
 499
 500         snprintf(tmp, sizeof(tmp), "Undefined function %s()",
 501                  (char *) t->data);
 502
 503         mpsl_error(MPDM_MBS(tmp));
 504
 505         UF(w);
 506         UF(t);
 507     }
 508     else {
 509         int ts = 0;
 510
 511         /* does the symbol have more than one part? */
 512         if (MPDM_IS_ARRAY(s) && mpdm_size(s) > 1) {
 513             /* if so, store the prefix into local variable 'this' */
 514             mpdm_push(l, MPDM_H(0));
 515             mpsl_set_symbol(MPDM_LS(L"this"), mpsl_get_symbol_i(s, l, 1), l);
 516
 517             ts = 1;
 518         }
 519
 520         /* execute */
 521         r = th ? mpdm_exec_thread(v, M2, l) : mpdm_exec(v, M2, l);
 522
 523         if (ts)
 524             mpdm_adel(l, -1);
 525     }
 526
 527     UF(s);
 528
 529     return r;
 530 }
 531
 532
 533 O_TYPE O_execsym(O_ARGS)
 534 /* executes the value of a symbol */
 535 {
 536     return execsym(c, a, l, f, 0);
 537 }
 538
 539
 540 O_TYPE O_threadsym(O_ARGS)
 541 /* executes the value of a symbol in a new thread */
 542 {
 543     return execsym(c, a, l, f, 1);
 544 }
 545
 546
 547 O_TYPE O_while(O_ARGS)
 548 /* while/for loop */
 549 {
 550     mpdm_t r = NULL;
 551
 552     for (mpdm_void(M3); !*f && is_true_uf(M1); mpdm_void(M4)) {
 553         UF(r);
 554         r = RF(M2);
 555     }
 556
 557     if (*f == 1)
 558         *f = 0;
 559
 560     return UFND(r);
 561 }
 562
 563
 564 O_TYPE O_foreach(O_ARGS)
 565 /* foreach loop */
 566 {
 567     mpdm_t s = RF(M1);
 568     mpdm_t v = RF(M2);
 569     mpdm_t r = NULL;
 570     int n;
 571
 572     for (n = 0; n < mpdm_size(v) && !*f; n++) {
 573         SET(s, mpdm_aget(v, n));
 574         UF(r);
 575         r = RF(M3);
 576     }
 577
 578     if (*f == 1)
 579         *f = 0;
 580
 581     UF(s);
 582     UF(v);
 583
 584     return UFND(r);
 585 }
 586
 587
 588 O_TYPE O_range(O_ARGS)
 589 /* build list from range of two numeric values */
 590 {
 591     double n;
 592     double v1 = RM1;
 593     double v2 = RM2;
 594     mpdm_t r = RF(MPDM_A(0));
 595
 596     if (v1 < v2)
 597         for (n = v1; n <= v2; n++)
 598             mpdm_push(r, MPDM_R(n));
 599     else
 600         for (n = v1; n >= v2; n--)
 601             mpdm_push(r, MPDM_R(n));
 602
 603     UFND(r);
 604
 605     return r;
 606 }
 607
 608
 609 O_TYPE O_list(O_ARGS)
 610 /* build list from instructions */
 611 {
 612     mpdm_t ret = RF(mpdm_size(c) == 2 ? MPDM_A(0) : M(2));
 613
 614     mpdm_push(ret, M(1));
 615
 616     return UFND(ret);
 617 }
 618
 619
 620 O_TYPE O_ilist(O_ARGS)
 621 /* build and inverse list from instructions */
 622 {
 623     mpdm_t ret = RF(mpdm_size(c) == 2 ? MPDM_A(0) : M(2));
 624
 625     mpdm_ins(ret, M(1), 0);
 626
 627     return UFND(ret);
 628 }
 629
 630
 631 O_TYPE O_hash(O_ARGS)
 632 /* build hash from instructions */
 633 {
 634     mpdm_t ret = RF(mpdm_size(c) == 3 ? MPDM_H(0) : M(3));
 635
 636     mpdm_hset(ret, M1, M2);
 637
 638     return UFND(ret);
 639 }
 640
 641
 642 O_TYPE O_blkframe(O_ARGS)
 643 /* runs an instruction under a block frame */
 644 {
 645     mpdm_t ret;
 646
 647     /* no context? create one */
 648     if (l == NULL)
 649         l = MPDM_A(0);
 650
 651     RF(l);
 652
 653     /* create a new local symbol table */
 654     mpdm_push(l, MPDM_H(0));
 655
 656     /* creates the arguments (if any) as local variables */
 657     set_local_symbols(M2, a, l);
 658
 659     /* execute instruction */
 660     ret = RF(M1);
 661
 662     /* destroy the local symbol table */
 663     mpdm_adel(l, -1);
 664
 665     UF(l);
 666
 667     return UFND(ret);
 668 }
 669
 670
 671 O_TYPE O_subframe(O_ARGS)
 672 /* runs an instruction inside a subroutine frame */
 673 {
 674     /* like a block frame, but with its own symbol table */
 675     return O_blkframe(c, a, MPDM_A(0), f);
 676 }
 677
 678
 679 static struct mpsl_op_s {
 680     wchar_t *name;
 681     int foldable;
 682      mpdm_t(*func) (O_ARGS);
 683 } op_table[] = {
 684     { L"LITERAL",   0, O_literal },  /* *must* be the zeroth */
 685     { L"MULTI",     0, O_multi },
 686     { L"IMULTI",    0, O_imulti },
 687     { L"SYMVAL",    0, O_symval },
 688     { L"ASSIGN",    0, O_assign },
 689     { L"EXECSYM",   0, O_execsym },
 690     { L"THREADSYM", 0, O_threadsym },
 691     { L"IF",        0, O_if },
 692     { L"WHILE",     0, O_while },
 693     { L"FOREACH",   0, O_foreach },
 694     { L"SUBFRAME",  0, O_subframe },
 695     { L"BLKFRAME",  0, O_blkframe },
 696     { L"BREAK",     0, O_break },
 697     { L"RETURN",    0, O_return },
 698     { L"LOCAL",     0, O_local },
 699     { L"LIST",      1, O_list },
 700     { L"ILIST",     1, O_ilist },
 701     { L"HASH",      1, O_hash },
 702     { L"RANGE",     1, O_range },
 703     { L"UMINUS",    1, O_uminus },
 704     { L"ADD",       1, O_add },
 705     { L"SUB",       1, O_sub },
 706     { L"MUL",       1, O_mul },
 707     { L"DIV",       1, O_div },
 708     { L"MOD",       1, O_mod },
 709     { L"NOT",       1, O_not },
 710     { L"AND",       1, O_and },
 711     { L"OR",        1, O_or },
 712     { L"NUMEQ",     1, O_numeq },
 713     { L"NUMLT",     1, O_numlt },
 714     { L"NUMLE",     1, O_numle },
 715     { L"NUMGT",     1, O_numgt },
 716     { L"NUMGE",     1, O_numge },
 717     { L"STRCAT",    1, O_strcat },
 718     { L"STREQ",     1, O_streq },
 719     { L"BITAND",    1, O_bitand },
 720     { L"BITOR",     1, O_bitor },
 721     { L"BITXOR",    1, O_bitxor },
 722     { L"SHL",       1, O_shl },
 723     { L"SHR",       1, O_shr },
 724     { L"POW",       1, O_pow },
 725     { NULL,         0, NULL }
 726 };
 727
 728
 729 O_TYPE mpsl_exec_i(O_ARGS)
 730 /* Executes one MPSL instruction in the MPSL virtual machine. Called
 731    from mpsl_exec_p() (which holds the flow control status variable) */
 732 {
 733     mpdm_t ret = NULL;
 734
 735     mpdm_ref(c);
 736     mpdm_ref(a);
 737     mpdm_ref(l);
 738
 739     /* if aborted or NULL, do nothing */
 740     if (!mpsl_abort && c != NULL) {
 741         /* gets the opcode and calls it */
 742         ret = op_table[mpdm_ival(C0)].func(c, a, l, f);
 743
 744         if (mpsl_trap_func != NULL) {
 745             mpdm_t f = mpsl_trap_func;
 746
 747             mpdm_ref(ret);
 748
 749             mpsl_trap_func = NULL;
 750             mpdm_exec_3(f, c, a, ret, l);
 751             mpsl_trap_func = f;
 752
 753             mpdm_unrefnd(ret);
 754         }
 755     }
 756
 757     mpdm_unref(l);
 758     mpdm_unref(a);
 759     mpdm_unref(c);
 760
 761     return ret;
 762 }
 763
 764
 765 mpdm_t mpsl_exec_p(mpdm_t c, mpdm_t a, mpdm_t ctxt)
 766 /* executes an MPSL instruction stream */
 767 {
 768     int f = 0;
 769
 770     /* execute first instruction with a new flow control variable */
 771     return mpsl_exec_i(c, a, ctxt, &f);
 772 }
 773
 774
 775 static mpdm_t constant_fold(mpdm_t i)
 776 /* tries to fold complex but constant expressions into a literal */
 777 {
 778     int n;
 779     mpdm_t v;
 780
 781     /* get the number opcode */
 782     n = mpdm_ival(mpdm_aget(i, 0));
 783
 784     if (op_table[n].foldable) {
 785         /* test if all arguments are literal (opcode 0) */
 786         for (n = 1; n < mpdm_size(i); n++) {
 787             mpdm_t t = mpdm_aget(i, n);
 788
 789             /* if it's not LITERAL, abort immediately */
 790             if (mpdm_ival(mpdm_aget(t, 0)) != 0)
 791                 return i;
 792         }
 793
 794         /* execute the instruction and convert to LITERAL */
 795         v = mpsl_exec_p(i, NULL, NULL);
 796         i = mpsl_mkins(L"LITERAL", 1, v, NULL, NULL, NULL);
 797     }
 798
 799     return i;
 800 }
 801
 802
 803 mpdm_t mpsl_mkins(wchar_t * opcode, int args, mpdm_t a1, mpdm_t a2,
 804                   mpdm_t a3, mpdm_t a4)
 805 /* creates an instruction */
 806 {
 807     mpdm_t o;
 808     mpdm_t v;
 809
 810     v = MPDM_A(args + 1);
 811     mpdm_ref(v);
 812
 813     /* inserts the opcode */
 814     o = mpdm_hget_s(mpsl_opcodes, opcode);
 815     mpdm_aset(v, o, 0);
 816
 817     switch (args) {
 818     case 4: mpdm_aset(v, a4, 4); /* no break */
 819     case 3: mpdm_aset(v, a3, 3); /* no break */
 820     case 2: mpdm_aset(v, a2, 2); /* no break */
 821     case 1: mpdm_aset(v, a1, 1); /* no break */
 822     }
 823
 824     mpdm_unrefnd(v);
 825
 826     v = constant_fold(v);
 827
 828     return v;
 829 }
 830
 831
 832 mpdm_t mpsl_build_opcodes(void)
 833 /* builds the table of opcodes */
 834 {
 835     int n;
 836     mpdm_t r = MPDM_H(0);
 837
 838     mpdm_ref(r);
 839
 840     for (n = 0; op_table[n].name != NULL; n++) {
 841         mpdm_t v = MPDM_LS(op_table[n].name);
 842
 843         mpdm_set_ival(v, n);
 844
 845         /* keys and values are the same */
 846         mpdm_hset(r, v, v);
 847     }
 848
 849     mpdm_unrefnd(r);
 850
 851     return r;
 852 }
 853
 854
 855 /**
 856  * mpsl_trap - Install a trapping function.
 857  * @trap_func: The trapping MPSL code
 858  *
 859  * Installs a trapping function. The function is an MPSL
 860  * executable value receiving 3 arguments: the code stream,
 861  * the arguments and the return value of the executed code.
 862  *
 863  * Returns NULL (previous versions returned the previous
 864  * trapping function).
 865  */
 866 mpdm_t mpsl_trap(mpdm_t trap_func)
 867 {
 868     mpdm_ref(trap_func);
 869     mpdm_unref(mpsl_trap_func);
 870     mpsl_trap_func = trap_func;
 871
 872     return NULL;
 873 }
 874
 875
 876 /**
 877  * mpsl_argv - Fills the ARGV global array.
 878  * @argc: number of arguments
 879  * @argv: array of string values
 880  *
 881  * Fills the ARGV global MPSL array with an array of arguments. These
 882  * are usually the ones sent to main().
 883  */
 884 void mpsl_argv(int argc, char *argv[])
 885 {
 886     int n;
 887     mpdm_t ARGV;
 888
 889     /* create the ARGV array */
 890     ARGV = mpdm_hset_s(mpdm_root(), L"ARGV", MPDM_A(0));
 891
 892     for (n = 0; n < argc; n++)
 893         mpdm_push(ARGV, MPDM_MBS(argv[n]));
 894 }
 895
 896
 897 /* in mpsl_f.c */
 898 mpdm_t mpsl_build_funcs(void);
 899
 900
 901 /**
 902  * mpsl_startup - Initializes MPSL.
 903  *
 904  * Initializes the Minimum Profit Scripting Language. Returns 0 if
 905  * everything went OK.
 906  */
 907 int mpsl_startup(void)
 908 {
 909     mpdm_t r;
 910     mpdm_t m;
 911
 912     /* startup MPDM */
 913     mpdm_startup();
 914
 915     r = mpdm_root();
 916
 917     /* creates INC, unless already defined */
 918     if (mpdm_hget_s(r, L"INC") == NULL)
 919         mpdm_hset_s(r, L"INC", MPDM_A(0));
 920
 921     /* the TRUE value */
 922     mpdm_hset_s(r, L"TRUE", MPDM_I(1));
 923
 924     /* standard file descriptors */
 925     mpdm_hset_s(r, L"STDIN",    MPDM_F(stdin));
 926     mpdm_hset_s(r, L"STDOUT",   MPDM_F(stdout));
 927     mpdm_hset_s(r, L"STDERR",   MPDM_F(stderr));
 928
 929     /* home and application directories */
 930     mpdm_hset_s(r, L"HOMEDIR",  mpdm_home_dir());
 931     mpdm_hset_s(r, L"APPDIR",   mpdm_app_dir());
 932
 933     /* fill now the MPSL hash */
 934     m = MPDM_H(0);
 935     mpdm_hset_s(r, L"MPSL", m);
 936
 937     /* store things there */
 938     mpdm_hset_s(m, L"VERSION",  MPDM_MBS(VERSION));
 939     mpdm_hset_s(m, L"OPCODE",   mpsl_build_opcodes());
 940     mpdm_hset_s(m, L"LC",       MPDM_H(0));
 941     mpdm_hset_s(m, L"CORE",     mpsl_build_funcs());
 942
 943     mpdm_dump_1 = mpsl_dump_1;
 944
 945     return 0;
 946 }
 947
 948
 949 /**
 950  * mpsl_shutdown - Shuts down MPSL.
 951  *
 952  * Shuts down MPSL. No MPSL functions should be used from now on.
 953  */
 954 void mpsl_shutdown(void)
 955 {
 956     mpdm_shutdown();
 957 }