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);
}
