dlls/vbscript/compile.c

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