xref: /reactos/dll/win32/vbscript/compile.c (revision 84ccccab)
1 /*
2  * Copyright 2011 Jacek Caban for CodeWeavers
3  *
4  * This library is free software; you can redistribute it and/or
5  * modify it under the terms of the GNU Lesser General Public
6  * License as published by the Free Software Foundation; either
7  * version 2.1 of the License, or (at your option) any later version.
8  *
9  * This library is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12  * Lesser General Public License for more details.
13  *
14  * You should have received a copy of the GNU Lesser General Public
15  * License along with this library; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17  */
18 
19 #include "vbscript.h"
20 
21 WINE_DECLARE_DEBUG_CHANNEL(vbscript_disas);
22 
23 typedef struct _statement_ctx_t {
24     unsigned stack_use;
25 
26     unsigned while_end_label;
27     unsigned for_end_label;
28 
29     struct _statement_ctx_t *next;
30 } statement_ctx_t;
31 
32 typedef struct {
33     parser_ctx_t parser;
34 
35     unsigned instr_cnt;
36     unsigned instr_size;
37     vbscode_t *code;
38 
39     statement_ctx_t *stat_ctx;
40 
41     unsigned *labels;
42     unsigned labels_size;
43     unsigned labels_cnt;
44 
45     unsigned sub_end_label;
46     unsigned func_end_label;
47     unsigned prop_end_label;
48 
49     dim_decl_t *dim_decls;
50     dim_decl_t *dim_decls_tail;
51     dynamic_var_t *global_vars;
52 
53     const_decl_t *const_decls;
54     const_decl_t *global_consts;
55 
56     function_t *func;
57     function_t *funcs;
58     function_decl_t *func_decls;
59 
60     class_desc_t *classes;
61 } compile_ctx_t;
62 
63 static HRESULT compile_expression(compile_ctx_t*,expression_t*);
64 static HRESULT compile_statement(compile_ctx_t*,statement_ctx_t*,statement_t*);
65 
66 static const struct {
67     const char *op_str;
68     instr_arg_type_t arg1_type;
69     instr_arg_type_t arg2_type;
70 } instr_info[] = {
71 #define X(n,a,b,c) {#n,b,c},
72 OP_LIST
73 #undef X
74 };
75 
76 static void dump_instr_arg(instr_arg_type_t type, instr_arg_t *arg)
77 {
78     switch(type) {
79     case ARG_STR:
80     case ARG_BSTR:
81         TRACE_(vbscript_disas)("\t%s", debugstr_w(arg->str));
82         break;
83     case ARG_INT:
84         TRACE_(vbscript_disas)("\t%d", arg->uint);
85         break;
86     case ARG_UINT:
87     case ARG_ADDR:
88         TRACE_(vbscript_disas)("\t%u", arg->uint);
89         break;
90     case ARG_DOUBLE:
91         TRACE_(vbscript_disas)("\t%lf", *arg->dbl);
92         break;
93     case ARG_NONE:
94         break;
95     DEFAULT_UNREACHABLE;
96     }
97 }
98 
99 static void dump_code(compile_ctx_t *ctx)
100 {
101     instr_t *instr;
102 
103     for(instr = ctx->code->instrs+1; instr < ctx->code->instrs+ctx->instr_cnt; instr++) {
104         assert(instr->op < OP_LAST);
105         TRACE_(vbscript_disas)("%d:\t%s", (int)(instr-ctx->code->instrs), instr_info[instr->op].op_str);
106         dump_instr_arg(instr_info[instr->op].arg1_type, &instr->arg1);
107         dump_instr_arg(instr_info[instr->op].arg2_type, &instr->arg2);
108         TRACE_(vbscript_disas)("\n");
109     }
110 }
111 
112 static inline void *compiler_alloc(vbscode_t *vbscode, size_t size)
113 {
114     return heap_pool_alloc(&vbscode->heap, size);
115 }
116 
117 static inline void *compiler_alloc_zero(vbscode_t *vbscode, size_t size)
118 {
119     void *ret;
120 
121     ret = heap_pool_alloc(&vbscode->heap, size);
122     if(ret)
123         memset(ret, 0, size);
124     return ret;
125 }
126 
127 static WCHAR *compiler_alloc_string(vbscode_t *vbscode, const WCHAR *str)
128 {
129     size_t size;
130     WCHAR *ret;
131 
132     size = (strlenW(str)+1)*sizeof(WCHAR);
133     ret = compiler_alloc(vbscode, size);
134     if(ret)
135         memcpy(ret, str, size);
136     return ret;
137 }
138 
139 static inline instr_t *instr_ptr(compile_ctx_t *ctx, unsigned id)
140 {
141     assert(id < ctx->instr_cnt);
142     return ctx->code->instrs + id;
143 }
144 
145 static unsigned push_instr(compile_ctx_t *ctx, vbsop_t op)
146 {
147     assert(ctx->instr_size && ctx->instr_size >= ctx->instr_cnt);
148 
149     if(ctx->instr_size == ctx->instr_cnt) {
150         instr_t *new_instr;
151 
152         new_instr = heap_realloc(ctx->code->instrs, ctx->instr_size*2*sizeof(instr_t));
153         if(!new_instr)
154             return 0;
155 
156         ctx->code->instrs = new_instr;
157         ctx->instr_size *= 2;
158     }
159 
160     ctx->code->instrs[ctx->instr_cnt].op = op;
161     return ctx->instr_cnt++;
162 }
163 
164 static HRESULT push_instr_int(compile_ctx_t *ctx, vbsop_t op, LONG arg)
165 {
166     unsigned ret;
167 
168     ret = push_instr(ctx, op);
169     if(!ret)
170         return E_OUTOFMEMORY;
171 
172     instr_ptr(ctx, ret)->arg1.lng = arg;
173     return S_OK;
174 }
175 
176 static HRESULT push_instr_uint(compile_ctx_t *ctx, vbsop_t op, unsigned arg)
177 {
178     unsigned ret;
179 
180     ret = push_instr(ctx, op);
181     if(!ret)
182         return E_OUTOFMEMORY;
183 
184     instr_ptr(ctx, ret)->arg1.uint = arg;
185     return S_OK;
186 }
187 
188 static HRESULT push_instr_addr(compile_ctx_t *ctx, vbsop_t op, unsigned arg)
189 {
190     unsigned ret;
191 
192     ret = push_instr(ctx, op);
193     if(!ret)
194         return E_OUTOFMEMORY;
195 
196     instr_ptr(ctx, ret)->arg1.uint = arg;
197     return S_OK;
198 }
199 
200 static HRESULT push_instr_str(compile_ctx_t *ctx, vbsop_t op, const WCHAR *arg)
201 {
202     unsigned instr;
203     WCHAR *str;
204 
205     str = compiler_alloc_string(ctx->code, arg);
206     if(!str)
207         return E_OUTOFMEMORY;
208 
209     instr = push_instr(ctx, op);
210     if(!instr)
211         return E_OUTOFMEMORY;
212 
213     instr_ptr(ctx, instr)->arg1.str = str;
214     return S_OK;
215 }
216 
217 static HRESULT push_instr_double(compile_ctx_t *ctx, vbsop_t op, double arg)
218 {
219     unsigned instr;
220     double *d;
221 
222     d = compiler_alloc(ctx->code, sizeof(double));
223     if(!d)
224         return E_OUTOFMEMORY;
225 
226     instr = push_instr(ctx, op);
227     if(!instr)
228         return E_OUTOFMEMORY;
229 
230     *d = arg;
231     instr_ptr(ctx, instr)->arg1.dbl = d;
232     return S_OK;
233 }
234 
235 static BSTR alloc_bstr_arg(compile_ctx_t *ctx, const WCHAR *str)
236 {
237     if(!ctx->code->bstr_pool_size) {
238         ctx->code->bstr_pool = heap_alloc(8 * sizeof(BSTR));
239         if(!ctx->code->bstr_pool)
240             return NULL;
241         ctx->code->bstr_pool_size = 8;
242     }else if(ctx->code->bstr_pool_size == ctx->code->bstr_cnt) {
243         BSTR *new_pool;
244 
245         new_pool = heap_realloc(ctx->code->bstr_pool, ctx->code->bstr_pool_size*2*sizeof(BSTR));
246         if(!new_pool)
247             return NULL;
248 
249         ctx->code->bstr_pool = new_pool;
250         ctx->code->bstr_pool_size *= 2;
251     }
252 
253     ctx->code->bstr_pool[ctx->code->bstr_cnt] = SysAllocString(str);
254     if(!ctx->code->bstr_pool[ctx->code->bstr_cnt])
255         return NULL;
256 
257     return ctx->code->bstr_pool[ctx->code->bstr_cnt++];
258 }
259 
260 static HRESULT push_instr_bstr(compile_ctx_t *ctx, vbsop_t op, const WCHAR *arg)
261 {
262     unsigned instr;
263     BSTR bstr;
264 
265     bstr = alloc_bstr_arg(ctx, arg);
266     if(!bstr)
267         return E_OUTOFMEMORY;
268 
269     instr = push_instr(ctx, op);
270     if(!instr)
271         return E_OUTOFMEMORY;
272 
273     instr_ptr(ctx, instr)->arg1.bstr = bstr;
274     return S_OK;
275 }
276 
277 static HRESULT push_instr_bstr_uint(compile_ctx_t *ctx, vbsop_t op, const WCHAR *arg1, unsigned arg2)
278 {
279     unsigned instr;
280     BSTR bstr;
281 
282     bstr = alloc_bstr_arg(ctx, arg1);
283     if(!bstr)
284         return E_OUTOFMEMORY;
285 
286     instr = push_instr(ctx, op);
287     if(!instr)
288         return E_OUTOFMEMORY;
289 
290     instr_ptr(ctx, instr)->arg1.bstr = bstr;
291     instr_ptr(ctx, instr)->arg2.uint = arg2;
292     return S_OK;
293 }
294 
295 static HRESULT push_instr_uint_bstr(compile_ctx_t *ctx, vbsop_t op, unsigned arg1, const WCHAR *arg2)
296 {
297     unsigned instr;
298     BSTR bstr;
299 
300     bstr = alloc_bstr_arg(ctx, arg2);
301     if(!bstr)
302         return E_OUTOFMEMORY;
303 
304     instr = push_instr(ctx, op);
305     if(!instr)
306         return E_OUTOFMEMORY;
307 
308     instr_ptr(ctx, instr)->arg1.uint = arg1;
309     instr_ptr(ctx, instr)->arg2.bstr = bstr;
310     return S_OK;
311 }
312 
313 #define LABEL_FLAG 0x80000000
314 
315 static unsigned alloc_label(compile_ctx_t *ctx)
316 {
317     if(!ctx->labels_size) {
318         ctx->labels = heap_alloc(8 * sizeof(*ctx->labels));
319         if(!ctx->labels)
320             return 0;
321         ctx->labels_size = 8;
322     }else if(ctx->labels_size == ctx->labels_cnt) {
323         unsigned *new_labels;
324 
325         new_labels = heap_realloc(ctx->labels, 2*ctx->labels_size*sizeof(*ctx->labels));
326         if(!new_labels)
327             return 0;
328 
329         ctx->labels = new_labels;
330         ctx->labels_size *= 2;
331     }
332 
333     return ctx->labels_cnt++ | LABEL_FLAG;
334 }
335 
336 static inline void label_set_addr(compile_ctx_t *ctx, unsigned label)
337 {
338     assert(label & LABEL_FLAG);
339     ctx->labels[label & ~LABEL_FLAG] = ctx->instr_cnt;
340 }
341 
342 static inline unsigned stack_offset(compile_ctx_t *ctx)
343 {
344     statement_ctx_t *iter;
345     unsigned ret = 0;
346 
347     for(iter = ctx->stat_ctx; iter; iter = iter->next)
348         ret += iter->stack_use;
349 
350     return ret;
351 }
352 
353 static BOOL emit_catch_jmp(compile_ctx_t *ctx, unsigned stack_off, unsigned code_off)
354 {
355     unsigned code;
356 
357     code = push_instr(ctx, OP_catch);
358     if(!code)
359         return FALSE;
360 
361     instr_ptr(ctx, code)->arg1.uint = code_off;
362     instr_ptr(ctx, code)->arg2.uint = stack_off + stack_offset(ctx);
363     return TRUE;
364 }
365 
366 static inline BOOL emit_catch(compile_ctx_t *ctx, unsigned off)
367 {
368     return emit_catch_jmp(ctx, off, ctx->instr_cnt);
369 }
370 
371 static expression_t *lookup_const_decls(compile_ctx_t *ctx, const WCHAR *name, BOOL lookup_global)
372 {
373     const_decl_t *decl;
374 
375     for(decl = ctx->const_decls; decl; decl = decl->next) {
376         if(!strcmpiW(decl->name, name))
377             return decl->value_expr;
378     }
379 
380     if(!lookup_global)
381         return NULL;
382 
383     for(decl = ctx->global_consts; decl; decl = decl->next) {
384         if(!strcmpiW(decl->name, name))
385             return decl->value_expr;
386     }
387 
388     return NULL;
389 }
390 
391 static HRESULT compile_args(compile_ctx_t *ctx, expression_t *args, unsigned *ret)
392 {
393     unsigned arg_cnt = 0;
394     HRESULT hres;
395 
396     while(args) {
397         hres = compile_expression(ctx, args);
398         if(FAILED(hres))
399             return hres;
400 
401         arg_cnt++;
402         args = args->next;
403     }
404 
405     *ret = arg_cnt;
406     return S_OK;
407 }
408 
409 static HRESULT compile_member_expression(compile_ctx_t *ctx, member_expression_t *expr, BOOL ret_val)
410 {
411     unsigned arg_cnt = 0;
412     HRESULT hres;
413 
414     if(ret_val && !expr->args) {
415         expression_t *const_expr;
416 
417         const_expr = lookup_const_decls(ctx, expr->identifier, TRUE);
418         if(const_expr)
419             return compile_expression(ctx, const_expr);
420     }
421 
422     hres = compile_args(ctx, expr->args, &arg_cnt);
423     if(FAILED(hres))
424         return hres;
425 
426     if(expr->obj_expr) {
427         hres = compile_expression(ctx, expr->obj_expr);
428         if(FAILED(hres))
429             return hres;
430 
431         hres = push_instr_bstr_uint(ctx, ret_val ? OP_mcall : OP_mcallv, expr->identifier, arg_cnt);
432     }else {
433         hres = push_instr_bstr_uint(ctx, ret_val ? OP_icall : OP_icallv, expr->identifier, arg_cnt);
434     }
435 
436     return hres;
437 }
438 
439 static HRESULT compile_unary_expression(compile_ctx_t *ctx, unary_expression_t *expr, vbsop_t op)
440 {
441     HRESULT hres;
442 
443     hres = compile_expression(ctx, expr->subexpr);
444     if(FAILED(hres))
445         return hres;
446 
447     return push_instr(ctx, op) ? S_OK : E_OUTOFMEMORY;
448 }
449 
450 static HRESULT compile_binary_expression(compile_ctx_t *ctx, binary_expression_t *expr, vbsop_t op)
451 {
452     HRESULT hres;
453 
454     hres = compile_expression(ctx, expr->left);
455     if(FAILED(hres))
456         return hres;
457 
458     hres = compile_expression(ctx, expr->right);
459     if(FAILED(hres))
460         return hres;
461 
462     return push_instr(ctx, op) ? S_OK : E_OUTOFMEMORY;
463 }
464 
465 static HRESULT compile_expression(compile_ctx_t *ctx, expression_t *expr)
466 {
467     switch(expr->type) {
468     case EXPR_ADD:
469         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_add);
470     case EXPR_AND:
471         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_and);
472     case EXPR_BOOL:
473         return push_instr_int(ctx, OP_bool, ((bool_expression_t*)expr)->value);
474     case EXPR_BRACKETS:
475         return compile_expression(ctx, ((unary_expression_t*)expr)->subexpr);
476     case EXPR_CONCAT:
477         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_concat);
478     case EXPR_DIV:
479         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_div);
480     case EXPR_DOUBLE:
481         return push_instr_double(ctx, OP_double, ((double_expression_t*)expr)->value);
482     case EXPR_EMPTY:
483         return push_instr(ctx, OP_empty) ? S_OK : E_OUTOFMEMORY;
484     case EXPR_EQUAL:
485         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_equal);
486     case EXPR_EQV:
487         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_eqv);
488     case EXPR_EXP:
489         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_exp);
490     case EXPR_GT:
491         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_gt);
492     case EXPR_GTEQ:
493         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_gteq);
494     case EXPR_IDIV:
495         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_idiv);
496     case EXPR_IS:
497         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_is);
498     case EXPR_IMP:
499         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_imp);
500     case EXPR_LT:
501         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_lt);
502     case EXPR_LTEQ:
503         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_lteq);
504     case EXPR_ME:
505         return push_instr(ctx, OP_me) ? S_OK : E_OUTOFMEMORY;
506     case EXPR_MEMBER:
507         return compile_member_expression(ctx, (member_expression_t*)expr, TRUE);
508     case EXPR_MOD:
509         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_mod);
510     case EXPR_MUL:
511         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_mul);
512     case EXPR_NEG:
513         return compile_unary_expression(ctx, (unary_expression_t*)expr, OP_neg);
514     case EXPR_NEQUAL:
515         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_nequal);
516     case EXPR_NEW:
517         return push_instr_str(ctx, OP_new, ((string_expression_t*)expr)->value);
518     case EXPR_NOARG:
519         return push_instr_int(ctx, OP_hres, DISP_E_PARAMNOTFOUND);
520     case EXPR_NOT:
521         return compile_unary_expression(ctx, (unary_expression_t*)expr, OP_not);
522     case EXPR_NOTHING:
523         return push_instr(ctx, OP_nothing) ? S_OK : E_OUTOFMEMORY;
524     case EXPR_NULL:
525         return push_instr(ctx, OP_null) ? S_OK : E_OUTOFMEMORY;
526     case EXPR_OR:
527         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_or);
528     case EXPR_STRING:
529         return push_instr_str(ctx, OP_string, ((string_expression_t*)expr)->value);
530     case EXPR_SUB:
531         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_sub);
532     case EXPR_USHORT:
533         return push_instr_int(ctx, OP_short, ((int_expression_t*)expr)->value);
534     case EXPR_ULONG:
535         return push_instr_int(ctx, OP_long, ((int_expression_t*)expr)->value);
536     case EXPR_XOR:
537         return compile_binary_expression(ctx, (binary_expression_t*)expr, OP_xor);
538     default:
539         FIXME("Unimplemented expression type %d\n", expr->type);
540         return E_NOTIMPL;
541     }
542 
543     return S_OK;
544 }
545 
546 static HRESULT compile_if_statement(compile_ctx_t *ctx, if_statement_t *stat)
547 {
548     unsigned cnd_jmp, endif_label = 0;
549     elseif_decl_t *elseif_decl;
550     HRESULT hres;
551 
552     hres = compile_expression(ctx, stat->expr);
553     if(FAILED(hres))
554         return hres;
555 
556     cnd_jmp = push_instr(ctx, OP_jmp_false);
557     if(!cnd_jmp)
558         return E_OUTOFMEMORY;
559 
560     if(!emit_catch(ctx, 0))
561         return E_OUTOFMEMORY;
562 
563     hres = compile_statement(ctx, NULL, stat->if_stat);
564     if(FAILED(hres))
565         return hres;
566 
567     if(stat->else_stat || stat->elseifs) {
568         endif_label = alloc_label(ctx);
569         if(!endif_label)
570             return E_OUTOFMEMORY;
571 
572         hres = push_instr_addr(ctx, OP_jmp, endif_label);
573         if(FAILED(hres))
574             return hres;
575     }
576 
577     for(elseif_decl = stat->elseifs; elseif_decl; elseif_decl = elseif_decl->next) {
578         instr_ptr(ctx, cnd_jmp)->arg1.uint = ctx->instr_cnt;
579 
580         hres = compile_expression(ctx, elseif_decl->expr);
581         if(FAILED(hres))
582             return hres;
583 
584         cnd_jmp = push_instr(ctx, OP_jmp_false);
585         if(!cnd_jmp)
586             return E_OUTOFMEMORY;
587 
588         if(!emit_catch(ctx, 0))
589             return E_OUTOFMEMORY;
590 
591         hres = compile_statement(ctx, NULL, elseif_decl->stat);
592         if(FAILED(hres))
593             return hres;
594 
595         hres = push_instr_addr(ctx, OP_jmp, endif_label);
596         if(FAILED(hres))
597             return hres;
598     }
599 
600     instr_ptr(ctx, cnd_jmp)->arg1.uint = ctx->instr_cnt;
601 
602     if(stat->else_stat) {
603         hres = compile_statement(ctx, NULL, stat->else_stat);
604         if(FAILED(hres))
605             return hres;
606     }
607 
608     if(endif_label)
609         label_set_addr(ctx, endif_label);
610     return S_OK;
611 }
612 
613 static HRESULT compile_while_statement(compile_ctx_t *ctx, while_statement_t *stat)
614 {
615     statement_ctx_t stat_ctx = {0}, *loop_ctx;
616     unsigned start_addr;
617     unsigned jmp_end;
618     HRESULT hres;
619 
620     start_addr = ctx->instr_cnt;
621 
622     hres = compile_expression(ctx, stat->expr);
623     if(FAILED(hres))
624         return hres;
625 
626     jmp_end = push_instr(ctx, stat->stat.type == STAT_UNTIL ? OP_jmp_true : OP_jmp_false);
627     if(!jmp_end)
628         return E_OUTOFMEMORY;
629 
630     if(!emit_catch(ctx, 0))
631         return E_OUTOFMEMORY;
632 
633     if(stat->stat.type == STAT_WHILE) {
634         loop_ctx = NULL;
635     }else {
636         if(!(stat_ctx.while_end_label = alloc_label(ctx)))
637             return E_OUTOFMEMORY;
638         loop_ctx = &stat_ctx;
639     }
640 
641     hres = compile_statement(ctx, loop_ctx, stat->body);
642     if(FAILED(hres))
643         return hres;
644 
645     hres = push_instr_addr(ctx, OP_jmp, start_addr);
646     if(FAILED(hres))
647         return hres;
648 
649     instr_ptr(ctx, jmp_end)->arg1.uint = ctx->instr_cnt;
650 
651     if(loop_ctx)
652         label_set_addr(ctx, stat_ctx.while_end_label);
653 
654     return S_OK;
655 }
656 
657 static HRESULT compile_dowhile_statement(compile_ctx_t *ctx, while_statement_t *stat)
658 {
659     statement_ctx_t loop_ctx = {0};
660     unsigned start_addr;
661     vbsop_t jmp_op;
662     HRESULT hres;
663 
664     start_addr = ctx->instr_cnt;
665 
666     if(!(loop_ctx.while_end_label = alloc_label(ctx)))
667         return E_OUTOFMEMORY;
668 
669     hres = compile_statement(ctx, &loop_ctx, stat->body);
670     if(FAILED(hres))
671         return hres;
672 
673     if(stat->expr) {
674         hres = compile_expression(ctx, stat->expr);
675         if(FAILED(hres))
676             return hres;
677 
678         jmp_op = stat->stat.type == STAT_DOUNTIL ? OP_jmp_false : OP_jmp_true;
679     }else {
680         jmp_op = OP_jmp;
681     }
682 
683     hres = push_instr_addr(ctx, jmp_op, start_addr);
684     if(FAILED(hres))
685         return hres;
686 
687     label_set_addr(ctx, loop_ctx.while_end_label);
688 
689     if(!emit_catch(ctx, 0))
690         return E_OUTOFMEMORY;
691 
692     return S_OK;
693 }
694 
695 static HRESULT compile_foreach_statement(compile_ctx_t *ctx, foreach_statement_t *stat)
696 {
697     statement_ctx_t loop_ctx = {1};
698     unsigned loop_start;
699     HRESULT hres;
700 
701     /* Preserve a place on the stack in case we throw before having proper enum collection. */
702     if(!push_instr(ctx, OP_empty))
703         return E_OUTOFMEMORY;
704 
705     hres = compile_expression(ctx, stat->group_expr);
706     if(FAILED(hres))
707         return hres;
708 
709     if(!push_instr(ctx, OP_newenum))
710         return E_OUTOFMEMORY;
711 
712     if(!(loop_ctx.for_end_label = alloc_label(ctx)))
713         return E_OUTOFMEMORY;
714 
715     hres = push_instr_uint_bstr(ctx, OP_enumnext, loop_ctx.for_end_label, stat->identifier);
716     if(FAILED(hres))
717         return hres;
718 
719     if(!emit_catch(ctx, 1))
720         return E_OUTOFMEMORY;
721 
722     loop_start = ctx->instr_cnt;
723     hres = compile_statement(ctx, &loop_ctx, stat->body);
724     if(FAILED(hres))
725         return hres;
726 
727     /* We need a separated enumnext here, because we need to jump out of the loop on exception. */
728     hres = push_instr_uint_bstr(ctx, OP_enumnext, loop_ctx.for_end_label, stat->identifier);
729     if(FAILED(hres))
730         return hres;
731 
732     hres = push_instr_addr(ctx, OP_jmp, loop_start);
733     if(FAILED(hres))
734         return hres;
735 
736     label_set_addr(ctx, loop_ctx.for_end_label);
737     return S_OK;
738 }
739 
740 static HRESULT compile_forto_statement(compile_ctx_t *ctx, forto_statement_t *stat)
741 {
742     statement_ctx_t loop_ctx = {2};
743     unsigned step_instr, instr;
744     BSTR identifier;
745     HRESULT hres;
746 
747     identifier = alloc_bstr_arg(ctx, stat->identifier);
748     if(!identifier)
749         return E_OUTOFMEMORY;
750 
751     hres = compile_expression(ctx, stat->from_expr);
752     if(FAILED(hres))
753         return hres;
754 
755     /* FIXME: Assign should happen after both expressions evaluation. */
756     instr = push_instr(ctx, OP_assign_ident);
757     if(!instr)
758         return E_OUTOFMEMORY;
759     instr_ptr(ctx, instr)->arg1.bstr = identifier;
760     instr_ptr(ctx, instr)->arg2.uint = 0;
761 
762     hres = compile_expression(ctx, stat->to_expr);
763     if(FAILED(hres))
764         return hres;
765 
766     if(!push_instr(ctx, OP_val))
767         return E_OUTOFMEMORY;
768 
769     if(stat->step_expr) {
770         hres = compile_expression(ctx, stat->step_expr);
771         if(FAILED(hres))
772             return hres;
773 
774         if(!push_instr(ctx, OP_val))
775             return E_OUTOFMEMORY;
776     }else {
777         hres = push_instr_int(ctx, OP_short, 1);
778         if(FAILED(hres))
779             return hres;
780     }
781 
782     loop_ctx.for_end_label = alloc_label(ctx);
783     if(!loop_ctx.for_end_label)
784         return E_OUTOFMEMORY;
785 
786     step_instr = push_instr(ctx, OP_step);
787     if(!step_instr)
788         return E_OUTOFMEMORY;
789     instr_ptr(ctx, step_instr)->arg2.bstr = identifier;
790     instr_ptr(ctx, step_instr)->arg1.uint = loop_ctx.for_end_label;
791 
792     if(!emit_catch(ctx, 2))
793         return E_OUTOFMEMORY;
794 
795     hres = compile_statement(ctx, &loop_ctx, stat->body);
796     if(FAILED(hres))
797         return hres;
798 
799     /* FIXME: Error handling can't be done compatible with native using OP_incc here. */
800     instr = push_instr(ctx, OP_incc);
801     if(!instr)
802         return E_OUTOFMEMORY;
803     instr_ptr(ctx, instr)->arg1.bstr = identifier;
804 
805     hres = push_instr_addr(ctx, OP_jmp, step_instr);
806     if(FAILED(hres))
807         return hres;
808 
809     hres = push_instr_uint(ctx, OP_pop, 2);
810     if(FAILED(hres))
811         return hres;
812 
813     label_set_addr(ctx, loop_ctx.for_end_label);
814 
815     /* FIXME: reconsider after OP_incc fixup. */
816     if(!emit_catch(ctx, 0))
817         return E_OUTOFMEMORY;
818 
819     return S_OK;
820 }
821 
822 static HRESULT compile_select_statement(compile_ctx_t *ctx, select_statement_t *stat)
823 {
824     unsigned end_label, case_cnt = 0, *case_labels = NULL, i;
825     case_clausule_t *case_iter;
826     expression_t *expr_iter;
827     HRESULT hres;
828 
829     hres = compile_expression(ctx, stat->expr);
830     if(FAILED(hres))
831         return hres;
832 
833     if(!push_instr(ctx, OP_val))
834         return E_OUTOFMEMORY;
835 
836     end_label = alloc_label(ctx);
837     if(!end_label)
838         return E_OUTOFMEMORY;
839 
840     if(!emit_catch_jmp(ctx, 0, end_label))
841         return E_OUTOFMEMORY;
842 
843     for(case_iter = stat->case_clausules; case_iter; case_iter = case_iter->next)
844         case_cnt++;
845 
846     if(case_cnt) {
847         case_labels = heap_alloc(case_cnt*sizeof(*case_labels));
848         if(!case_labels)
849             return E_OUTOFMEMORY;
850     }
851 
852     for(case_iter = stat->case_clausules, i=0; case_iter; case_iter = case_iter->next, i++) {
853         case_labels[i] = alloc_label(ctx);
854         if(!case_labels[i]) {
855             hres = E_OUTOFMEMORY;
856             break;
857         }
858 
859         if(!case_iter->expr)
860             break;
861 
862         for(expr_iter = case_iter->expr; expr_iter; expr_iter = expr_iter->next) {
863             hres = compile_expression(ctx, expr_iter);
864             if(FAILED(hres))
865                 break;
866 
867             hres = push_instr_addr(ctx, OP_case, case_labels[i]);
868             if(FAILED(hres))
869                 break;
870 
871             if(!emit_catch_jmp(ctx, 0, case_labels[i])) {
872                 hres = E_OUTOFMEMORY;
873                 break;
874             }
875         }
876     }
877 
878     if(FAILED(hres)) {
879         heap_free(case_labels);
880         return hres;
881     }
882 
883     hres = push_instr_uint(ctx, OP_pop, 1);
884     if(FAILED(hres)) {
885         heap_free(case_labels);
886         return hres;
887     }
888 
889     hres = push_instr_addr(ctx, OP_jmp, case_iter ? case_labels[i] : end_label);
890     if(FAILED(hres)) {
891         heap_free(case_labels);
892         return hres;
893     }
894 
895     for(case_iter = stat->case_clausules, i=0; case_iter; case_iter = case_iter->next, i++) {
896         label_set_addr(ctx, case_labels[i]);
897         hres = compile_statement(ctx, NULL, case_iter->stat);
898         if(FAILED(hres))
899             break;
900 
901         if(!case_iter->next)
902             break;
903 
904         hres = push_instr_addr(ctx, OP_jmp, end_label);
905         if(FAILED(hres))
906             break;
907     }
908 
909     heap_free(case_labels);
910     if(FAILED(hres))
911         return hres;
912 
913     label_set_addr(ctx, end_label);
914     return S_OK;
915 }
916 
917 static HRESULT compile_assignment(compile_ctx_t *ctx, member_expression_t *member_expr, expression_t *value_expr, BOOL is_set)
918 {
919     unsigned args_cnt;
920     vbsop_t op;
921     HRESULT hres;
922 
923     if(member_expr->obj_expr) {
924         hres = compile_expression(ctx, member_expr->obj_expr);
925         if(FAILED(hres))
926             return hres;
927 
928         op = is_set ? OP_set_member : OP_assign_member;
929     }else {
930         op = is_set ? OP_set_ident : OP_assign_ident;
931     }
932 
933     hres = compile_expression(ctx, value_expr);
934     if(FAILED(hres))
935         return hres;
936 
937     hres = compile_args(ctx, member_expr->args, &args_cnt);
938     if(FAILED(hres))
939         return hres;
940 
941     hres = push_instr_bstr_uint(ctx, op, member_expr->identifier, args_cnt);
942     if(FAILED(hres))
943         return hres;
944 
945     if(!emit_catch(ctx, 0))
946         return E_OUTOFMEMORY;
947 
948     return S_OK;
949 }
950 
951 static HRESULT compile_assign_statement(compile_ctx_t *ctx, assign_statement_t *stat, BOOL is_set)
952 {
953     return compile_assignment(ctx, stat->member_expr, stat->value_expr, is_set);
954 }
955 
956 static HRESULT compile_call_statement(compile_ctx_t *ctx, call_statement_t *stat)
957 {
958     HRESULT hres;
959 
960     /* It's challenging for parser to distinguish parameterized assignment with one argument from call
961      * with equality expression argument, so we do it in compiler. */
962     if(!stat->is_strict && stat->expr->args && !stat->expr->args->next && stat->expr->args->type == EXPR_EQUAL) {
963         binary_expression_t *eqexpr = (binary_expression_t*)stat->expr->args;
964 
965         if(eqexpr->left->type == EXPR_BRACKETS) {
966             member_expression_t new_member = *stat->expr;
967 
968             WARN("converting call expr to assign expr\n");
969 
970             new_member.args = ((unary_expression_t*)eqexpr->left)->subexpr;
971             return compile_assignment(ctx, &new_member, eqexpr->right, FALSE);
972         }
973     }
974 
975     hres = compile_member_expression(ctx, stat->expr, FALSE);
976     if(FAILED(hres))
977         return hres;
978 
979     if(!emit_catch(ctx, 0))
980         return E_OUTOFMEMORY;
981 
982     return S_OK;
983 }
984 
985 static BOOL lookup_dim_decls(compile_ctx_t *ctx, const WCHAR *name)
986 {
987     dim_decl_t *dim_decl;
988 
989     for(dim_decl = ctx->dim_decls; dim_decl; dim_decl = dim_decl->next) {
990         if(!strcmpiW(dim_decl->name, name))
991             return TRUE;
992     }
993 
994     return FALSE;
995 }
996 
997 static BOOL lookup_args_name(compile_ctx_t *ctx, const WCHAR *name)
998 {
999     unsigned i;
1000 
1001     for(i = 0; i < ctx->func->arg_cnt; i++) {
1002         if(!strcmpiW(ctx->func->args[i].name, name))
1003             return TRUE;
1004     }
1005 
1006     return FALSE;
1007 }
1008 
1009 static HRESULT compile_dim_statement(compile_ctx_t *ctx, dim_statement_t *stat)
1010 {
1011     dim_decl_t *dim_decl = stat->dim_decls;
1012 
1013     while(1) {
1014         if(lookup_dim_decls(ctx, dim_decl->name) || lookup_args_name(ctx, dim_decl->name)
1015            || lookup_const_decls(ctx, dim_decl->name, FALSE)) {
1016             FIXME("dim %s name redefined\n", debugstr_w(dim_decl->name));
1017             return E_FAIL;
1018         }
1019 
1020         ctx->func->var_cnt++;
1021 
1022         if(dim_decl->is_array) {
1023             HRESULT hres = push_instr_bstr_uint(ctx, OP_dim, dim_decl->name, ctx->func->array_cnt++);
1024             if(FAILED(hres))
1025                 return hres;
1026 
1027             if(!emit_catch(ctx, 0))
1028                 return E_OUTOFMEMORY;
1029         }
1030 
1031         if(!dim_decl->next)
1032             break;
1033         dim_decl = dim_decl->next;
1034     }
1035 
1036     if(ctx->dim_decls_tail)
1037         ctx->dim_decls_tail->next = stat->dim_decls;
1038     else
1039         ctx->dim_decls = stat->dim_decls;
1040     ctx->dim_decls_tail = dim_decl;
1041     return S_OK;
1042 }
1043 
1044 static HRESULT compile_const_statement(compile_ctx_t *ctx, const_statement_t *stat)
1045 {
1046     const_decl_t *decl, *next_decl = stat->decls;
1047 
1048     do {
1049         decl = next_decl;
1050 
1051         if(lookup_const_decls(ctx, decl->name, FALSE) || lookup_args_name(ctx, decl->name)
1052                 || lookup_dim_decls(ctx, decl->name)) {
1053             FIXME("%s redefined\n", debugstr_w(decl->name));
1054             return E_FAIL;
1055         }
1056 
1057         if(ctx->func->type == FUNC_GLOBAL) {
1058             HRESULT hres;
1059 
1060             hres = compile_expression(ctx, decl->value_expr);
1061             if(FAILED(hres))
1062                 return hres;
1063 
1064             hres = push_instr_bstr(ctx, OP_const, decl->name);
1065             if(FAILED(hres))
1066                 return hres;
1067 
1068             if(!emit_catch(ctx, 0))
1069                 return E_OUTOFMEMORY;
1070         }
1071 
1072         next_decl = decl->next;
1073         decl->next = ctx->const_decls;
1074         ctx->const_decls = decl;
1075     } while(next_decl);
1076 
1077     return S_OK;
1078 }
1079 
1080 static HRESULT compile_function_statement(compile_ctx_t *ctx, function_statement_t *stat)
1081 {
1082     if(ctx->func != &ctx->code->main_code) {
1083         FIXME("Function is not in the global code\n");
1084         return E_FAIL;
1085     }
1086 
1087     stat->func_decl->next = ctx->func_decls;
1088     ctx->func_decls = stat->func_decl;
1089     return S_OK;
1090 }
1091 
1092 static HRESULT compile_exitdo_statement(compile_ctx_t *ctx)
1093 {
1094     statement_ctx_t *iter;
1095     unsigned pop_cnt = 0;
1096 
1097     for(iter = ctx->stat_ctx; iter; iter = iter->next) {
1098         pop_cnt += iter->stack_use;
1099         if(iter->while_end_label)
1100             break;
1101     }
1102     if(!iter) {
1103         FIXME("Exit Do outside Do Loop\n");
1104         return E_FAIL;
1105     }
1106 
1107     if(pop_cnt) {
1108         HRESULT hres;
1109 
1110         hres = push_instr_uint(ctx, OP_pop, pop_cnt);
1111         if(FAILED(hres))
1112             return hres;
1113     }
1114 
1115     return push_instr_addr(ctx, OP_jmp, iter->while_end_label);
1116 }
1117 
1118 static HRESULT compile_exitfor_statement(compile_ctx_t *ctx)
1119 {
1120     statement_ctx_t *iter;
1121     unsigned pop_cnt = 0;
1122 
1123     for(iter = ctx->stat_ctx; iter; iter = iter->next) {
1124         pop_cnt += iter->stack_use;
1125         if(iter->for_end_label)
1126             break;
1127     }
1128     if(!iter) {
1129         FIXME("Exit For outside For loop\n");
1130         return E_FAIL;
1131     }
1132 
1133     if(pop_cnt) {
1134         HRESULT hres;
1135 
1136         hres = push_instr_uint(ctx, OP_pop, pop_cnt);
1137         if(FAILED(hres))
1138             return hres;
1139     }
1140 
1141     return push_instr_addr(ctx, OP_jmp, iter->for_end_label);
1142 }
1143 
1144 static HRESULT exit_label(compile_ctx_t *ctx, unsigned jmp_label)
1145 {
1146     unsigned pop_cnt = stack_offset(ctx);
1147 
1148     if(pop_cnt) {
1149         HRESULT hres;
1150 
1151         hres = push_instr_uint(ctx, OP_pop, pop_cnt);
1152         if(FAILED(hres))
1153             return hres;
1154     }
1155 
1156     return push_instr_addr(ctx, OP_jmp, jmp_label);
1157 }
1158 
1159 static HRESULT compile_exitsub_statement(compile_ctx_t *ctx)
1160 {
1161     if(!ctx->sub_end_label) {
1162         FIXME("Exit Sub outside Sub?\n");
1163         return E_FAIL;
1164     }
1165 
1166     return exit_label(ctx, ctx->sub_end_label);
1167 }
1168 
1169 static HRESULT compile_exitfunc_statement(compile_ctx_t *ctx)
1170 {
1171     if(!ctx->func_end_label) {
1172         FIXME("Exit Function outside Function?\n");
1173         return E_FAIL;
1174     }
1175 
1176     return exit_label(ctx, ctx->func_end_label);
1177 }
1178 
1179 static HRESULT compile_exitprop_statement(compile_ctx_t *ctx)
1180 {
1181     if(!ctx->prop_end_label) {
1182         FIXME("Exit Property outside Property?\n");
1183         return E_FAIL;
1184     }
1185 
1186     return exit_label(ctx, ctx->prop_end_label);
1187 }
1188 
1189 static HRESULT compile_onerror_statement(compile_ctx_t *ctx, onerror_statement_t *stat)
1190 {
1191     return push_instr_int(ctx, OP_errmode, stat->resume_next);
1192 }
1193 
1194 static HRESULT compile_statement(compile_ctx_t *ctx, statement_ctx_t *stat_ctx, statement_t *stat)
1195 {
1196     HRESULT hres;
1197 
1198     if(stat_ctx) {
1199         stat_ctx->next = ctx->stat_ctx;
1200         ctx->stat_ctx = stat_ctx;
1201     }
1202 
1203     while(stat) {
1204         switch(stat->type) {
1205         case STAT_ASSIGN:
1206             hres = compile_assign_statement(ctx, (assign_statement_t*)stat, FALSE);
1207             break;
1208         case STAT_CALL:
1209             hres = compile_call_statement(ctx, (call_statement_t*)stat);
1210             break;
1211         case STAT_CONST:
1212             hres = compile_const_statement(ctx, (const_statement_t*)stat);
1213             break;
1214         case STAT_DIM:
1215             hres = compile_dim_statement(ctx, (dim_statement_t*)stat);
1216             break;
1217         case STAT_DOWHILE:
1218         case STAT_DOUNTIL:
1219             hres = compile_dowhile_statement(ctx, (while_statement_t*)stat);
1220             break;
1221         case STAT_EXITDO:
1222             hres = compile_exitdo_statement(ctx);
1223             break;
1224         case STAT_EXITFOR:
1225             hres = compile_exitfor_statement(ctx);
1226             break;
1227         case STAT_EXITFUNC:
1228             hres = compile_exitfunc_statement(ctx);
1229             break;
1230         case STAT_EXITPROP:
1231             hres = compile_exitprop_statement(ctx);
1232             break;
1233         case STAT_EXITSUB:
1234             hres = compile_exitsub_statement(ctx);
1235             break;
1236         case STAT_FOREACH:
1237             hres = compile_foreach_statement(ctx, (foreach_statement_t*)stat);
1238             break;
1239         case STAT_FORTO:
1240             hres = compile_forto_statement(ctx, (forto_statement_t*)stat);
1241             break;
1242         case STAT_FUNC:
1243             hres = compile_function_statement(ctx, (function_statement_t*)stat);
1244             break;
1245         case STAT_IF:
1246             hres = compile_if_statement(ctx, (if_statement_t*)stat);
1247             break;
1248         case STAT_ONERROR:
1249             hres = compile_onerror_statement(ctx, (onerror_statement_t*)stat);
1250             break;
1251         case STAT_SELECT:
1252             hres = compile_select_statement(ctx, (select_statement_t*)stat);
1253             break;
1254         case STAT_SET:
1255             hres = compile_assign_statement(ctx, (assign_statement_t*)stat, TRUE);
1256             break;
1257         case STAT_STOP:
1258             hres = push_instr(ctx, OP_stop) ? S_OK : E_OUTOFMEMORY;
1259             break;
1260         case STAT_UNTIL:
1261         case STAT_WHILE:
1262         case STAT_WHILELOOP:
1263             hres = compile_while_statement(ctx, (while_statement_t*)stat);
1264             break;
1265         default:
1266             FIXME("Unimplemented statement type %d\n", stat->type);
1267             hres = E_NOTIMPL;
1268         }
1269 
1270         if(FAILED(hres))
1271             return hres;
1272         stat = stat->next;
1273     }
1274 
1275     if(stat_ctx) {
1276         assert(ctx->stat_ctx == stat_ctx);
1277         ctx->stat_ctx = stat_ctx->next;
1278     }
1279 
1280     return S_OK;
1281 }
1282 
1283 static void resolve_labels(compile_ctx_t *ctx, unsigned off)
1284 {
1285     instr_t *instr;
1286 
1287     for(instr = ctx->code->instrs+off; instr < ctx->code->instrs+ctx->instr_cnt; instr++) {
1288         if(instr_info[instr->op].arg1_type == ARG_ADDR && (instr->arg1.uint & LABEL_FLAG)) {
1289             assert((instr->arg1.uint & ~LABEL_FLAG) < ctx->labels_cnt);
1290             instr->arg1.uint = ctx->labels[instr->arg1.uint & ~LABEL_FLAG];
1291         }
1292         assert(instr_info[instr->op].arg2_type != ARG_ADDR);
1293     }
1294 
1295     ctx->labels_cnt = 0;
1296 }
1297 
1298 static HRESULT fill_array_desc(compile_ctx_t *ctx, dim_decl_t *dim_decl, array_desc_t *array_desc)
1299 {
1300     unsigned dim_cnt = 0, i;
1301     dim_list_t *iter;
1302 
1303     for(iter = dim_decl->dims; iter; iter = iter->next)
1304         dim_cnt++;
1305 
1306     array_desc->bounds = compiler_alloc(ctx->code, dim_cnt * sizeof(SAFEARRAYBOUND));
1307     if(!array_desc->bounds)
1308         return E_OUTOFMEMORY;
1309 
1310     array_desc->dim_cnt = dim_cnt;
1311 
1312     for(iter = dim_decl->dims, i=0; iter; iter = iter->next, i++) {
1313         array_desc->bounds[i].cElements = iter->val+1;
1314         array_desc->bounds[i].lLbound = 0;
1315     }
1316 
1317     return S_OK;
1318 }
1319 
1320 static HRESULT compile_func(compile_ctx_t *ctx, statement_t *stat, function_t *func)
1321 {
1322     HRESULT hres;
1323 
1324     func->code_off = ctx->instr_cnt;
1325 
1326     ctx->sub_end_label = 0;
1327     ctx->func_end_label = 0;
1328     ctx->prop_end_label = 0;
1329 
1330     switch(func->type) {
1331     case FUNC_FUNCTION:
1332         ctx->func_end_label = alloc_label(ctx);
1333         if(!ctx->func_end_label)
1334             return E_OUTOFMEMORY;
1335         break;
1336     case FUNC_SUB:
1337         ctx->sub_end_label = alloc_label(ctx);
1338         if(!ctx->sub_end_label)
1339             return E_OUTOFMEMORY;
1340         break;
1341     case FUNC_PROPGET:
1342     case FUNC_PROPLET:
1343     case FUNC_PROPSET:
1344     case FUNC_DEFGET:
1345         ctx->prop_end_label = alloc_label(ctx);
1346         if(!ctx->prop_end_label)
1347             return E_OUTOFMEMORY;
1348         break;
1349     case FUNC_GLOBAL:
1350         break;
1351     }
1352 
1353     ctx->func = func;
1354     ctx->dim_decls = ctx->dim_decls_tail = NULL;
1355     ctx->const_decls = NULL;
1356     hres = compile_statement(ctx, NULL, stat);
1357     ctx->func = NULL;
1358     if(FAILED(hres))
1359         return hres;
1360 
1361     if(ctx->sub_end_label)
1362         label_set_addr(ctx, ctx->sub_end_label);
1363     if(ctx->func_end_label)
1364         label_set_addr(ctx, ctx->func_end_label);
1365     if(ctx->prop_end_label)
1366         label_set_addr(ctx, ctx->prop_end_label);
1367 
1368     if(!push_instr(ctx, OP_ret))
1369         return E_OUTOFMEMORY;
1370 
1371     resolve_labels(ctx, func->code_off);
1372 
1373     if(func->var_cnt) {
1374         dim_decl_t *dim_decl;
1375 
1376         if(func->type == FUNC_GLOBAL) {
1377             dynamic_var_t *new_var;
1378 
1379             func->var_cnt = 0;
1380 
1381             for(dim_decl = ctx->dim_decls; dim_decl; dim_decl = dim_decl->next) {
1382                 new_var = compiler_alloc(ctx->code, sizeof(*new_var));
1383                 if(!new_var)
1384                     return E_OUTOFMEMORY;
1385 
1386                 new_var->name = compiler_alloc_string(ctx->code, dim_decl->name);
1387                 if(!new_var->name)
1388                     return E_OUTOFMEMORY;
1389 
1390                 V_VT(&new_var->v) = VT_EMPTY;
1391                 new_var->is_const = FALSE;
1392 
1393                 new_var->next = ctx->global_vars;
1394                 ctx->global_vars = new_var;
1395             }
1396         }else {
1397             unsigned i;
1398 
1399             func->vars = compiler_alloc(ctx->code, func->var_cnt * sizeof(var_desc_t));
1400             if(!func->vars)
1401                 return E_OUTOFMEMORY;
1402 
1403             for(dim_decl = ctx->dim_decls, i=0; dim_decl; dim_decl = dim_decl->next, i++) {
1404                 func->vars[i].name = compiler_alloc_string(ctx->code, dim_decl->name);
1405                 if(!func->vars[i].name)
1406                     return E_OUTOFMEMORY;
1407             }
1408 
1409             assert(i == func->var_cnt);
1410         }
1411     }
1412 
1413     if(func->array_cnt) {
1414         unsigned array_id = 0;
1415         dim_decl_t *dim_decl;
1416 
1417         func->array_descs = compiler_alloc(ctx->code, func->array_cnt * sizeof(array_desc_t));
1418         if(!func->array_descs)
1419             return E_OUTOFMEMORY;
1420 
1421         for(dim_decl = ctx->dim_decls; dim_decl; dim_decl = dim_decl->next) {
1422             if(dim_decl->is_array) {
1423                 hres = fill_array_desc(ctx, dim_decl, func->array_descs + array_id++);
1424                 if(FAILED(hres))
1425                     return hres;
1426             }
1427         }
1428 
1429         assert(array_id == func->array_cnt);
1430     }
1431 
1432     return S_OK;
1433 }
1434 
1435 static BOOL lookup_funcs_name(compile_ctx_t *ctx, const WCHAR *name)
1436 {
1437     function_t *iter;
1438 
1439     for(iter = ctx->funcs; iter; iter = iter->next) {
1440         if(!strcmpiW(iter->name, name))
1441             return TRUE;
1442     }
1443 
1444     return FALSE;
1445 }
1446 
1447 static HRESULT create_function(compile_ctx_t *ctx, function_decl_t *decl, function_t **ret)
1448 {
1449     function_t *func;
1450     HRESULT hres;
1451 
1452     if(lookup_dim_decls(ctx, decl->name) || lookup_funcs_name(ctx, decl->name) || lookup_const_decls(ctx, decl->name, FALSE)) {
1453         FIXME("%s: redefinition\n", debugstr_w(decl->name));
1454         return E_FAIL;
1455     }
1456 
1457     func = compiler_alloc(ctx->code, sizeof(*func));
1458     if(!func)
1459         return E_OUTOFMEMORY;
1460 
1461     func->name = compiler_alloc_string(ctx->code, decl->name);
1462     if(!func->name)
1463         return E_OUTOFMEMORY;
1464 
1465     func->vars = NULL;
1466     func->var_cnt = 0;
1467     func->array_cnt = 0;
1468     func->code_ctx = ctx->code;
1469     func->type = decl->type;
1470     func->is_public = decl->is_public;
1471 
1472     func->arg_cnt = 0;
1473     if(decl->args) {
1474         arg_decl_t *arg;
1475         unsigned i;
1476 
1477         for(arg = decl->args; arg; arg = arg->next)
1478             func->arg_cnt++;
1479 
1480         func->args = compiler_alloc(ctx->code, func->arg_cnt * sizeof(arg_desc_t));
1481         if(!func->args)
1482             return E_OUTOFMEMORY;
1483 
1484         for(i = 0, arg = decl->args; arg; arg = arg->next, i++) {
1485             func->args[i].name = compiler_alloc_string(ctx->code, arg->name);
1486             if(!func->args[i].name)
1487                 return E_OUTOFMEMORY;
1488             func->args[i].by_ref = arg->by_ref;
1489         }
1490     }else {
1491         func->args = NULL;
1492     }
1493 
1494     hres = compile_func(ctx, decl->body, func);
1495     if(FAILED(hres))
1496         return hres;
1497 
1498     *ret = func;
1499     return S_OK;
1500 }
1501 
1502 static BOOL lookup_class_name(compile_ctx_t *ctx, const WCHAR *name)
1503 {
1504     class_desc_t *iter;
1505 
1506     for(iter = ctx->classes; iter; iter = iter->next) {
1507         if(!strcmpiW(iter->name, name))
1508             return TRUE;
1509     }
1510 
1511     return FALSE;
1512 }
1513 
1514 static HRESULT create_class_funcprop(compile_ctx_t *ctx, function_decl_t *func_decl, vbdisp_funcprop_desc_t *desc)
1515 {
1516     vbdisp_invoke_type_t invoke_type;
1517     function_decl_t *funcprop_decl;
1518     HRESULT hres;
1519 
1520     desc->name = compiler_alloc_string(ctx->code, func_decl->name);
1521     if(!desc->name)
1522         return E_OUTOFMEMORY;
1523 
1524     for(funcprop_decl = func_decl; funcprop_decl; funcprop_decl = funcprop_decl->next_prop_func) {
1525         switch(funcprop_decl->type) {
1526         case FUNC_FUNCTION:
1527         case FUNC_SUB:
1528         case FUNC_PROPGET:
1529         case FUNC_DEFGET:
1530             invoke_type = VBDISP_CALLGET;
1531             break;
1532         case FUNC_PROPLET:
1533             invoke_type = VBDISP_LET;
1534             break;
1535         case FUNC_PROPSET:
1536             invoke_type = VBDISP_SET;
1537             break;
1538         DEFAULT_UNREACHABLE;
1539         }
1540 
1541         assert(!desc->entries[invoke_type]);
1542 
1543         if(funcprop_decl->is_public)
1544             desc->is_public = TRUE;
1545 
1546         hres = create_function(ctx, funcprop_decl, desc->entries+invoke_type);
1547         if(FAILED(hres))
1548             return hres;
1549     }
1550 
1551     return S_OK;
1552 }
1553 
1554 static BOOL lookup_class_funcs(class_desc_t *class_desc, const WCHAR *name)
1555 {
1556     unsigned i;
1557 
1558     for(i=0; i < class_desc->func_cnt; i++) {
1559         if(class_desc->funcs[i].name && !strcmpiW(class_desc->funcs[i].name, name))
1560             return TRUE;
1561     }
1562 
1563     return FALSE;
1564 }
1565 
1566 static HRESULT compile_class(compile_ctx_t *ctx, class_decl_t *class_decl)
1567 {
1568     function_decl_t *func_decl, *func_prop_decl;
1569     class_desc_t *class_desc;
1570     dim_decl_t *prop_decl;
1571     unsigned i;
1572     HRESULT hres;
1573 
1574     static const WCHAR class_initializeW[] = {'c','l','a','s','s','_','i','n','i','t','i','a','l','i','z','e',0};
1575     static const WCHAR class_terminateW[] = {'c','l','a','s','s','_','t','e','r','m','i','n','a','t','e',0};
1576 
1577     if(lookup_dim_decls(ctx, class_decl->name) || lookup_funcs_name(ctx, class_decl->name)
1578             || lookup_const_decls(ctx, class_decl->name, FALSE) || lookup_class_name(ctx, class_decl->name)) {
1579         FIXME("%s: redefinition\n", debugstr_w(class_decl->name));
1580         return E_FAIL;
1581     }
1582 
1583     class_desc = compiler_alloc_zero(ctx->code, sizeof(*class_desc));
1584     if(!class_desc)
1585         return E_OUTOFMEMORY;
1586 
1587     class_desc->name = compiler_alloc_string(ctx->code, class_decl->name);
1588     if(!class_desc->name)
1589         return E_OUTOFMEMORY;
1590 
1591     class_desc->func_cnt = 1; /* always allocate slot for default getter */
1592 
1593     for(func_decl = class_decl->funcs; func_decl; func_decl = func_decl->next) {
1594         for(func_prop_decl = func_decl; func_prop_decl; func_prop_decl = func_prop_decl->next_prop_func) {
1595             if(func_prop_decl->type == FUNC_DEFGET)
1596                 break;
1597         }
1598         if(!func_prop_decl)
1599             class_desc->func_cnt++;
1600     }
1601 
1602     class_desc->funcs = compiler_alloc(ctx->code, class_desc->func_cnt*sizeof(*class_desc->funcs));
1603     if(!class_desc->funcs)
1604         return E_OUTOFMEMORY;
1605     memset(class_desc->funcs, 0, class_desc->func_cnt*sizeof(*class_desc->funcs));
1606 
1607     for(func_decl = class_decl->funcs, i=1; func_decl; func_decl = func_decl->next, i++) {
1608         for(func_prop_decl = func_decl; func_prop_decl; func_prop_decl = func_prop_decl->next_prop_func) {
1609             if(func_prop_decl->type == FUNC_DEFGET) {
1610                 i--;
1611                 break;
1612             }
1613         }
1614 
1615         if(!strcmpiW(class_initializeW, func_decl->name)) {
1616             if(func_decl->type != FUNC_SUB) {
1617                 FIXME("class initializer is not sub\n");
1618                 return E_FAIL;
1619             }
1620 
1621             class_desc->class_initialize_id = i;
1622         }else  if(!strcmpiW(class_terminateW, func_decl->name)) {
1623             if(func_decl->type != FUNC_SUB) {
1624                 FIXME("class terminator is not sub\n");
1625                 return E_FAIL;
1626             }
1627 
1628             class_desc->class_terminate_id = i;
1629         }
1630 
1631         hres = create_class_funcprop(ctx, func_decl, class_desc->funcs + (func_prop_decl ? 0 : i));
1632         if(FAILED(hres))
1633             return hres;
1634     }
1635 
1636     for(prop_decl = class_decl->props; prop_decl; prop_decl = prop_decl->next)
1637         class_desc->prop_cnt++;
1638 
1639     class_desc->props = compiler_alloc(ctx->code, class_desc->prop_cnt*sizeof(*class_desc->props));
1640     if(!class_desc->props)
1641         return E_OUTOFMEMORY;
1642 
1643     for(prop_decl = class_decl->props, i=0; prop_decl; prop_decl = prop_decl->next, i++) {
1644         if(lookup_class_funcs(class_desc, prop_decl->name)) {
1645             FIXME("Property %s redefined\n", debugstr_w(prop_decl->name));
1646             return E_FAIL;
1647         }
1648 
1649         class_desc->props[i].name = compiler_alloc_string(ctx->code, prop_decl->name);
1650         if(!class_desc->props[i].name)
1651             return E_OUTOFMEMORY;
1652 
1653         class_desc->props[i].is_public = prop_decl->is_public;
1654         class_desc->props[i].is_array = prop_decl->is_array;
1655 
1656         if(prop_decl->is_array)
1657             class_desc->array_cnt++;
1658     }
1659 
1660     if(class_desc->array_cnt) {
1661         class_desc->array_descs = compiler_alloc(ctx->code, class_desc->array_cnt*sizeof(*class_desc->array_descs));
1662         if(!class_desc->array_descs)
1663             return E_OUTOFMEMORY;
1664 
1665         for(prop_decl = class_decl->props, i=0; prop_decl; prop_decl = prop_decl->next) {
1666             if(prop_decl->is_array) {
1667                 hres = fill_array_desc(ctx, prop_decl, class_desc->array_descs + i++);
1668                 if(FAILED(hres))
1669                     return hres;
1670             }
1671         }
1672     }
1673 
1674     class_desc->next = ctx->classes;
1675     ctx->classes = class_desc;
1676     return S_OK;
1677 }
1678 
1679 static BOOL lookup_script_identifier(script_ctx_t *script, const WCHAR *identifier)
1680 {
1681     class_desc_t *class;
1682     dynamic_var_t *var;
1683     function_t *func;
1684 
1685     for(var = script->global_vars; var; var = var->next) {
1686         if(!strcmpiW(var->name, identifier))
1687             return TRUE;
1688     }
1689 
1690     for(func = script->global_funcs; func; func = func->next) {
1691         if(!strcmpiW(func->name, identifier))
1692             return TRUE;
1693     }
1694 
1695     for(class = script->classes; class; class = class->next) {
1696         if(!strcmpiW(class->name, identifier))
1697             return TRUE;
1698     }
1699 
1700     return FALSE;
1701 }
1702 
1703 static HRESULT check_script_collisions(compile_ctx_t *ctx, script_ctx_t *script)
1704 {
1705     class_desc_t *class;
1706     dynamic_var_t *var;
1707     function_t *func;
1708 
1709     for(var = ctx->global_vars; var; var = var->next) {
1710         if(lookup_script_identifier(script, var->name)) {
1711             FIXME("%s: redefined\n", debugstr_w(var->name));
1712             return E_FAIL;
1713         }
1714     }
1715 
1716     for(func = ctx->funcs; func; func = func->next) {
1717         if(lookup_script_identifier(script, func->name)) {
1718             FIXME("%s: redefined\n", debugstr_w(func->name));
1719             return E_FAIL;
1720         }
1721     }
1722 
1723     for(class = ctx->classes; class; class = class->next) {
1724         if(lookup_script_identifier(script, class->name)) {
1725             FIXME("%s: redefined\n", debugstr_w(class->name));
1726             return E_FAIL;
1727         }
1728     }
1729 
1730     return S_OK;
1731 }
1732 
1733 void release_vbscode(vbscode_t *code)
1734 {
1735     unsigned i;
1736 
1737     list_remove(&code->entry);
1738 
1739     for(i=0; i < code->bstr_cnt; i++)
1740         SysFreeString(code->bstr_pool[i]);
1741 
1742     heap_pool_free(&code->heap);
1743 
1744     heap_free(code->bstr_pool);
1745     heap_free(code->source);
1746     heap_free(code->instrs);
1747     heap_free(code);
1748 }
1749 
1750 static vbscode_t *alloc_vbscode(compile_ctx_t *ctx, const WCHAR *source)
1751 {
1752     vbscode_t *ret;
1753 
1754     ret = heap_alloc(sizeof(*ret));
1755     if(!ret)
1756         return NULL;
1757 
1758     ret->source = heap_strdupW(source);
1759     if(!ret->source) {
1760         heap_free(ret);
1761         return NULL;
1762     }
1763 
1764     ret->instrs = heap_alloc(32*sizeof(instr_t));
1765     if(!ret->instrs) {
1766         release_vbscode(ret);
1767         return NULL;
1768     }
1769 
1770     ctx->instr_cnt = 1;
1771     ctx->instr_size = 32;
1772     heap_pool_init(&ret->heap);
1773 
1774     ret->option_explicit = ctx->parser.option_explicit;
1775 
1776     ret->bstr_pool = NULL;
1777     ret->bstr_pool_size = 0;
1778     ret->bstr_cnt = 0;
1779     ret->pending_exec = FALSE;
1780 
1781     ret->main_code.type = FUNC_GLOBAL;
1782     ret->main_code.name = NULL;
1783     ret->main_code.code_ctx = ret;
1784     ret->main_code.vars = NULL;
1785     ret->main_code.var_cnt = 0;
1786     ret->main_code.array_cnt = 0;
1787     ret->main_code.arg_cnt = 0;
1788     ret->main_code.args = NULL;
1789 
1790     list_init(&ret->entry);
1791     return ret;
1792 }
1793 
1794 static void release_compiler(compile_ctx_t *ctx)
1795 {
1796     parser_release(&ctx->parser);
1797     heap_free(ctx->labels);
1798     if(ctx->code)
1799         release_vbscode(ctx->code);
1800 }
1801 
1802 HRESULT compile_script(script_ctx_t *script, const WCHAR *src, const WCHAR *delimiter, vbscode_t **ret)
1803 {
1804     function_t *new_func;
1805     function_decl_t *func_decl;
1806     class_decl_t *class_decl;
1807     compile_ctx_t ctx;
1808     vbscode_t *code;
1809     HRESULT hres;
1810 
1811     hres = parse_script(&ctx.parser, src, delimiter);
1812     if(FAILED(hres))
1813         return hres;
1814 
1815     code = ctx.code = alloc_vbscode(&ctx, src);
1816     if(!ctx.code)
1817         return E_OUTOFMEMORY;
1818 
1819     ctx.funcs = NULL;
1820     ctx.func_decls = NULL;
1821     ctx.global_vars = NULL;
1822     ctx.classes = NULL;
1823     ctx.labels = NULL;
1824     ctx.global_consts = NULL;
1825     ctx.stat_ctx = NULL;
1826     ctx.labels_cnt = ctx.labels_size = 0;
1827 
1828     hres = compile_func(&ctx, ctx.parser.stats, &ctx.code->main_code);
1829     if(FAILED(hres)) {
1830         release_compiler(&ctx);
1831         return hres;
1832     }
1833 
1834     ctx.global_consts = ctx.const_decls;
1835 
1836     for(func_decl = ctx.func_decls; func_decl; func_decl = func_decl->next) {
1837         hres = create_function(&ctx, func_decl, &new_func);
1838         if(FAILED(hres)) {
1839             release_compiler(&ctx);
1840             return hres;
1841         }
1842 
1843         new_func->next = ctx.funcs;
1844         ctx.funcs = new_func;
1845     }
1846 
1847     for(class_decl = ctx.parser.class_decls; class_decl; class_decl = class_decl->next) {
1848         hres = compile_class(&ctx, class_decl);
1849         if(FAILED(hres)) {
1850             release_compiler(&ctx);
1851             return hres;
1852         }
1853     }
1854 
1855     hres = check_script_collisions(&ctx, script);
1856     if(FAILED(hres)) {
1857         release_compiler(&ctx);
1858         return hres;
1859     }
1860 
1861     if(ctx.global_vars) {
1862         dynamic_var_t *var;
1863 
1864         for(var = ctx.global_vars; var->next; var = var->next);
1865 
1866         var->next = script->global_vars;
1867         script->global_vars = ctx.global_vars;
1868     }
1869 
1870     if(ctx.funcs) {
1871         for(new_func = ctx.funcs; new_func->next; new_func = new_func->next);
1872 
1873         new_func->next = script->global_funcs;
1874         script->global_funcs = ctx.funcs;
1875     }
1876 
1877     if(ctx.classes) {
1878         class_desc_t *class = ctx.classes;
1879 
1880         while(1) {
1881             class->ctx = script;
1882             if(!class->next)
1883                 break;
1884             class = class->next;
1885         }
1886 
1887         class->next = script->classes;
1888         script->classes = ctx.classes;
1889     }
1890 
1891     if(TRACE_ON(vbscript_disas))
1892         dump_code(&ctx);
1893 
1894     ctx.code = NULL;
1895     release_compiler(&ctx);
1896 
1897     list_add_tail(&script->code_list, &code->entry);
1898     *ret = code;
1899     return S_OK;
1900 }
1901