int eval_expr (int Sharp, int Complain) { char c; char d; int rv; sharp = Sharp; complain = Complain; expr = read_expr_(); if (sharp) { c = getnonhspace(); d = '\n'; } else { c = getnonspace(); d = ')'; } if (c != d) { if (complain) { err_head(); fprintf(stderr, "expression syntax error -- junk after expression\n"); } while (Get() != d) ; } #ifdef DEBUG_EXPR if (debugging) { outputc('<'); dump_expr(expr); outputc('='); rv = exec_free(expr); outputd(rv); outputc('>'); } else { rv = exec_free(expr); } return (rv); #else return (exec_free(expr)); #endif }
void dump_object( FILE *fp, char *filename ) { long obj_start = ftell(fp) - 8; /* before signature */ int org = -1; long fp_modname, fp_expr, fp_names, fp_extern, fp_code; if ( file_version >= 8 ) ; /* no object ORG - ORG is now per section */ else if ( file_version >= 5 ) org = (int) xfread_long( fp, filename ); else org = xfread_word( fp, filename ); fp_modname = xfread_long( fp, filename ); fp_expr = xfread_long( fp, filename ); fp_names = xfread_long( fp, filename ); fp_extern = xfread_long( fp, filename ); fp_code = xfread_long( fp, filename ); /* module name */ fseek( fp, obj_start + fp_modname, SEEK_SET ); printf(" Name: %s\n", xfread_string( fp, filename ) ); /* org */ if ( org >= 0 ) printf(" Org: $%04X\n", org ); /* names */ if ( fp_names >= 0 ) dump_names( fp, filename, obj_start + fp_names, obj_start + END( fp_extern, fp_modname ) ); /* extern */ if ( fp_extern >= 0 ) dump_extern( fp, filename, obj_start + fp_extern, obj_start + fp_modname ); /* expressions */ if ( fp_expr >= 0 && opt_showexpr ) dump_expr( fp, filename, obj_start + fp_expr, obj_start + END( fp_names, END( fp_extern, fp_modname ) ) ); /* code */ if ( fp_code >= 0 && opt_dump_code ) dump_code( fp, filename, obj_start + fp_code ); }
static void dump_plist(struct plist *plist) { if (plist) { struct property *p; int nprops = 0; for (p = plist->head; p != NULL; p = p->next) nprops++; dump_integer(nprops); for (p = plist->head; p != NULL; p = p->next) { dump_symbol(p->keyword); dump_expr(p->expr); } } else dump_integer(0); }
/* Dumps av_set AV. */ void dump_av_set (av_set_t av) { av_set_iterator i; expr_t expr; if (!sched_dump_to_dot_p) sel_print ("{"); FOR_EACH_EXPR (expr, i, av) { dump_expr (expr); if (!sched_dump_to_dot_p) sel_print (" "); else sel_print ("\n"); }
static void dump_actual(g95_actual_arglist *actual) { dump_char('['); while(actual != NULL) { if (actual->type == ARG_ALT_RETURN) dumpf("%d", actual->u.label->value); else if (actual->u.expr == NULL) dumpf("None"); else dump_expr(actual->u.expr); actual = actual->next; if (actual != NULL) dump_char(','); } dump_char(']'); }
void dump_init(dump *ctx, decl_init *dinit) { if(dinit == DYNARRAY_NULL){ dump_printf(ctx, "<null init>\n"); return; } switch(dinit->type){ case decl_init_scalar: { dump_expr(dinit->bits.expr, ctx); break; } case decl_init_brace: { decl_init **i; dump_desc(ctx, "brace init", dinit, &dinit->where); dump_inc(ctx); for(i = dinit->bits.ar.inits; i && *i; i++) dump_init(ctx, *i); dump_dec(ctx); break; } case decl_init_copy: { struct init_cpy *cpy = *dinit->bits.range_copy; dump_init(ctx, cpy->range_init); break; } } }
void Parser::dump_expr(FILE *f, ExprNode *node) { if(node->op == OP_FIRST) fprintf(f, "["); else fprintf(f, "("); fflush(f); for(ExprNode *i = node; i != NULL; i = i->next) { switch(i->op) { case OP_CONSTANT: fprintf(f, "%f", (float)(i->number)); break; case OP_VARIABLE: fprintf(f, "%s", i->variable); break; case OP_DOT: fprintf(f, "."); break; case OP_MEMBER: fprintf(f, "%s", i->variable); break; case OP_CALL: fprintf(f, "fn%d", (int)(i->call.fn)); break; case OP_CMP_EQ: fprintf(f, " == "); break; case OP_CMP_NE: fprintf(f, " != "); break; case OP_CMP_LT: fprintf(f, " < "); break; case OP_CMP_LE: fprintf(f, " <= "); break; case OP_CMP_GT: fprintf(f, " > "); break; case OP_CMP_GE: fprintf(f, " >= "); break; case OP_ADD: fprintf(f, " + "); break; case OP_SUB: fprintf(f, " - "); break; case OP_OR: fprintf(f, " | "); break; case OP_MUL: fprintf(f, " * "); break; case OP_DIV: fprintf(f, " / "); break; case OP_AND: fprintf(f, " & "); break; case OP_POW: fprintf(f, " ^ "); break; case OP_NEG: fprintf(f, " -"); break; case OP_NOT: fprintf(f, " !"); break; default: break; } fflush(f); if(i->child != NULL) dump_expr(f, i->child); } if(node->op == OP_FIRST) fprintf(f, "]"); else fprintf(f, ")"); fflush(f); }
static void dump_defclass_constituent(struct defclass_constituent *c) { struct superclass *super; struct slot_spec *slot; struct initarg_spec *initarg; struct inherited_spec *inherited; int n; dump_op(fop_DEFINE_CLASS); n = 0; for (super = c->supers; super != NULL; super = super->next) n++; dump_integer(n); for (super = c->supers; super != NULL; super = super->next) dump_expr(super->expr); n = 0; for (slot = c->slots; slot != NULL; slot = slot->next) n++; dump_integer(n); for (slot = c->slots; slot != NULL; slot = slot->next) { switch (slot->alloc) { case alloc_INSTANCE: dump_symbol(sym_Instance); break; case alloc_CLASS: dump_symbol(sym_Class); break; case alloc_EACH_SUBCLASS: dump_symbol(sym_Each_Subclass); break; case alloc_VIRTUAL: dump_symbol(sym_Virtual); break; default: lose("strange slot allocation"); } if (slot->name) dump_id(slot->name); else dump_op(fop_FALSE); if (slot->type) dump_expr(slot->type); else dump_op(fop_FALSE); dump_plist(slot->plist); } n = 0; for (initarg = c->initargs; initarg != NULL; initarg = initarg->next) n++; dump_integer(n); for (initarg = c->initargs; initarg != NULL; initarg = initarg->next) { dump_symbol(initarg->keyword); dump_plist(initarg->plist); } n = 0; for (inherited = c->inheriteds; inherited != NULL; inherited = inherited->next) n++; dump_integer(n); for (inherited = c->inheriteds; inherited != NULL; inherited = inherited->next) { dump_id(inherited->name); dump_plist(inherited->plist); } }
static void dump_varset_expr(struct varset_expr *expr) { dump_op(fop_VARSET_EXPR); dump_id(expr->var); dump_expr(expr->value); }
static void dump_dot_expr(struct dot_expr *expr) { dump_op(fop_DOT_EXPR); dump_expr(expr->arg); dump_expr(expr->func); }
static void dump_bindings(struct bindings *bindings) { dump_param_list(bindings->params); dump_expr(bindings->expr); }
static lisp_obj *apply(lisp_expr_application *app, lisp_env *env, lisp_err *err) { lisp_obj *callable = FORCE_VALUE(app->proc, env, err); if (! callable){ return NULL; } lisp_obj *res = NIL; /* Internal procedure */ if (callable->type == PROC){ /* Eval args */ lisp_obj **args = calloc(app->nparams, sizeof(lisp_obj*)); for (size_t i=0; i<app->nparams; i++){ lisp_obj *arg = FORCE_VALUE(app->params[i], env, err); if (! arg){ for (size_t j=0; j<i; j++){ release(args[j]); } free(args); return NULL; } args[i] = arg; } /* Eval internal */ res = callable->value.p(app->nparams, args); /* Free args */ for (size_t i=0; i<app->nparams; i++){ release(args[i]); } free(args); } /* Lisp func */ else if (callable->type == LAMBDA){ lisp_lambda *lambda = &(callable->value.l); lisp_expr_lambda *lambda_expr = &(lambda->declaration->value.mklambda); /* Check arity */ if (app->nparams != lambda_expr->nparams){ raise_error(err, WRONG_ARITY, "Arity error ! Expected %d params, got %d", lambda_expr->nparams, app->nparams); return NULL; } /* Extend env */ lisp_env *locals = create_env(lambda->context); for (size_t i=0; i<lambda_expr->nparams; i++){ lisp_obj *param = eval_expression(app->params[i], env, err); if (! param){ release_env(locals); return NULL; } DEBUG("Extend env with %s", lambda_expr->param_names[i]); release(set_env(locals, lambda_expr->param_names[i], param)); } if (enable_debug){ printf("\033[1mCALL\033[0m "); dump_expr(lambda_expr->body); printf(" with env\n"); dump_env(locals); } /* Wrap in thunk for trampoline */ res = make_thunk(lambda_expr->body, locals); release_env(locals); } else { lisp_print(callable); raise_error(err, NOT_CALLABLE, "CANNOT CALL obj %p", callable); return NULL; } release(callable); return res; }
static int dump_code(g95_code *c) { int m, n, list_size, *list, node[2]; g95_forall_iterator *f; g95_filepos *filepos; g95_inquire *inquire; g95_close *close; g95_flush *flush; g95_alloc *alloc; g95_open *open; g95_wait *wait; g95_case *sel; g95_code *d; g95_dt *dt; if (c == NULL) return 0; n = st_n++; list = NULL; list_size = 0; dumpf("%C = []\n", n); for(; c; c=c->next) { switch(c->type) { case EXEC_CONTINUE: case EXEC_NOP: case EXEC_DT_END: dumpf("%C.append(st_nop(%L", n, &c->where); break; case EXEC_ASSIGN: dumpf("%C.append(st_assign(%L,", n, &c->where); dump_expr(c->expr); dump_char(','); dump_expr(c->expr2); break; case EXEC_POINTER_ASSIGN: dumpf("%C.append(st_ptr_assign(%L,", n, &c->where); dump_expr(c->expr); dump_char(','); dump_expr(c->expr2); break; case EXEC_GOTO: dumpf("%C.append(st_goto(%L, %d", n, &c->where, c->label->value); break; case EXEC_PAUSE: dumpf("%C.append(st_pause(%L", n, &c->where); break; case EXEC_STOP: dumpf("%C.append(st_stop(%L", n, &c->where); break; case EXEC_RETURN: dumpf("%C.append(st_return(%L", n, &c->where); if (c->expr != NULL) { dumpf(",rc="); dump_expr(c->expr); } break; case EXEC_IF: node[0] = dump_code(c->block); node[1] = dump_code(c->ext.block); list = node; list_size = 2; dumpf("%C.append(st_if(%L,", n, &c->where); dump_expr(c->expr); dumpf(",%C,%C", node[0], node[1]); break; case EXEC_DO_WHILE: node[0] = dump_code(c->block); list = node; list_size = 1; dumpf("%C.append(st_do_while(%L,", n, &c->where, node[0]); dump_expr(c->expr); dumpf(",%C", node[0]); if (c->sym != NULL) dumpf(",label='%s'", c->sym->name); break; case EXEC_DO: node[0] = dump_code(c->block); list = node; list_size = 1; dumpf("%C.append(st_do(%L, ", n, &c->where); dump_expr(c->ext.iterator->var); dump_char(','); dump_expr(c->ext.iterator->start); dump_char(','); dump_expr(c->ext.iterator->end); dump_char(','); dump_expr(c->ext.iterator->step); dumpf(",%C", node[0]); if (c->sym != NULL) dumpf(",label='%s'", c->sym->name); break; case EXEC_OPEN: open = c->ext.open; dumpf("%C.append(st_open(%L", n, &c->where); if (open->unit != NULL) { dumpf(",unit="); dump_expr(open->unit); } if (open->file != NULL) { dumpf(",file="); dump_expr(open->file); } if (open->status != NULL) { dumpf(",status="); dump_expr(open->status); } if (open->access != NULL) { dumpf(",access="); dump_expr(open->access); } if (open->form != NULL) { dumpf(",form="); dump_expr(open->form); } if (open->recl != NULL) { dumpf(",recl="); dump_expr(open->recl); } if (open->decimal != NULL) { dumpf(",decimal="); dump_expr(open->decimal); } if (open->blank != NULL) { dumpf(",blank="); dump_expr(open->position); } if (open->position != NULL) { dumpf(",position="); dump_expr(open->position); } if (open->action != NULL) { dumpf(",action="); dump_expr(open->action); } if (open->delim != NULL) { dumpf(",delim="); dump_expr(open->delim); } if (open->pad != NULL) { dumpf(",pad="); dump_expr(open->pad); } if (open->iostat != NULL) { dumpf(",iostat="); dump_expr(open->iostat); } if (open->err != NULL) dumpf(",err=%d", open->err->value); break; case EXEC_CLOSE: close = c->ext.close; dumpf("%C.append(st_close(%L", n, &c->where); if (close->unit != NULL) { dumpf(",unit="); dump_expr(close->unit); } if (close->status != NULL) { dumpf(",status="); dump_expr(close->status); } if (close->iostat != NULL) { dumpf(",iostat="); dump_expr(close->iostat); } if (close->err != NULL) dumpf(",err=%d", close->err->value); break; case EXEC_BACKSPACE: dumpf("%C.append(st_backspace(%L", n, &c->where); goto show_filepos; case EXEC_ENDFILE: dumpf("%C.append(st_endfile(%L", n, &c->where); goto show_filepos; case EXEC_REWIND: dumpf("%C.append(st_rewind(%L", n, &c->where); show_filepos: filepos = c->ext.filepos; if (filepos->unit != NULL) { dumpf(",unit="); dump_expr(filepos->unit); } if (filepos->iostat != NULL) { dumpf(",iostat="); dump_expr(filepos->iostat); } if (filepos->err != NULL) dumpf(",err=%d", filepos->err->value); break; case EXEC_INQUIRE: dumpf("%C.append(st_inquire(%L", n, &c->where); inquire = c->ext.inquire; if (inquire->unit != NULL) { dumpf(",unit="); dump_expr(inquire->unit); } if (inquire->file != NULL) { dumpf(",file="); dump_expr(inquire->file); } if (inquire->iostat != NULL) { dumpf(",iostat="); dump_expr(inquire->iostat); } if (inquire->exist != NULL) { dumpf(",exist="); dump_expr(inquire->exist); } if (inquire->opened != NULL) { dumpf(",opened="); dump_expr(inquire->opened); } if (inquire->number != NULL) { dumpf(",number="); dump_expr(inquire->number); } if (inquire->named != NULL) { dumpf(",named="); dump_expr(inquire->named); } if (inquire->name != NULL) { dumpf(",name="); dump_expr(inquire->name); } if (inquire->access != NULL) { dumpf(",access="); dump_expr(inquire->access); } if (inquire->sequential != NULL) { dumpf(",sequential="); dump_expr(inquire->sequential); } if (inquire->direct != NULL) { dumpf(",direct="); dump_expr(inquire->direct); } if (inquire->form != NULL) { dumpf(",form="); dump_expr(inquire->form); } if (inquire->formatted != NULL) { dumpf(",formatted="); dump_expr(inquire->formatted); } if (inquire->unformatted != NULL) { dumpf(",unformatted="); dump_expr(inquire->unformatted); } if (inquire->recl != NULL) { dumpf(",recl="); dump_expr(inquire->recl); } if (inquire->nextrec != NULL) { dumpf(",nextrec="); dump_expr(inquire->nextrec); } if (inquire->blank != NULL) { dumpf(",blank="); dump_expr(inquire->blank); } if (inquire->position != NULL) { dumpf(",position="); dump_expr(inquire->position); } if (inquire->action != NULL) { dumpf(",action="); dump_expr(inquire->action); } if (inquire->read != NULL) { dumpf(",read="); dump_expr(inquire->read); } if (inquire->write != NULL) { dumpf(",write="); dump_expr(inquire->write); } if (inquire->readwrite != NULL) { dumpf(",readwrite="); dump_expr(inquire->readwrite); } if (inquire->delim != NULL) { dumpf(",delim="); dump_expr(inquire->delim); } if (inquire->pad != NULL) { dumpf(",pad="); dump_expr(inquire->pad); } if (inquire->pos != NULL) { dumpf(",pos="); dump_expr(inquire->pos); } if (inquire->iolength != NULL) { dumpf(",iolength="); dump_expr(inquire->iolength); } if (inquire->size != NULL) { dumpf(",size="); dump_expr(inquire->size); } if (inquire->err != NULL) dumpf(",err=%d", inquire->err->value); break; case EXEC_FLUSH: dumpf("%C.append(st_flush(%L", n, &c->where); flush = c->ext.flush; if (flush->unit != NULL) { dumpf(",unit="); dump_expr(flush->unit); } if (flush->iostat != NULL) { dumpf(",iostat="); dump_expr(flush->iostat); } if (flush->iomsg != NULL) { dumpf(",iomsg="); dump_expr(flush->iomsg); } if (flush->err != NULL) dumpf(",err=%d", flush->err->value); break; case EXEC_WAIT: dumpf("%C.append(st_wait(%L", n, &c->where); wait = c->ext.wait; if (wait->unit != NULL) { dumpf(",unit="); dump_expr(wait->unit); } if (wait->id != NULL) { dumpf(",id="); dump_expr(wait->id); } if (wait->iostat != NULL) { dumpf(",iostat="); dump_expr(wait->iostat); } if (wait->iomsg != NULL) { dumpf(",iomsg="); dump_expr(wait->iomsg); } if (wait->err != NULL) dumpf(",err=%d", wait->err->value); if (wait->end != NULL) dumpf(",end=%d", wait->end->value); if (wait->eor != NULL) dumpf(",eof=%d", wait->eor->value); break; case EXEC_IOLENGTH: dumpf("%C.append(st_iolength(%L,", n, &c->where); dump_expr(c->expr); break; case EXEC_WRITE: dumpf("%C.append(st_write(%L", n, &c->where); goto show_dt; case EXEC_READ: dumpf("%C.append(st_read(%L", n, &c->where); show_dt: dt = c->ext.dt; if (dt->io_unit->ts.type == BT_INTEGER) dumpf(",unit="); else dumpf(",internal_unit="); dump_expr(dt->io_unit); if (dt->format_expr != NULL) { dumpf(",format_expr="); dump_expr(dt->format_expr); } if (dt->rec != NULL) { dumpf(",rec="); dump_expr(dt->rec); } if (dt->advance != NULL) { dumpf(",advance="); dump_expr(dt->advance); } if (dt->iostat != NULL) { dumpf(",iostat="); dump_expr(dt->iostat); } if (dt->size != NULL) { dumpf(",size="); dump_expr(dt->size); } if (dt->pos != NULL) { dumpf(",pos="); dump_expr(dt->pos); } if (dt->decimal != NULL) { dumpf(",decimal="); dump_expr(dt->decimal); } if (dt->namelist != NULL) dumpf(",namelist=(%S,%L)", dt->namelist->name, &dt->namelist_where); if (dt->format_label != NULL) dumpf(",format_label=%d", dt->format_label->value); if (dt->err != NULL) dumpf(",err=%d", dt->err->value); if (dt->end != NULL) dumpf(",end=%d", dt->end->value); if (dt->eor != NULL) dumpf(",eof=%d", dt->eor->value); break; case EXEC_TRANSFER: dumpf("%C.append(st_transfer(%L,%d,", n, &c->expr->where, c->ext.transfer == M_READ); dump_expr(c->expr); break; case EXEC_ALLOCATE: dumpf("%C.append(st_allocate(%L,", n, &c->where); goto show_alloc; case EXEC_DEALLOCATE: dumpf("%C.append(st_deallocate(%L,", n, &c->where); show_alloc: dumpf("["); alloc = c->ext.alloc_list; while(alloc != NULL) { dump_expr(alloc->expr); if (alloc->next != NULL) dump_char(','); alloc = alloc->next; } dumpf("]"); if (c->expr != NULL) { dumpf(",stat="); dump_expr(c->expr); } break; case EXEC_ARITHMETIC_IF: dumpf("%C.append(st_arith_if(%L,", n, &c->where); dump_expr(c->expr); dumpf(", %d, %d, %d", c->label->value, c->label2->value, c->label3->value); break; case EXEC_LABEL_ASSIGN: dumpf("%C.append(st_label_assign(%L,", n, &c->where); dump_expr(c->expr); dumpf(", %d", c->label->value); break; case EXEC_SELECT: for(d=c->block; d; d=d->block) list_size++; list = g95_getmem(list_size * sizeof(int)); m = 0; for(d=c->block; d; d=d->block) list[m++] = dump_code(d->next); dumpf("%C.append(st_select(%L, ", n, &c->where); dump_expr(c->expr); dumpf(",["); m = 0; for(d=c->block; d; d=d->next) { dumpf("["); for(sel=d->ext.case_list; sel; sel=sel->next) { dump_char('('); if (sel->low == NULL) dumpf("None"); else dump_expr(sel->low); dumpf(","); if (sel->high == NULL) dumpf("None"); else dump_expr(sel->high); } dumpf("],%C,", list[m++]); } dump_char(']'); break; case EXEC_CYCLE: dumpf("%C.append(st_cycle(%L", n, &c->where); if (c->sym != NULL) dumpf(",label=%p", c->sym); break; case EXEC_EXIT: dumpf("%C.append(st_exit(%L", n, &c->where); if (c->sym != NULL) dumpf(",label=%p", c->sym); break; case EXEC_ENTRY: dumpf("%C.append(st_entry(%L,'%s',", n, &c->where, c->sym->name); dump_formal(c->sym); break; case EXEC_WHERE: for(d=c->block; d; d=d->block) list_size++; list = g95_getmem(list_size * sizeof(int)); m = 0; for(d=c->block; d; d=d->block) list[m++] = dump_code(d->next); dumpf("%C.append(st_where(%L, [", n, &c->where); m = 0; for(d=c->block; d; d=d->block) { dump_char('('); if (d->expr == NULL) dumpf("None"); else dump_expr(d->expr); dumpf(",%C),", list[m++]); } dump_char(']'); break; case EXEC_FORALL: node[0] = dump_code(c->block); list = node; list_size = 1; dumpf("%C.append(st_forall(%L, [", n, &c->where); for(f=c->ext.forall_iterator; f; f=f->next) { dump_char('('); dump_expr(f->var); dump_char(','); dump_expr(f->start); dump_char(','); dump_expr(f->end); dump_char(','); dump_expr(f->stride); dump_char(')'); if (f->next != NULL) dump_char(','); } dumpf("], %C", node[0]); if (c->expr != NULL) { dumpf(", mask="); dump_expr(c->expr); } break; case EXEC_CALL: dumpf("%C.append(st_call(%L,", n, &c->where); dump_name(c->sym, c->ext.sub.isym); dump_char(','); dump_actual(c->ext.sub.actual); break; default: g95_internal_error("dump_code(): Bad code"); break; } if (c->here != NULL) dumpf(",here=%d", c->here->value); dumpf("))\n"); for(m=0; m<list_size; m++) if (list[m] != 0) dumpf("del %C\n", list[m]); list_size = 0; if (list != NULL && list != node) g95_free(list); } return n; }
static void dump_expr(g95_expr *e) { if (e == NULL) { dumpf("None"); return; } switch(e->type) { case EXPR_NULL: dumpf("null(%L,%S,%d)", &e->where, g95_typename(&e->ts), e->rank); break; case EXPR_OP: dump_intrinsic(e); break; case EXPR_CONSTANT: dump_constant(e); break; case EXPR_VARIABLE: dump_variable(e); break; case EXPR_FUNCTION: if (e->value.function.isym != NULL && e->value.function.isym->id == G95_ISYM_CONVERSION) dump_expr(e->value.function.actual->u.expr); else { dumpf("fcall(%L,", &e->where); dump_name(e->symbol, e->value.function.isym); dumpf(",%S,%d,", g95_typename(&e->ts), e->rank); dump_actual(e->value.function.actual); dump_char(')'); } break; case EXPR_PROCEDURE: dumpf("procedure(%L,", &e->where); dump_name(e->symbol, NULL); dump_char(')'); break; case EXPR_STRUCTURE: dump_cons("scons", e); break; case EXPR_ARRAY: dump_cons("acons", e); break; case EXPR_SUBSTRING: dumpf("substring_exp(%L,", &e->where); dump_constant(e); dump_char(','); dump_expr(e->ref->u.ss.start); dump_char(','); dump_expr(e->ref->u.ss.end); dump_char(')'); break; default: g95_internal_error("dump_expr(): Bad expression"); } }
static void dump_variable(g95_expr *e) { g95_ref *ref; int i; dumpf("var(%L,%p,[", &e->where, e->symbol); for(ref=e->ref; ref; ref=ref->next) { switch(ref->type) { case REF_ARRAY: switch(ref->u.ar.type) { case AR_FULL: dumpf("ar_full()"); break; case AR_ELEMENT: dumpf("ar_element(["); for(i=0; i<ref->u.ar.dimen; i++) { dump_expr(ref->u.ar.start[i]); if (i < ref->u.ar.dimen-1) dump_char(','); } dumpf("])"); break; case AR_SECTION: dumpf("ar_section(["); for(i=0; i<ref->u.ar.dimen; i++) { switch(ref->u.ar.dimen_type[i]) { case DIMEN_ELEMENT: case DIMEN_VECTOR: dump_expr(ref->u.ar.start[i]); break; case DIMEN_RANGE: dump_char('('); dump_expr(ref->u.ar.start[i]); dump_char(','); dump_expr(ref->u.ar.end[i]); dump_char(','); dump_expr(ref->u.ar.stride[i]); dump_char(')'); break; default: g95_internal_error("dump_variable(): Bad dimen"); } if (i < ref->u.ar.dimen-1) dump_char(','); } dumpf("])"); break; default: g95_internal_error("dump_variable(): Bad array ref"); } break; case REF_COARRAY: dumpf("coarray(["); for(i=0; i<ref->u.car.dimen; i++) { dump_expr(ref->u.car.element[i]); dump_char(','); } dumpf("])"); break; case REF_COMPONENT: dumpf("component(%S)", ref->u.c.name); break; case REF_SUBSTRING: dumpf("substring("); dump_expr(ref->u.ss.start); dump_char(','); dump_expr(ref->u.ss.end); dump_char(')'); break; default: g95_internal_error("dump_variable(): Bad ref"); } if (ref->next != NULL) dump_char(','); } dump_char(']'); dump_char(')'); }
void dump_decl(decl *d, dump *ctx, const char *desc) { const int is_func = !!type_is(d->ref, type_func); type *ty; if(!desc){ if(d->spel){ desc = is_func ? "function" : "variable"; }else{ desc = "type"; } } dump_desc_colour_newline(ctx, desc, d, &d->where, maybe_colour(ctx->fout, col_desc_decl), 0); if(d->proto) dump_printf_indent(ctx, 0, " prev %p", (void *)d->proto); if(d->spel) dump_printf_indent(ctx, 0, " %s", d->spel); dump_type(ctx, d->ref); if(d->store) dump_printf_indent(ctx, 0, " %s", decl_store_to_str(d->store)); dump_printf_indent(ctx, 0, "\n"); if(!is_func){ type *tof = type_skip_non_tdefs(d->ref); if(tof->type == type_tdef && !tof->bits.tdef.decl){ /* show typeof expr */ dump_inc(ctx); dump_expr(tof->bits.tdef.type_of, ctx); dump_dec(ctx); } if(d->bits.var.field_width){ dump_inc(ctx); dump_expr(d->bits.var.field_width, ctx); dump_dec(ctx); } if(!d->spel){ dump_sue(ctx, d->ref); }else if(d->bits.var.init.dinit){ dump_inc(ctx); dump_init(ctx, d->bits.var.init.dinit); dump_dec(ctx); } } dump_inc(ctx); dump_attributes(d->attr, ctx); ty = type_skip_non_attr(d->ref); if(ty && ty->type == type_attr) dump_attributes(ty->bits.attr, ctx); dump_dec(ctx); if(is_func && d->bits.func.code){ funcargs *fa = type_funcargs(d->ref); dump_inc(ctx); dump_args(fa, ctx); dump_stmt(d->bits.func.code, ctx); dump_dec(ctx); } }
static void dump_expr_constituent(struct expr_constituent *c) { dump_op(fop_EXPR_CONSTITUENT); dump_expr(c->expr); }