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