3 MPSL - Minimum Profit Scripting Language
4 Copyright (C) 2003/2007 Angel Ortega <angel@triptico.com>
6 mpsl_c.c - Minimum Profit Scripting Language Core
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.
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.
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.
22 http://www.triptico.com
37 /* instruction execution tracing flag */
40 /* global abort flag */
43 /* temporary storage for the local symbol table */
44 static mpdm_t local_symbol_table
= NULL
;
46 /* temporary storage for the opcode table
47 (only usable while compiling) */
48 mpdm_t mpsl_opcodes
= NULL
;
50 /* flag to control calls to mpdm_sweep() from inside mpsl_exec_i() */
51 static int sweep_on_exec_i
= 1;
58 * mpsl_is_true - Tests if a value is true.
61 * If @v is a valid MPSL 'false' value (NULL, "" or the "0" string),
62 * returns zero, or nonzero otherwise.
64 int mpsl_is_true(mpdm_t v
)
66 /* if value is NULL, it's false */
70 /* if it's a printable string... */
71 if (v
->flags
& MPDM_STRING
) {
72 wchar_t * ptr
= (wchar_t *)v
->data
;
74 /* ... and it's "" or the "0" string, it's false */
75 if(*ptr
== L
'\0' || (*ptr
== L
'0' && *(ptr
+ 1) == L
'\0'))
79 /* any other case is true */
85 * mpsl_boolean - Returns 'true' or 'false' MPSL stock values.
86 * @b: boolean selector
88 * Returns MPSL's 'false' or 'true' values depending on the value in @b.
90 mpdm_t
mpsl_boolean(int b
)
92 return b
? mpdm_hget_s(mpdm_root(), L
"TRUE") : NULL
;
96 static mpdm_t
find_local_symbol_table(mpdm_t s
, mpdm_t l
)
97 /* finds the local symbol table hash that holds l */
102 /* no local symbol table? nothing to find */
106 /* if s is multiple, take just the first element */
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
);
114 if (mpdm_exists(h
, s
)) {
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 */
129 if (s
== NULL
|| l
== NULL
)
132 /* gets the top local variable frame */
133 h
= mpdm_aget(l
, -1);
135 if (MPDM_IS_ARRAY(s
)) {
138 for (n
= 0; n
< mpdm_size(s
); n
++)
139 mpdm_hset(h
, mpdm_aget(s
, n
), mpdm_aget(v
, n
));
146 static mpdm_t
get_symbol(mpdm_t s
, mpdm_t l
)
147 /* gets a symbol from a local symbol table, or the global */
149 return mpdm_sget(find_local_symbol_table(s
, l
), s
);
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 */
156 mpdm_sset(find_local_symbol_table(s
, l
), s
, v
);
162 * mpsl_set_symbol - Sets value to a symbol.
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).
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).
174 mpdm_t
mpsl_set_symbol(mpdm_t s
, mpdm_t v
)
176 return set_symbol(s
, v
, local_symbol_table
);
181 * mpsl_get_symbol - Gets the value of a symbol.
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).
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).
191 mpdm_t
mpsl_get_symbol(mpdm_t s
)
193 return get_symbol(s
, local_symbol_table
);
198 * mpsl_error - Generates an error.
199 * @err: the error message
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.
205 mpdm_t
mpsl_error(mpdm_t err
)
207 /* abort further execution */
211 return mpdm_hset_s(mpdm_root(), L
"ERROR", err
);
216 #define O_TYPE static mpdm_t
217 #define O_ARGS mpdm_t c, mpdm_t a, mpdm_t l, int * f
219 O_TYPE
mpsl_exec_i(O_ARGS
);
221 #define C(n) mpdm_aget(c, n)
225 #define M(n) mpsl_exec_i(C(n), a, l, f)
230 #define R(x) mpdm_rval(x)
231 #define I(x) mpdm_ival(x)
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))
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
243 #define RF(v) mpdm_ref(v)
244 #define UF(v) mpdm_unref(v)
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
; }
283 O_TYPE
O_execsym(O_ARGS
)
284 /* executes the value of a symbol */
286 mpdm_t s
, v
, r
= NULL
;
288 /* gets the symbol name */
291 /* gets the symbol value */
294 if (!MPDM_IS_EXEC(v
)) {
295 /* not found or NULL value? error */
299 t
= mpdm_join(MPDM_LS(L
"."), s
);
300 t
= MPDM_2MBS((wchar_t *) t
->data
);
302 snprintf(tmp
, sizeof(tmp
), "Undefined function %s()",
305 mpsl_error(MPDM_MBS(tmp
));
308 local_symbol_table
= l
;
311 r
= mpdm_exec(v
, M2
);
313 local_symbol_table
= NULL
;
322 O_TYPE
O_while(O_ARGS
)
327 while (! *f
&& ISTRU(M1
)) {
339 O_TYPE
O_foreach(O_ARGS
)
347 for (n
= 0; n
< mpdm_size(v
) && ! *f
; n
++) {
348 SET(s
, mpdm_aget(v
, n
));
362 O_TYPE
O_range(O_ARGS
)
363 /* build list from range of two numeric values */
368 mpdm_t ret
= MPDM_A(0);
371 for (n
= v1
; n
<= v2
; n
++)
372 mpdm_push(ret
, MPDM_R(n
));
374 for (n
= v1
; n
>= v2
; n
--)
375 mpdm_push(ret
, MPDM_R(n
));
381 O_TYPE
O_list(O_ARGS
)
382 /* build list from instructions */
384 mpdm_t ret
= RF(mpdm_size(c
) == 2 ? MPDM_A(0) : M(2));
386 mpdm_push(ret
, M(1));
391 O_TYPE
O_hash(O_ARGS
)
392 /* build hash from instructions */
395 mpdm_t ret
= RF(mpdm_size(c
) == 3 ? MPDM_H(0) : M(3));
397 k
= RF(M(1)); v
= RF(M(2));
398 mpdm_hset(ret
, UF(k
), UF(v
));
403 O_TYPE
O_blkframe(O_ARGS
)
404 /* runs an instruction under a (block) frame */
408 /* if l is NULL (usually for subroutine frames),
409 create a new array for holding local symbol tables */
413 /* create a new local symbol table */
414 mpdm_push(l
, MPDM_H(0));
416 /* creates the arguments (if any) as local variables */
417 set_local_symbols(M2
, a
, l
);
419 /* execute instruction */
422 /* destroy the local symbol table */
429 O_TYPE
O_subframe(O_ARGS
)
430 /* runs an instruction inside a subroutine frame */
432 /* don't propagate the local symbol table,
433 triggering a new subroutine frame */
434 return O_blkframe(c
, a
, NULL
, f
);
438 static struct mpsl_op_s
{
441 mpdm_t (* func
)(O_ARGS
);
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
},
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
},
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
},
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) */
497 /* if aborted, do nothing */
501 /* reference code, arguments and local symbol table */
509 /* gets the opcode */
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
];
516 /* and call it if existent */
518 ret
= mpdm_ref(o
->func(c
, a
, l
, f
));
523 printf("** %ls: %ls\n", mpdm_string(C0
), mpdm_string(ret
));
530 /* sweep some values */
534 return mpdm_unref(ret
);
538 mpdm_t
mpsl_exec_p(mpdm_t c
, mpdm_t a
)
539 /* executes an MPSL instruction stream */
543 /* execute first instruction with a new flow control variable */
544 return mpsl_exec_i(c
, a
, NULL
, &f
);
548 static mpdm_t
constant_fold(mpdm_t i
)
549 /* tries to fold complex but constant expressions into a literal */
553 /* get the number opcode */
554 n
= mpdm_ival(mpdm_aget(i
, 0));
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
);
561 /* if it's not LITERAL, abort immediately */
562 if (mpdm_ival(mpdm_aget(t
, 0)) != 0)
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
);
581 mpdm_t
mpsl_mkins(wchar_t * opcode
, int args
, mpdm_t a1
, mpdm_t a2
, mpdm_t a3
)
582 /* creates an instruction */
587 v
= MPDM_A(args
+ 1);
589 /* inserts the opcode */
590 o
= mpdm_hget_s(mpsl_opcodes
, opcode
);
600 v
= constant_fold(v
);
606 mpdm_t
mpsl_build_opcodes(void)
607 /* builds the table of opcodes */
610 mpdm_t r
= MPDM_H(0);
612 for (n
= 0; op_table
[n
].name
!= NULL
; n
++) {
613 mpdm_t v
= MPDM_LS(op_table
[n
].name
);
615 v
->flags
|= MPDM_IVAL
;
617 /* keys and values are the same */