static Node initialization_proc(Symbol proc_name, Symbol type_name, Tuple formals, Tuple stmts) /*;initialization_proc*/ { /* Build procedure with given formals and statement list. */ Node proc_node; int i, n; Tuple tup; NATURE (proc_name) = na_procedure; n = tup_size(formals); tup = tup_new(n); for (i = 1; i <= n; i++) tup[i] = (char *) N_UNQ((Node)formals[i]); SIGNATURE(proc_name) = tup; generate_object(proc_name); /* * Create as_subprogram_tr node with statements node as N_AST1 * instead of N_AST3 as it is with as_subprogram. */ proc_node = new_node(as_subprogram_tr); N_UNQ(proc_node) = proc_name; N_AST1(proc_node) = new_statements_node(stmts); N_AST2(proc_node) = OPT_NODE; N_AST4(proc_node) = OPT_NODE; return proc_node; }
std::vector<std::string> generate_objects() { std::vector<std::string> obj_names; for (auto const m : modules) { assert(m); obj_names.push_back(generate_object(*m)); } return obj_names; }
Node build_proc_init_rec(Symbol type_name) /*;build_proc_init_rec*/ { /* * This is the main procedure for building default initialization * procedures for record types. Those initialization procedures are * built if the type given contains some subcomponent for which a * default initialization exists (at any level of nesting), or if it * has determinants. * Note that scalar objects are not initialized at all, which implies * that they get whatever initial value is in that location in memory * This saves some time in object creation. * * All init. procedures have an 'out' parameter that designates the * object begin initialized (the space has already been allocated). * */ int side_effect; Node invar_node; /* TBSL: is invar_node local??*/ Tuple stmts, tup, nstmts, formals, invariant_fields; Tuple discr_list; /* is this local ?? TBSL */ Fortup ft1; Symbol d, proc_name; Node param, var_node, out_param; Node node, node1, node2, discr_value_node; #ifdef TRACE if (debug_flag) gen_trace_symbol("BUILD_PROC_INIT_REC", type_name); #endif side_effect = FALSE; /* Let's hope... TBSL */ /* * The initialization procedure for records has the usual out param., * and one in parameter per discriminant. The CONSTRAINED flag is the * first of the discriminants */ proc_name = new_unique_name("Init_ type_name"); out_param = new_param_node("param_type_name", proc_name, type_name, na_out); generate_object(proc_name); generate_object(N_UNQ(out_param)); tup = SIGNATURE(type_name); invar_node = (Node) tup[1]; var_node = (Node) tup[2]; discr_list = (Tuple) tup[3]; invariant_fields = build_comp_names(invar_node); stmts = tup_new(0); if (tup_size(discr_list)) { /* Generate formal parameters for each. The body of the procedure */ /* assigns them to the field of the object. */ /* Note: the 'constrained' field is part of the discriminants. */ formals = tup_new(0); FORTUP(d=(Symbol), discr_list, ft1); param = new_param_node("param_type_name", proc_name, TYPE_OF(d), na_in); generate_object(N_UNQ(param)); formals = tup_with(formals, (char *) param ); stmts = tup_with(stmts, (char *) new_assign_node(new_selector_node(out_param, d), param)); discr_value_node = new_selector_node (out_param, d); /* generate code in order to test if the value of discriminant is * compatible with its subtype */ node1 = new_attribute_node(ATTR_T_FIRST, new_name_node(TYPE_OF(d)), OPT_NODE, TYPE_OF(d)); node2 = new_attribute_node(ATTR_T_LAST, new_name_node(TYPE_OF(d)), OPT_NODE, TYPE_OF(d)); node = node_new (as_list); make_if_node(node, tup_new1((char *) new_cond_stmts_node( new_binop_node(symbol_or, new_binop_node(symbol_lt, discr_value_node, node1, symbol_boolean), new_binop_node(symbol_gt, discr_value_node, node2, symbol_boolean), symbol_boolean), new_raise_node(symbol_constraint_error))), OPT_NODE); stmts = tup_with(stmts, (char *) node); ENDFORTUP(ft1); formals = tup_with(formals, (char *) out_param ); /* if there are default expressions for any other components, */ /* further initialization steps are needed. */ tup = proc_init_rec(type_name, invariant_fields, var_node, out_param); /*stmts += proc_init_rec(invariant_fields, var_node, out_param);*/ nstmts = tup_add(stmts, tup); tup_free(stmts); tup_free(tup); stmts = nstmts; } else { /* record without discriminants. There may still be default values */ /* for some components. */ formals = tup_new1((char *) out_param); stmts = proc_init_rec(type_name,invariant_fields,var_node, out_param); } if (tup_size(stmts)) { INIT_PROC(type_name) = proc_name; return initialization_proc(proc_name, type_name, formals, stmts); } else { return OPT_NODE; } }
Node build_proc_init_ara(Symbol type_name) /*;build_proc_init_ara*/ { /* * This is the main procedure for building default initialization * procedures for array types. Those initialization procedures are * built if the type given contains some subcomponent for which a * default initialization exists (at any level of nesting), or if it * has determinants. * Note that scalar objects are not initialized at all, which implies * that they get whatever initial value is in that location in memory * This saves some time in object creation. * * All init. procedures have an 'out' parameter that designates the * object being initialized (the space has already been allocated). * */ int side_effect; Tuple tup, formals, subscripts; Symbol c_type, ip, index_t, proc_name, index_sym; Node one_component, init_stmt, out_param, i_nodes, d_node, iter_node; Fortup ft1; Node iterator, index_node; #ifdef TRACE if (debug_flag) { gen_trace_symbol("BUILD_PROC_INIT_ARR", type_name); } #endif side_effect = FALSE; /* Let's hope... TBSL */ tup = SIGNATURE(type_name); c_type = (Symbol) tup[2]; one_component = new_node(as_index); ip = INIT_PROC(base_type(c_type)); if (ip != (Symbol)0 ){ /* Use the initialization procedure for the component type */ init_stmt = (Node) build_init_call(one_component, ip, c_type, OPT_NODE); } else if (is_task_type(c_type)) { /* initialization is task creation. */ init_stmt = new_assign_node(one_component, new_create_task_node(c_type)); } else if (is_access_type(c_type)) { /* default value is the null pointer. */ init_stmt = new_assign_node(one_component, new_null_node(c_type)); } else { init_stmt = (Node) 0; } if (init_stmt != (Node)0) { /* body of initialization procedure is a loop over the indices */ /* allocating each component. Generate loop variables and code */ /* for iteration, using the attributes of the type. */ proc_name = new_unique_name("type_name+INIT"); out_param = new_param_node("param_type_name", proc_name, type_name, na_out); generate_object(N_UNQ(out_param)); formals = tup_new1((char *) out_param); subscripts = tup_new(0); FORTUP(index_t=(Symbol), index_types(type_name), ft1); /*index = index_t + 'INDEX';*/ index_sym = new_unique_name("index_t+INDEX"); NATURE (index_sym) = na_obj; TYPE_OF(index_sym) = index_t; subscripts = tup_with(subscripts, (char *)new_name_node(index_sym)); ENDFORTUP(ft1); i_nodes = new_node(as_list); /* need tup_copy since subscripts used destructively below */ N_LIST(i_nodes) = tup_copy(subscripts); /* Build the tree for the one_component of the array. */ N_AST1(one_component) = out_param; N_AST2(one_component) = i_nodes; N_TYPE(one_component) = c_type; while (tup_size(subscripts)) { /* Build loop from innermost index outwards. The iterations */ /* span the ranges of the array being initialized. */ /* dimension spanned by this loop: */ d_node = new_ivalue_node(int_const(tup_size(subscripts)), symbol_integer); iterator = new_attribute_node(ATTR_O_RANGE, new_name_node(N_UNQ(out_param)), d_node, type_name); index_node = (Node) tup_frome(subscripts); iter_node = new_node(as_for); N_AST1(iter_node) = index_node; N_AST2(iter_node) = iterator; init_stmt = new_loop_node(OPT_NODE, iter_node, tup_new1((char *)init_stmt)); } INIT_PROC(type_name) = proc_name; return initialization_proc(proc_name, type_name, formals, tup_new1((char *) init_stmt)); } else { return OPT_NODE; } }
ENTRYPOINT void init_glblur (ModeInfo *mi) { glblur_configuration *bp; int wire = MI_IS_WIREFRAME(mi); MI_INIT (mi, bps); bp = &bps[MI_SCREEN(mi)]; bp->glx_context = init_GL(mi); reshape_glblur (mi, MI_WIDTH(mi), MI_HEIGHT(mi)); clear_gl_error(); /* WTF? sometimes "invalid op" from glViewport! */ if (!wire) { GLfloat gamb[4]= {0.2, 0.2, 0.2, 1.0}; GLfloat pos[4] = {0.0, 5.0, 10.0, 1.0}; GLfloat amb[4] = {0.2, 0.2, 0.2, 1.0}; GLfloat dif[4] = {0.3, 0.3, 0.3, 1.0}; GLfloat spc[4] = {0.8, 0.8, 0.8, 1.0}; GLfloat shiny = 128; glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); glEnable(GL_DEPTH_TEST); glEnable(GL_CULL_FACE); glEnable(GL_NORMALIZE); glShadeModel(GL_SMOOTH); glLightModelfv (GL_LIGHT_MODEL_AMBIENT, gamb); glLightfv(GL_LIGHT0, GL_POSITION, pos); glLightfv(GL_LIGHT0, GL_AMBIENT, amb); glLightfv(GL_LIGHT0, GL_DIFFUSE, dif); glLightfv(GL_LIGHT0, GL_SPECULAR, spc); glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); glMaterialf(GL_FRONT, GL_SHININESS, shiny); } { Bool spinx=False, spiny=False, spinz=False; double spin_speed = 0.9; double wander_speed = 0.06; char *s = do_spin; while (*s) { if (*s == 'x' || *s == 'X') spinx = True; else if (*s == 'y' || *s == 'Y') spiny = True; else if (*s == 'z' || *s == 'Z') spinz = True; else if (*s == '0') ; else { fprintf (stderr, "%s: spin must contain only the characters X, Y, or Z (not \"%s\")\n", progname, do_spin); exit (1); } s++; } bp->rot = make_rotator (spinx ? spin_speed : 0, spiny ? spin_speed : 0, spinz ? spin_speed : 0, 1.0, do_wander ? wander_speed : 0, False); bp->trackball = gltrackball_init (True); } if (blursize < 0) blursize = 0; if (blursize > 200) blursize = 200; bp->ncolors = 128; bp->colors0 = (XColor *) calloc(bp->ncolors, sizeof(XColor)); bp->colors1 = (XColor *) calloc(bp->ncolors, sizeof(XColor)); bp->colors2 = (XColor *) calloc(bp->ncolors, sizeof(XColor)); bp->colors3 = (XColor *) calloc(bp->ncolors, sizeof(XColor)); make_smooth_colormap (0, 0, 0, bp->colors0, &bp->ncolors, False, 0, False); make_smooth_colormap (0, 0, 0, bp->colors1, &bp->ncolors, False, 0, False); make_smooth_colormap (0, 0, 0, bp->colors2, &bp->ncolors, False, 0, False); make_smooth_colormap (0, 0, 0, bp->colors3, &bp->ncolors, False, 0, False); bp->ccolor = 0; bp->obj_dlist0 = glGenLists (1); bp->obj_dlist1 = glGenLists (1); bp->obj_dlist2 = glGenLists (1); bp->obj_dlist3 = glGenLists (1); bp->scene_dlist1 = glGenLists (1); bp->scene_dlist2 = glGenLists (1); init_texture (mi); generate_object (mi); }