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