void CodeGen::generate(node *cur){ if(cur){ int a = 0, bool_jump = 0; std::string jump = ""; if(!cur -> data.compare("block")){ scope_level++; } else if(!cur -> data.compare("var_decl")){ generate_var_decl(cur -> child); } else if(!cur -> data.compare("assignment")){ generate_assignment(cur -> child); } else if(!cur -> data.compare("if")){ jump = generate_if(cur -> child); a = code_ptr; } else if(!cur -> data.compare("while")){ bool_jump = code_ptr + 1; a = code_ptr; } else if(!cur -> data.compare("print")){ generate_print(cur -> child); } generate(cur -> child); if(!cur -> data.compare("block")){ scope_level--; } else if(!cur -> data.compare("if")){ std::map<std::string, int>::iterator j = find_jump(jump); j -> second = code_ptr - a; // std::cout << "If Jump Distance: " << j -> second << std::endl; } else if(!cur -> data.compare("while")){ jump = generate_while(cur -> child); std::map<std::string, int>::iterator j = find_jump(jump); // i = find_jump(branch_not_equal()); // j -> second = code_ptr - a; j -> second = 256 - (code_ptr - bool_jump) - 1; } generate(cur -> younger_sibling); } }
int main() { // struct vm vm; char bytecode[2000]; char *tmp; // vm_init(&vm); tmp = generate_if(bytecode); // ip = generate_push(bytecode,30); // ip = generate_add(bytecode,4,5); *tmp = DONE; print_bytecode(bytecode); // vm_eval(&vm,bytecode); printf("result: %d",vm(bytecode)); return 0; }
static void generate_update_var( struct kconfig * scfg, int menu_num ) { struct kconfig * cfg; if ( menu_num>0 ) { printf( "proc update_define_menu%d {} {\n", menu_num ); printf( "\tupdate_define_mainmenu\n" ); } else printf( "proc update_define_mainmenu {} {\n" ); clear_globalflags(); global( "CONFIG_MODULES" ); vartable[ get_varnum( "CONFIG_MODULES" ) ].global_written = 1; for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { if ( cfg->menu_number == menu_num && (cfg->token == token_define_bool || cfg->token == token_define_tristate || cfg->token == token_define_hex || cfg->token == token_define_int || cfg->token == token_define_string || cfg->token == token_unset || cfg->token == token_tristate) ) { if ( ! vartable[cfg->nameindex].global_written ) { vartable[cfg->nameindex].global_written = 1; global( vartable[cfg->nameindex].name ); } } } /* * set all conditional bool/tristates to off unless changed later */ for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { if (cfg->menu_number != menu_num) continue; if (!cfg->cond) continue; switch (cfg->token) { case token_bool: case token_tristate: if (! vartable[cfg->nameindex].global_written) { vartable[cfg->nameindex].global_written = 1; global(vartable[cfg->nameindex].name); } printf("set %s [expr $%s|16]\n", vartable[cfg->nameindex].name, vartable[cfg->nameindex].name); break; default: break; } } for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { char tmp[20]; struct kconfig * cfg1; if ( cfg->menu_number == menu_num ) { switch ( cfg->token ) { default: case token_choice_item: break; case token_choice_header: sprintf( tmp, "tmpvar_%d", -(cfg->nameindex) ); global( tmp ); for ( cfg1 = cfg->next; cfg1 != NULL && cfg1->token == token_choice_item; cfg1 = cfg1->next ) { vartable[cfg1->nameindex].global_written = 1; global( vartable[cfg1->nameindex].name ); printf( "\tif {$tmpvar_%d == \"%s\"} then {set %s 1} else {set %s 0}\n", -(cfg->nameindex), cfg1->label, vartable[cfg1->nameindex].name, vartable[cfg1->nameindex].name ); } break; case token_bool: case token_define_bool: case token_define_tristate: case token_define_hex: case token_define_int: case token_define_string: case token_dep_bool: case token_dep_tristate: case token_dep_mbool: case token_int: case token_hex: case token_mainmenu_option: case token_tristate: case token_unset: if ( cfg->cond != NULL ) generate_if( cfg, cfg->cond, menu_num, -2 ); else switch ( cfg->token ) { case token_tristate: printf( "\n\tif {($CONFIG_MODULES == 0)} then {if {($%s == 2)} then {set %s 1}}\n", vartable[cfg->nameindex].name, vartable[cfg->nameindex].name ); break; case token_define_bool: case token_define_tristate: if ( ! vartable[get_varnum( cfg->value )].global_written ) { vartable[get_varnum( cfg->value )].global_written = 1; global( cfg->value ); } printf( "\tset %s $%s\n", vartable[cfg->nameindex].name, cfg->value ); break; case token_define_hex: case token_define_int: printf( "\tset %s %s\n", vartable[cfg->nameindex].name, cfg->value ); break; case token_define_string: printf( "\tset %s \"%s\"\n", vartable[cfg->nameindex].name, cfg->value ); break; case token_unset: printf( "\tset %s 4\n", vartable[cfg->nameindex].name ); default: break; } } } } printf( "}\n\n\n" ); }
/* * This is the top level function for generating the tk script. */ void dump_tk_script( struct kconfig * scfg ) { int menu_depth; int menu_num [64]; int imenu, i; int top_level_num = 0; struct kconfig * cfg; struct kconfig * cfg1 = NULL; const char * name = "No Name"; /* * Mark begin and end of each menu so I can omit submenus when walking * over a parent menu. */ tot_menu_num = 0; menu_depth = 0; menu_num [0] = 0; for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { switch ( cfg->token ) { default: break; case token_mainmenu_name: name = cfg->label; break; case token_mainmenu_option: if ( ++menu_depth >= 64 ) { fprintf( stderr, "menus too deep\n" ); exit( 1 ); } if ( ++tot_menu_num >= 100 ) { fprintf( stderr, "too many menus\n" ); exit( 1 ); } menu_num [menu_depth] = tot_menu_num; menu_first [tot_menu_num] = cfg; menu_last [tot_menu_num] = cfg; /* * Note, that menu_number is set to the number of parent * (upper level) menu. */ cfg->menu_number = menu_num[menu_depth - 1]; if ( menu_depth == 1 ) ++top_level_num; break; case token_endmenu: menu_last [menu_num [menu_depth]] = cfg; /* flatten menus with proper scoping */ if ( --menu_depth < 0 ) { fprintf( stderr, "unmatched endmenu\n" ); exit( 1 ); } break; case token_bool: case token_choice_header: case token_choice_item: case token_comment: case token_dep_bool: case token_dep_tristate: case token_dep_mbool: case token_hex: case token_int: case token_string: case token_tristate: cfg->menu_number = menu_num[menu_depth]; if ( menu_depth == 0 ) { fprintf( stderr, "statement not in menu\n" ); exit( 1 ); } break; case token_define_bool: case token_define_hex: case token_define_int: case token_define_string: case token_define_tristate: case token_unset: cfg->menu_number = menu_num[menu_depth]; break; } } /* * Generate menus per column setting. * There are: * four extra buttons for save/quit/load/store; * one blank button * add two to round up for division */ printf( "set menus_per_column %d\n", (top_level_num + 4 + 1 + 2) / 3 ); printf( "set total_menus %d\n\n", tot_menu_num ); printf( "proc toplevel_menu {num} {\n" ); for ( imenu = 1; imenu <= tot_menu_num; ++imenu ) { int parent = 1; if ( menu_first[imenu]->menu_number == 0 ) parent = menu_first[imenu]->menu_number; else printf( "\tif {$num == %d} then {return %d}\n", imenu, menu_first[imenu]->menu_number ); } printf( "\treturn $num\n}\n\n" ); /* * Generate the menus. */ printf( "mainmenu_name \"%s\"\n", name ); for ( imenu = 1; imenu <= tot_menu_num; ++imenu ) { int menu_line = 0; int nr_submenu = imenu; int menu_name_omitted = 0; int opt_count = 0; clear_globalflags(); start_proc( menu_first[imenu]->label, imenu, !menu_first[imenu]->menu_number ); for ( cfg = menu_first[imenu]->next; cfg != NULL && cfg != menu_last[imenu]; cfg = cfg->next ) { switch ( cfg->token ) { default: break; case token_mainmenu_option: while ( menu_first[++nr_submenu]->menu_number > imenu ) ; cfg->menu_line = menu_line++; printf( "\tsubmenu $w.config.f %d %d \"%s\" %d\n", cfg->menu_number, cfg->menu_line, cfg->label, nr_submenu ); cfg = menu_last[nr_submenu]; break; case token_comment: if ( !cfg->menu_line && !menu_name_omitted ) { cfg->menu_line = -1; menu_name_omitted = 1; } else { menu_name_omitted = 1; cfg->menu_line = menu_line++; printf( "\tcomment $w.config.f %d %d \"%s\"\n", cfg->menu_number, cfg->menu_line, cfg->label ); } break; case token_bool: cfg->menu_line = menu_line++; printf( "\tbool $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; case token_choice_header: /* * I need the first token_choice_item to pick out the right * help text from Documentation/Configure.help. */ cfg->menu_line = menu_line++; printf( "\tglobal tmpvar_%d\n", -(cfg->nameindex) ); printf( "\tminimenu $w.config.f %d %d \"%s\" tmpvar_%d %s\n", cfg->menu_number, cfg->menu_line, cfg->label, -(cfg->nameindex), vartable[cfg->next->nameindex].name ); printf( "\tmenu $w.config.f.x%d.x.menu -tearoffcommand \"menutitle \\\"%s\\\"\"\n", cfg->menu_line, cfg->label ); cfg1 = cfg; opt_count = 0; break; case token_choice_item: /* note: no menu line; uses choice header menu line */ printf( "\t$w.config.f.x%d.x.menu add radiobutton -label \"%s\" -variable tmpvar_%d -value \"%s\" -command \"update_active\"\n", cfg1->menu_line, cfg->label, -(cfg1->nameindex), cfg->label ); opt_count++; if ( cfg->next && cfg->next->token != token_choice_item ) { /* last option in the menu */ printf( "\tmenusplit $w $w.config.f.x%d.x.menu %d\n", cfg1->menu_line, opt_count ); } break; case token_dep_bool: case token_dep_mbool: cfg->menu_line = menu_line++; printf( "\tdep_bool $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; case token_dep_tristate: cfg->menu_line = menu_line++; printf( "\tdep_tristate $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; case token_hex: cfg->menu_line = menu_line++; printf( "\thex $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; case token_int: cfg->menu_line = menu_line++; printf( "\tint $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; case token_string: cfg->menu_line = menu_line++; printf( "\tistring $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; case token_tristate: cfg->menu_line = menu_line++; printf( "\ttristate $w.config.f %d %d \"%s\" %s\n", cfg->menu_number, cfg->menu_line, cfg->label, vartable[cfg->nameindex].name ); break; } } end_proc( scfg, imenu ); } /* * The top level menu also needs an update function. When we update a * submenu, we may need to disable one or more of the submenus on * the top level menu, and this procedure will ensure that things are * correct. */ clear_globalflags(); printf( "proc update_mainmenu {} {\n" ); for ( imenu = 1; imenu <= tot_menu_num; imenu++ ) { if ( menu_first[imenu]->cond != NULL && menu_first[imenu]->menu_number == 0 ) generate_if( menu_first[imenu], menu_first[imenu]->cond, imenu, -1 ); } printf( "}\n\n\n" ); clear_globalflags(); /* * Generate code to load the default settings into the variables. * The script in tail.tk will attempt to load .config, * which may override these settings, but that's OK. */ for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { switch ( cfg->token ) { default: break; case token_bool: case token_choice_item: case token_dep_bool: case token_dep_tristate: case token_dep_mbool: case token_tristate: if ( ! vartable[cfg->nameindex].global_written ) { printf( "set %s 0\n", vartable[cfg->nameindex].name ); vartable[cfg->nameindex].global_written = 1; } break; case token_choice_header: printf( "set tmpvar_%d \"(not set)\"\n", -(cfg->nameindex) ); break; case token_hex: case token_int: if ( ! vartable[cfg->nameindex].global_written ) { printf( "set %s %s\n", vartable[cfg->nameindex].name, cfg->value ? cfg->value : "0" ); vartable[cfg->nameindex].global_written = 1; } break; case token_string: if ( ! vartable[cfg->nameindex].global_written ) { printf( "set %s \"%s\"\n", vartable[cfg->nameindex].name, cfg->value ); vartable[cfg->nameindex].global_written = 1; } break; } } /* * Define to an empty value all other variables (which are never defined) */ for ( i = 1; i <= max_varnum; i++ ) { if ( ! vartable[i].global_written && strncmp( vartable[i].name, "CONSTANT_", 9 ) ) printf( "set %s 4\n", vartable[i].name ); } /* * Generate a function to write all of the variables to a file. */ printf( "proc writeconfig {file1 file2} {\n" ); printf( "\tset cfg [open $file1 w]\n" ); printf( "\tset autocfg [open $file2 w]\n" ); printf( "\tset notmod 1\n" ); printf( "\tset notset 0\n" ); printf( "\tputs $cfg \"#\"\n"); printf( "\tputs $cfg \"# Automatically generated make config: don't edit\"\n"); printf( "\tputs $cfg \"#\"\n" ); printf( "\tputs $autocfg \"/*\"\n" ); printf( "\tputs $autocfg \" * Automatically generated C config: don't edit\"\n" ); printf( "\tputs $autocfg \" */\"\n" ); printf( "\tputs $autocfg \"#define AUTOCONF_INCLUDED\"\n" ); clear_globalflags(); for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { switch ( cfg->token ) { default: break; case token_bool: case token_choice_header: case token_comment: case token_define_bool: case token_define_hex: case token_define_int: case token_define_string: case token_define_tristate: case token_dep_bool: case token_dep_tristate: case token_dep_mbool: case token_hex: case token_int: case token_string: case token_tristate: generate_writeconfig( cfg ); break; } } printf( "\tclose $cfg\n" ); printf( "\tclose $autocfg\n" ); printf( "}\n\n\n" ); /* * Generate a simple function that updates the master choice * variable depending upon what values were loaded from a .config * file. */ printf( "proc clear_choices { } {\n" ); for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { if ( cfg->token == token_choice_header ) { for ( cfg1 = cfg->next; cfg1 != NULL && cfg1->token == token_choice_item; cfg1 = cfg1->next ) { printf( "\tglobal %s; set %s 0\n", vartable[cfg1->nameindex].name, vartable[cfg1->nameindex].name ); } } } printf( "}\n\n\n" ); printf( "proc update_choices { } {\n" ); for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { if ( cfg->token == token_choice_header ) { printf( "\tglobal tmpvar_%d\n", -(cfg->nameindex) ); printf("\tset tmpvar_%d \"%s\"\n", -(cfg->nameindex), cfg->value); for ( cfg1 = cfg->next; cfg1 != NULL && cfg1->token == token_choice_item; cfg1 = cfg1->next ) { printf( "\tglobal %s\n", vartable[cfg1->nameindex].name ); printf( "\tif { $%s == 1 } then { set tmpvar_%d \"%s\" }\n", vartable[cfg1->nameindex].name, -(cfg->nameindex), cfg1->label ); } } } printf( "}\n\n\n" ); generate_update_var( scfg, 0 ); /* * That's it. We are done. The output of this file will have header.tk * prepended and tail.tk appended to create an executable wish script. */ }
/* * Generates the end of a menu procedure. */ static void end_proc( struct kconfig * scfg, int menu_num ) { struct kconfig * cfg; printf( "\n\n\n" ); printf( "\tfocus $w\n" ); printf( "\tupdate_active\n" ); printf( "\tglobal winx; global winy\n" ); if ( menu_first[menu_num]->menu_number != 0 ) { printf( "\tif {[winfo exists .menu%d] == 0} then ", menu_first[menu_num]->menu_number ); printf( "{menu%d .menu%d \"%s\"}\n", menu_first[menu_num]->menu_number, menu_first[menu_num]->menu_number, menu_first[menu_first[menu_num]->menu_number]->label ); printf( "\tset winx [expr [winfo x .menu%d]+30]; set winy [expr [winfo y .menu%d]+30]\n", menu_first[menu_num]->menu_number, menu_first[menu_num]->menu_number ); } else printf( "\tset winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]\n" ); printf( "\tif {[winfo exists $w]} then {wm geometry $w +$winx+$winy}\n" ); /* * Now that the whole window is in place, we need to wait for an "update" * so we can tell the canvas what its virtual size should be. * * Unfortunately, this causes some ugly screen-flashing because the whole * window is drawn, and then it is immediately resized. It seems * unavoidable, though, since "frame" objects won't tell us their size * until after an update, and "canvas" objects can't automatically pack * around frames. Sigh. */ printf( "\tupdate idletasks\n" ); printf( "\tif {[winfo exists $w]} then {$w.config.canvas create window 0 0 -anchor nw -window $w.config.f\n\n" ); printf( "\t$w.config.canvas configure \\\n" ); printf( "\t\t-width [expr [winfo reqwidth $w.config.f] + 1]\\\n" ); printf( "\t\t-scrollregion \"-1 -1 [expr [winfo reqwidth $w.config.f] + 1] \\\n" ); printf( "\t\t\t [expr [winfo reqheight $w.config.f] + 1]\"\n\n" ); /* * If the whole canvas will fit in 3/4 of the screen height, do it; * otherwise, resize to around 1/2 the screen and let us scroll. */ printf( "\tset winy [expr [winfo reqh $w] - [winfo reqh $w.config.canvas]]\n" ); printf( "\tset scry [expr [winfo screenh $w] / 2]\n" ); printf( "\tset maxy [expr [winfo screenh $w] * 3 / 4]\n" ); printf( "\tset canvtotal [expr [winfo reqh $w.config.f] + 2]\n" ); printf( "\tif [expr $winy + $canvtotal < $maxy] {\n" ); printf( "\t\t$w.config.canvas configure -height $canvtotal\n" ); printf( "\t} else {\n" ); printf( "\t\t$w.config.canvas configure -height [expr $scry - $winy]\n" ); printf( "\t\t}\n\t}\n" ); /* * Limit the min/max window size. Height can vary, but not width, * because of the limitations of canvas and our laziness. */ printf( "\tupdate idletasks\n" ); printf( "\tif {[winfo exists $w]} then {\n\twm maxsize $w [winfo width $w] [winfo screenheight $w]\n" ); printf( "\twm minsize $w [winfo width $w] 100\n\n" ); printf( "\twm deiconify $w\n" ); printf( "}\n}\n\n" ); /* * Now we generate the companion procedure for the menu we just * generated. This procedure contains all of the code to * disable/enable widgets based upon the settings of the other * widgets, and will be called first when the window is mapped, * and each time one of the buttons in the window are clicked. */ printf( "proc update_menu%d {} {\n", menu_num ); /* * Clear all of the booleans that are defined in this menu. */ clear_globalflags(); for ( cfg = scfg; cfg != NULL; cfg = cfg->next ) { if ( cfg->menu_number == menu_num && cfg->token != token_mainmenu_option && cfg->token != token_choice_item ) { if ( cfg->cond != NULL ) { int i; if ( (cfg->token == token_tristate || cfg->token == token_dep_tristate) && ! vartable[i = get_varnum( "CONFIG_MODULES" )].global_written ) { global( "CONFIG_MODULES" ); vartable[i].global_written = 1; } generate_if( cfg, cfg->cond, cfg->menu_number, cfg->menu_line ); } else { if ( cfg->token == token_tristate ) { int i; if ( ! vartable[cfg->nameindex].global_written ) { vartable[cfg->nameindex].global_written = 1; printf( "\tglobal %s\n", vartable[cfg->nameindex].name ); } if ( ! vartable[i = get_varnum( "CONFIG_MODULES" )].global_written ) { global( "CONFIG_MODULES" ); vartable[i].global_written = 1; } printf( "\n\tif {($CONFIG_MODULES == 1)} then {configure_entry .menu%d.config.f.x%d normal {m}} else {configure_entry .menu%d.config.f.x%d disabled {m}}\n", menu_num, cfg->menu_line, menu_num, cfg->menu_line ); } } } else if ( cfg->token == token_mainmenu_option && cfg->menu_number == menu_num && cfg->cond != NULL ) { generate_if( cfg, cfg->cond, menu_num, cfg->menu_line ); } } printf("}\n\n\n"); generate_update_var( scfg, menu_num ); }
static code_block *generate_block(code_block *parent, block_statement *block, block_iter iter, void *iter_data) { for (symbol_entry *c = block->class_head; c; c = c->next) { generate_class_stub(parent->system, c->classtype); } for (symbol_entry *f = block->function_head; f; f = f->next) { generate_function_stub(parent->system, f->function); } for (symbol_entry *c = block->class_head; c; c = c->next) { generate_class(parent->system, c->classtype); } for (symbol_entry *f = block->function_head; f; f = f->next) { generate_function(parent->system, f->function); } for (statement *node = block->body; node; node = node->next) { switch (node->type) { case S_BLOCK: { code_block *body = fork_block(parent); body = generate_block(body, (block_statement*) node, NULL, NULL); parent = rejoin_block(parent, body); } break; case S_BREAK: case S_CONTINUE: generate_control(parent, (control_statement*) node); parent = NULL; break; case S_DEFINE: parent = generate_define(parent, (define_statement*) node); break; case S_LET: parent = generate_let(parent, (let_statement*) node); break; case S_DO_WHILE: case S_WHILE: parent = generate_loop(parent, (loop_statement*) node); break; case S_EXPRESSION: { expression_statement *express = (expression_statement*) node; parent = generate_expression(parent, express->value); } break; case S_IF: parent = generate_if(parent, (if_statement*) node); break; case S_RETURN: generate_return(parent, (return_statement*) node); parent = NULL; break; // already processed case S_CLASS: case S_FUNCTION: case S_TYPEDEF: break; } // most recently processed statement terminates abruptly if (parent == NULL) { if (node->next) { fprintf(stderr, "not reachable\n"); } return NULL; } if (iter != NULL) { iter(parent, iter_data); } } return parent; }
static void generate_component(component comp, fncode fn) { clist args; set_lineno(comp->lineno, fn); switch (comp->vclass) { case c_assign: { ulong offset; bool is_static; variable_class vclass = env_lookup(comp->u.assign.symbol, &offset, false, true, &is_static); component val = comp->u.assign.value; if (val->vclass == c_closure) { /* Defining a function, give it a name */ if (vclass == global_var) val->u.closure->varname = comp->u.assign.symbol; else { char *varname = allocate(fnmemory(fn), strlen(comp->u.assign.symbol) + 7); sprintf(varname, "local-%s", comp->u.assign.symbol); val->u.closure->varname = varname; } } if (is_static) { ins1(op_recall + vclass, offset, fn); generate_component(comp->u.assign.value, fn); mexecute(g_symbol_set, NULL, 2, fn); break; } generate_component(comp->u.assign.value, fn); set_lineno(comp->lineno, fn); if (vclass == global_var) massign(offset, comp->u.assign.symbol, fn); else ins1(op_assign + vclass, offset, fn); /* Note: varname becomes a dangling pointer when fnmemory(fn) is deallocated, but it is never used again so this does not cause a problem. */ break; } case c_vref: case c_recall: { bool is_vref = comp->vclass == c_vref; ulong offset; bool is_static; variable_class vclass = env_lookup(comp->u.recall, &offset, true, is_vref, &is_static); if (is_static) { assert(vclass != global_var); ins1(op_recall + vclass, offset, fn); ulong gidx = is_vref ? g_make_symbol_ref : g_symbol_get; mexecute(gidx, NULL, 1, fn); break; } if (vclass != global_var) ins1((is_vref ? op_vref : op_recall) + vclass, offset, fn); else if (is_vref) { if (!mwritable(offset, comp->u.recall)) return; ins_constant(makeint(offset), fn); } else mrecall(offset, comp->u.recall, fn); if (is_vref) mexecute(g_make_variable_ref, "make_variable_ref", 1, fn); break; } case c_constant: ins_constant(make_constant(comp->u.cst), fn); break; case c_closure: { uword idx; idx = add_constant(generate_function(comp->u.closure, false, fn), fn); if (idx < ARG1_MAX) ins1(op_closure_code1, idx, fn); else ins2(op_closure_code2, idx, fn); break; } case c_block: generate_block(comp->u.blk, fn); break; case c_labeled: start_block(comp->u.labeled.name, fn); generate_component(comp->u.labeled.expression, fn); end_block(fn); break; case c_exit: generate_component(comp->u.labeled.expression, fn); if (!exit_block(comp->u.labeled.name, fn)) { if (!comp->u.labeled.name) log_error("no loop to exit from"); else log_error("no block labeled %s", comp->u.labeled.name); } break; case c_execute: { uword count; generate_args(comp->u.execute->next, fn, &count); set_lineno(comp->lineno, fn); generate_execute(comp->u.execute->c, count, fn); break; } case c_builtin: args = comp->u.builtin.args; switch (comp->u.builtin.fn) { case b_if: { block cb = new_codeblock(fnmemory(fn), NULL, new_clist(fnmemory(fn), args->next->c, new_clist(fnmemory(fn), component_undefined, NULL)), NULL, NULL, -1); generate_if(args->c, new_component(fnmemory(fn), args->next->c->lineno, c_block, cb), component_undefined, fn); break; } case b_ifelse: generate_if(args->c, args->next->c, args->next->next->c, fn); break; case b_sc_and: case b_sc_or: generate_if(comp, component_true, component_false, fn); break; case b_while: generate_while(args->c, args->next->c, fn); break; case b_loop: { label loop = new_label(fn); env_start_loop(); set_label(loop, fn); start_block(NULL, fn); generate_component(args->c, fn); branch(op_loop1, loop, fn); end_block(fn); env_end_loop(); adjust_depth(1, fn); break; } case b_add: case b_subtract: case b_ref: case b_set: case b_bitor: case b_bitand: case b_not: case b_eq: case b_ne: case b_lt: case b_le: case b_ge: case b_gt: { uword count; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); set_lineno(comp->lineno, fn); ins0(builtin_ops[comp->u.builtin.fn], fn); break; } default: { uword count; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); set_lineno(comp->lineno, fn); mexecute(builtin_functions[comp->u.builtin.fn], NULL, count, fn); break; } } break; default: abort(); } }
void generate_component(component comp, const char *mlabel, bool discard, fncode fn) { clist args; switch (comp->vclass) { case c_assign: { u16 offset; mtype t; variable_class vclass = env_lookup(comp->l, comp->u.assign.symbol, &offset, &t, FALSE); component val = comp->u.assign.value; if (val->vclass == c_closure) { /* Defining a function, give it a name */ if (vclass == global_var) val->u.closure->varname = comp->u.assign.symbol; else { char *varname = allocate(fnmemory(fn), strlen(comp->u.assign.symbol) + 7); sprintf(varname, "local-%s", comp->u.assign.symbol); val->u.closure->varname = varname; } } generate_component(comp->u.assign.value, NULL, FALSE, fn); if (t != stype_any) ins0(OPmscheck4 + t, fn); if (vclass == global_var) massign(comp->l, offset, comp->u.assign.symbol, fn); else if (vclass == closure_var) ins1(OPmwritec, offset, fn); else ins1(OPmwritel, offset, fn); /* Note: varname becomes a dangling pointer when fnmemory(fn) is deallocated, but it is never used again so this does not cause a problem. */ break; } case c_recall: scompile_recall(comp->l, comp->u.recall, fn); break; case c_constant: ins_constant(make_constant(comp->u.cst, FALSE, fn), fn); break; case c_scheme: scheme_compile_mgc(comp->l, make_constant(comp->u.cst, TRUE, fn), discard, fn); discard = FALSE; break; case c_closure: generate_function(comp->u.closure, fn); break; case c_block: generate_block(comp->u.blk, discard, fn); discard = FALSE; break; case c_decl: { vlist decl, next; /* declare variables one at a time (any x = y, y = 2; is an error) */ for (decl = comp->u.decls; decl; decl = next) { next = decl->next; decl->next = NULL; env_declare(decl); generate_decls(decl, fn); } generate_component(component_undefined, NULL, FALSE, fn); break; } case c_labeled: { start_block(comp->u.labeled.name, FALSE, discard, fn); generate_component(comp->u.labeled.expression, comp->u.labeled.name, discard, fn); end_block(fn); discard = FALSE; break; } case c_exit: { bool discard_exit; label exitlab = exit_block(comp->u.labeled.name, FALSE, &discard_exit, fn); if (comp->u.labeled.expression != component_undefined && discard_exit) warning(comp->l, "break result is ignored"); generate_component(comp->u.labeled.expression, NULL, discard_exit, fn); if (exitlab) branch(OPmba3, exitlab, fn); else { if (!comp->u.labeled.name) log_error(comp->l, "No loop to exit from"); else log_error(comp->l, "No block labeled %s", comp->u.labeled.name); } /* Callers expect generate_component to increase stack depth by 1 */ if (discard_exit) adjust_depth(1, fn); break; } case c_continue: { bool discard_exit; /* Meaningless for continue blocks */ label exitlab = exit_block(comp->u.labeled.name, TRUE, &discard_exit, fn); if (exitlab) branch(OPmba3, exitlab, fn); else { if (comp->u.labeled.name[0] == '<') log_error(comp->l, "No loop to continue"); else log_error(comp->l, "No loop labeled %s", comp->u.labeled.name); } /* Callers expect generate_component to increase stack depth by 1 (*/ adjust_depth(1, fn); break; } case c_execute: { u16 count; generate_args(comp->u.execute->next, fn, &count); generate_execute(comp->u.execute->c, count, fn); break; } case c_builtin: args = comp->u.builtin.args; switch (comp->u.builtin.fn) { case b_if: generate_if(args->c, args->next->c, NULL, TRUE, fn); generate_component(component_undefined, NULL, FALSE, fn); break; case b_ifelse: generate_if(args->c, args->next->c, args->next->next->c, discard, fn); discard = FALSE; break; case b_sc_and: case b_sc_or: generate_if(comp, component_true, component_false, discard, fn); discard = FALSE; break; case b_while: enter_loop(fn); generate_while(args->c, args->next->c, mlabel, discard, fn); exit_loop(fn); discard = FALSE; break; case b_dowhile: enter_loop(fn); generate_dowhile(args->c, args->next->c, mlabel, discard, fn); exit_loop(fn); discard = FALSE; break; case b_for: enter_loop(fn); generate_for(args->c, args->next->c, args->next->next->c, args->next->next->next->c, mlabel, discard, fn); exit_loop(fn); discard = FALSE; break; default: { u16 count; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); ins0(builtin_ops[comp->u.builtin.fn], fn); break; } case b_cons: { u16 count; u16 goffset; mtype t; assert(comp->u.builtin.fn < last_builtin); generate_args(args, fn, &count); goffset = global_lookup(fnglobals(fn), builtin_functions[comp->u.builtin.fn], &t); mexecute(comp->l, goffset, NULL, count, fn); break; } } break; default: assert(0); } if (discard) ins0(OPmpop, fn); }