27 #include "pips_config.h"
115 gfc_symbol * root_sym;
116 gfc_formal_arglist *
formal;
136 gfc_symtree * current_proc;
138 message_assert(
"No current symtree to match the name of the namespace",
139 current_proc != NULL );
140 root_sym = current_proc->n.sym;
246 int stack_offset = 0;
249 list commons, commons_p, unnamed_commons, unnamed_commons_p, common_entities;
251 unnamed_commons = unnamed_commons_p =
getSymbolBy(ns,
255 common_entities = NULL;
269 for (; commons_p;
POP( commons_p )) {
270 gfc_symtree *st = (gfc_symtree*)commons_p->
car.
e;
288 commons_p->
car.
e = com;
290 gfc_symbol *s = st->n.common->head;
291 int offset_common = stack_offset;
297 for (; s; s = s->common_next) {
298 unnamed_commons_p = unnamed_commons;
301 while(unnamed_commons_p) {
302 st = unnamed_commons_p->
car.
e;
303 if(
strcmp_(st->n.sym->name, s->name) == 0) {
307 POP( unnamed_commons_p );
309 gfc2pips_debug(4,
"element in common founded: %s\t\toffset: %d\n",
310 s->name, offset_common );
321 offset_common +=
array_size(in_common_entity);
327 common_entities =
gen_cons(in_common_entity, common_entities);
332 gfc2pips_debug(3,
"nb of elements in the common: %zu\n\t\tsize of the common: %d\n",
344 int unnamed_commons_nb =
gen_length(unnamed_commons);
345 if(unnamed_commons_nb) {
346 gfc2pips_debug(2,
"nb of elements in %d unnamed common(s) founded\n",unnamed_commons_nb);
367 int offset_common = stack_offset;
368 unnamed_commons_p = unnamed_commons;
371 for (; unnamed_commons_p;
POP( unnamed_commons_p )) {
372 gfc_symtree* st = unnamed_commons_p->
car.
e;
373 gfc_symbol *s = st->n.sym;
374 gfc2pips_debug(4,
"element in common founded: %s\t\toffset: %d\n", s->name, offset_common );
385 offset_common +=
array_size(in_common_entity);
392 common_entities =
gen_cons(in_common_entity, common_entities);
397 gfc2pips_debug(3,
"nb of elements in the common: %zu\n\t\tsize of the common: %d\n",
415 list complete_list_of_entities = NULL, complete_list_of_entities_p = NULL;
417 complete_list_of_entities_p =
gen_union(complete_list_of_entities_p,
421 complete_list_of_entities_p =
gen_union(commons_p,
422 complete_list_of_entities_p);
424 complete_list_of_entities_p =
gen_union(complete_list_of_entities_p,
427 complete_list_of_entities = complete_list_of_entities_p;
428 for (; complete_list_of_entities_p;
POP( complete_list_of_entities_p )) {
440 list list_of_declarations =
443 complete_list_of_entities =
gen_union(complete_list_of_entities,
444 list_of_declarations);
457 list list_of_subroutines, list_of_subroutines_p;
458 list_of_subroutines_p = list_of_subroutines
460 for (; list_of_subroutines_p;
POP( list_of_subroutines_p )) {
461 gfc_symtree* st = list_of_subroutines_p->
car.
e;
468 list check_sub_parameters =
470 if(check_sub_parameters == NULL) {
484 complete_list_of_entities =
gen_union(complete_list_of_entities,
515 complete_list_of_entities_p = complete_list_of_entities;
517 for (; complete_list_of_entities_p;
POP( complete_list_of_entities_p )) {
518 ent =
ENTITY(
CAR(complete_list_of_entities_p));
521 "Complete list of entities, element: %s\n",
528 complete_list_of_entities),
532 list_of_subroutines),
640 extern const char *main_input_filename;
641 extern const char *aux_base_name;
644 char *dir_name = (
char *)aux_base_name;
650 char * unsplit_modname = NULL;
661 unsplit_modname = (
char *)
malloc(
sizeof(
char)
669 mkdir(module_dir_name, 0xffffffff);
670 pips_debug(2,
"Creating module directory : %s\n", module_dir_name);
678 fcopy(main_input_filename, source_file);
682 fcopy(main_input_filename, source_file_orig);
684 char *parsedcode_filename =
concatenate(module_dir_name,
688 FILE *parsedcode_file =
safe_fopen(parsedcode_filename,
"w");
689 printf(
"Write PArsed code in %s \n", parsedcode_filename);
693 char *callees_filename =
concatenate(module_dir_name,
"/",
"CALLEES", NULL);
694 FILE *callees_file =
safe_fopen(callees_filename,
"w");
705 printf(
"Writing %s\n\n", unsplit_source_file);
706 FILE *fp =
safe_fopen(unsplit_source_file,
"w");
707 fprintf(fp,
"/* module still to be implemented ! */\n\n");
716 mkdir(module_dir_name, 0xffffffff);
717 pips_debug(2,
"Creating module directory : %s\n", module_dir_name);
727 fcopy(main_input_filename, source_file);
731 fcopy(main_input_filename, source_file_orig);
735 char *parsedcode_filename =
concatenate(module_dir_name,
739 FILE *parsedcode_file =
safe_fopen(parsedcode_filename,
"w");
744 char *callees_filename =
concatenate(module_dir_name,
"/",
"CALLEES", NULL);
745 FILE *callees_file =
safe_fopen(callees_filename,
"w");
757 char *file_list =
concatenate(dir_name,
"/.fsplit_file_list", NULL);
759 fprintf(fp,
"%s %s/%s.f90\n", unsplit_modname, dir_name, unsplit_modname);
763 for (ns = ns->contained; ns; ns = ns->sibling) {
774 if(root_sym->attr.is_main_program) {
776 }
else if(root_sym->attr.subroutine) {
778 }
else if(root_sym->attr.function) {
780 }
else if(root_sym->attr.flavor == FL_BLOCK_DATA) {
782 }
else if(root_sym->attr.flavor == FL_MODULE) {
785 if(root_sym->attr.procedure) {
786 fprintf(stderr,
"procedure\n");
797 list parameters = NULL, parameters_name = NULL;
838 return parameters_name;
849 gfc_formal_arglist *
formal;
850 list args_list = NULL, args_list_p = NULL;
854 if(ns && ns->proc_name) {
870 args_list = args_list_p =
CONS(
ENTITY, e, NULL );
880 args_list =
CDR( args_list );
922 gfc_symtree *return_value = NULL;
934 gfc2pips_debug(10,
"Looking for the symtree called: %s(%zu) %s(%zu)\n",
935 name, strlen(name), st->name, strlen(st->name) );
938 if(
strcmp_(st->name, name) == 0) {
945 if(return_value == NULL) {
975 gfc_symtree *current_symtree = (gfc_symtree*)variables_p->
car.
e;
976 if(current_symtree && current_symtree->n.sym) {
978 if(current_symtree->n.sym->attr.in_common) {
979 gfc2pips_debug(4,
" %s is in a common, skipping\r\n", (current_symtree->name) );
984 if(current_symtree->n.sym->attr.use_assoc) {
985 gfc2pips_debug(4,
" %s is in a module, skipping\r\n", (current_symtree->name) );
990 gfc2pips_debug(4,
" symbol: %s size: %d\r\n", (current_symtree->name), current_symtree->n.sym->ts.kind );
1036 if(current_symtree->n.sym->attr.dummy) {
1037 gfc2pips_debug(0,
"dummy parameter \"%s\" put in FORMAL\n",current_symtree->n.sym->name);
1046 }
else if(current_symtree->n.sym->attr.flavor == FL_PARAMETER) {
1047 gfc2pips_debug(9,
"Variable \"%s\" (PARAMETER) put in FORMAL\n",current_symtree->n.sym->name);
1055 gfc2pips_debug(0,
"!!!!!! Variable \"%s\" (PARAMETER) put in formal WITHOUT RANK\n",current_symtree->n.sym->name);
1070 if(current_symtree->n.sym->as && current_symtree->n.sym->as->type
1071 != AS_EXPLICIT && !current_symtree->n.sym->value) {
1072 if(current_symtree->n.sym->attr.allocatable) {
1086 "Variable \"%s\" put in RAM \"%s\"\n",
1112 variables_p->
car.
e = NULL;
1125 while(variables_p) {
1128 gfc_symtree *current_symtree = (gfc_symtree*)variables_p->
car.
e;
1130 list list_of_components = NULL;
1132 list members = NULL;
1134 gfc2pips_debug(9,
"start list of elements in the structure %s\n",current_symtree->name);
1135 for (c = current_symtree->n.sym->components; c; c = c->next) {
1164 fprintf(stdout,
"%s\n", c->name);
1175 if(current_symtree->n.sym->attr.external) {
1220 list list_of_extern, list_of_extern_p;
1221 list_of_extern_p = list_of_extern =
getSymbolBy(ns,
1224 while(list_of_extern_p) {
1225 gfc_symtree* curr = list_of_extern_p->
car.
e;
1236 list_of_extern_p->
car.
e = e;
1237 POP( list_of_extern_p );
1239 return list_of_extern;
1268 list list_of_dimensions = NULL;
1271 pips_assert(
"Allocatable should have been handled before !",
1272 !s->attr.allocatable);
1274 if(s && s->attr.dimension) {
1275 gfc_array_spec *as = s->as;
1278 if(as != NULL && as->rank != 0) {
1282 c =
strdup(
"AS_EXPLICIT");
1291 list_of_dimensions);
1295 c =
strdup(
"AS_DEFERRED");
1302 list_of_dimensions);
1306 case AS_ASSUMED_SIZE:
1308 c =
strdup(
"AS_ASSUMED_SIZE");
1317 list_of_dimensions);
1325 list_of_dimensions);
1327 case AS_ASSUMED_SHAPE:
1328 c =
strdup(
"AS_ASSUMED_SHAPE");
1331 gfc_internal_error(
"show_array_spec(): Unhandled array shape "
1338 return list_of_dimensions;
1346 bool(*func)(gfc_namespace*, gfc_symtree *)) {
1347 list args_list = NULL;
1357 args_list =
gen_cons(st, args_list);
1374 if(!st || !st->n.sym)
1378 variable_p = (st->n.sym->attr.flavor == FL_VARIABLE || st->n.sym->attr.flavor
1399 if(!st || !st->n.sym)
1401 return st->n.sym->attr.flavor == EXPR_VARIABLE && !st->n.sym->attr.dummy;
1409 if(!st || !st->n.sym)
1411 return st->n.sym->attr.flavor == FL_DERIVED
1413 && !st->n.sym->attr.pointer && !st->n.sym->attr.dummy;
1421 if(!st || !st->n.sym)
1423 return st->n.sym->attr.external || st->n.sym->attr.proc == PROC_EXTERNAL;
1427 if(!st || !st->n.sym)
1429 return (st->n.sym->attr.flavor == FL_PROCEDURE && (st->n.sym->attr.subroutine
1430 || st->n.sym->attr.function) && strncmp(st->n.sym->name,
1432 strlen(
"__")) != 0);
1441 if(!st || !st->n.sym)
1443 return st->n.sym->attr.allocatable;
1450 if(!st || !st->n.sym)
1452 return st->n.sym->attr.flavor == EXPR_VARIABLE && st->n.sym->attr.dummy;
1459 if(!st || !st->n.sym)
1461 return st->n.sym->value && st->n.sym->attr.flavor != FL_PARAMETER
1462 && st->n.sym->attr.flavor != FL_PROCEDURE;
1469 if(!st || !st->n.sym)
1471 return st->n.sym->attr.save != SAVE_NONE;
1483 if(!st || !st->n.sym)
1485 return st->n.sym->attr.in_common;
1492 if(!st || !st->n.sym)
1494 return st->n.sym->attr.dimension;
1587 if(s->attr.flavor == FL_PROGRAM || s->attr.is_main_program) {
1593 }
else if(s->attr.function) {
1604 }
else if(s->attr.subroutine) {
1610 }
else if(s->attr.flavor == FL_BLOCK_DATA) {
1616 }
else if(s->attr.flavor == FL_MODULE) {
1627 if(s->ts.type == BT_DERIVED) {
1628 if(s->attr.allocatable) {
1635 pips_user_error(
"User-defined variables are not implemented yet\n" );
1640 if(s->attr.use_assoc) {
1649 "found in symbol table, are you sure that you parsed the module "
1650 "first ? Aborting\n",name, s->module);
1721 if(
strncmp_(
"_gfortran_exit_", str, strlen(
"_gfortran_exit_")) == 0) {
1723 }
else if(
strncmp_(
"_gfortran_float", str, strlen(
"_gfortran_float")) == 0) {
1778 sprintf(str,
"%d", n);
1804 if(r == 0. || r == (
double)((
int)r)) {
1805 sprintf(str,
"%d", (
int)r);
1810 sprintf(str,
"%.16e", r);
1854 char *s =
malloc(
sizeof(
char) * (nb + 1 + 2));
1882 while(p && *p && nb < 132) {
1891 s =
malloc(
sizeof(
char) * (nb + 1));
1893 while(i < nb && *p) {
1911 if(s->attr.pointer) {
1915 switch(s->ts.type) {
1943 pips_user_error(
"An error occurred in the type to type translation: impossible to translate the symbol.\n" );
1949 if(s->attr.allocatable) {
1991 if(s->ts.type == BT_CHARACTER && s->ts.cl && s->ts.cl->length) {
1994 "size of %s: %zu\n",
1996 mpz_get_si(s->ts.cl->length->value.integer)
1998 return mpz_get_si(s->ts.cl->length->value.integer);
2010 list list_of_dimensions = NULL;
2012 if(s && s->attr.dimension) {
2013 gfc_array_spec *as = s->as;
2015 if(as != NULL && as->rank != 0 && as->type == AS_EXPLICIT) {
2040 for (i = 0; i < ar->dimen; i++) {
2048 if(ar->dimen_type[i] == DIMEN_RANGE) {
2086 for (i = 0; i < ar->dimen; i++) {
2120 list list_of_data_symbol, list_of_data_symbol_p;
2124 list list_of_statements, list_of_statements_p;
2125 list_of_statements_p = list_of_statements = NULL;
2133 while(list_of_data_symbol_p) {
2160 POP( list_of_data_symbol_p );
2188 while(list_of_save) {
2189 static int offset_area = 0;
2194 gfc2pips_debug(4,
"entity to SAVE %s\n",((gfc_symtree*)list_of_save->
car.
e)->n.sym->name);
2235 POP( list_of_save );
2275 unsigned long curr_comment_num = first_comment_num;
2278 for (; curr_comment_num <= last_code_num; curr_comment_num++)
2280 - first_comment_num);
2292 for (; c; c = c->next) {
2294 if(c && c->op == EXEC_SELECT) {
2329 list list_of_statements_format = NULL;
2330 while(gfc2pips_format_p) {
2346 list_of_statements_format =
gen_nconc(list_of_statements_format,
2348 POP( gfc2pips_format_p );
2349 POP( gfc2pips_format2_p );
2351 list_of_statements =
gen_nconc(list_of_statements_format, list_of_statements);
2353 if(list_of_statements) {
2356 fprintf(stderr,
"Warning ! no instruction dumped => very bad\n");
2369 list list_of_statements;
2371 force_sequence =
true;
2373 if(force_sequence) {
2387 list_of_statements = NULL;
2391 if(c && c->op == EXEC_SELECT) {
2395 if(list_of_statements)
2412 list_of_statements );
2420 for (; c; c = c->next) {
2427 if(c && c->op == EXEC_SELECT) {
2494 case EXEC_INIT_ASSIGN:
2506 case EXEC_POINTER_ASSIGN: {
2528 case EXEC_ASSIGN_CALL: {
2530 c->op==EXEC_CALL?
"CALL":
"ASSIGN_CALL");
2532 gfc_symbol*
symbol = NULL;
2535 if(c->resolved_sym) {
2536 symbol = c->resolved_sym;
2537 }
else if(c->symtree) {
2538 symbol = c->symtree->n.sym;
2560 "didn't resolve symbol : %s\n",
2569 list param_of_call_p = param_of_call;
2571 while(param_of_call_p) {
2579 param_of_call_p->
car.
e = _new;
2580 POP( param_of_call_p );
2584 " thus we make it 'overloaded'\n",
2600 case EXEC_COMPCALL: {
2645 case EXEC_ARITHMETIC_IF: {
2662 if(c->label->value == c->label2->value) {
2663 if(c->label->value == c->label3->value) {
2680 }
else if(c->label2->value == c->label3->value) {
2719 gfc_code* d = c->block;
2723 }
else if(!d->expr) {
2731 }
else if(!d->next) {
2752 if(d->block->expr) {
2820 case EXEC_DO_WHILE: {
2879 case EXEC_DEALLOCATE: {
2881 c->op==EXEC_ALLOCATE?
"ALLOCATE":
"DEALLOCATE");
2897 for (a = c->ext.alloc_list; a; a = a->next) {
2910 gfc_open * o = c->ext.open;
2966 gfc_close * o = c->ext.close;
2982 case EXEC_BACKSPACE:
2987 if(c->op == EXEC_BACKSPACE)
2989 else if(c->op == EXEC_ENDFILE)
2991 else if(c->op == EXEC_REWIND)
2993 else if(c->op == EXEC_FLUSH)
3001 fp = c->ext.filepos;
3016 case EXEC_INQUIRE: {
3022 gfc_inquire *i = c->ext.inquire;
3100 gfc2pips_debug(5,
"Translation of %s\n",c->op==EXEC_WRITE?
"PRINT":
"READ");
3103 gfc_dt *dt = d->ext.dt;
3109 if(c->op == EXEC_WRITE) {
3124 for (c = c->block->next; c; c = c->next) {
3128 gfc_code *c = (gfc_code *)_c;
3142 if(c->op != EXEC_DT_END) {
3154 if(dt->format_expr) {
3156 }
else if(dt->format_label && dt->format_label->value != -1) {
3157 if(dt->format_label->format) {
3159 if(dt->format_label->value) {
3182 int curr_char_indice = 0, curr_char_indice_cible = 0,
3183 length_curr_format = strlen(str);
3184 for (; curr_char_indice_cible < length_curr_format - 1; curr_char_indice++, curr_char_indice_cible++) {
3185 if(str[curr_char_indice_cible] ==
'\'')
3186 curr_char_indice_cible++;
3187 str[curr_char_indice] = str[curr_char_indice_cible];
3189 str[curr_char_indice] =
'\0';
3202 int curr_char_indice = 0, curr_char_indice_cible = 0,
3203 length_curr_format = strlen(str);
3204 for (; curr_char_indice_cible < length_curr_format - 1; curr_char_indice++, curr_char_indice_cible++) {
3205 if(str[curr_char_indice_cible] ==
'\'')
3206 curr_char_indice_cible++;
3207 str[curr_char_indice] = str[curr_char_indice_cible];
3209 str[curr_char_indice] =
'\0';
3213 pips_user_error(
"gfc2pips_code2instruction, No format for label\n" );
3221 bool has_to_generate_unit = FALSE;
3223 if(dt->io_unit->expr_type != EXPR_CONSTANT) {
3225 has_to_generate_unit = TRUE;
3226 }
else if(d->op == EXEC_READ && mpz_get_si(dt->io_unit->value.integer)
3227 != 5 || d->op == EXEC_WRITE
3228 && mpz_get_si(dt->io_unit->value.integer) != 6) {
3233 has_to_generate_unit = TRUE;
3237 if(has_to_generate_unit) {
3261 if(dt->asynchronous)
3310 case EXEC_TRANSFER: {
3324 case EXEC_OMP_ATOMIC:
3325 case EXEC_OMP_BARRIER:
3326 case EXEC_OMP_CRITICAL:
3327 case EXEC_OMP_FLUSH:
3329 case EXEC_OMP_MASTER:
3330 case EXEC_OMP_ORDERED:
3331 case EXEC_OMP_PARALLEL:
3332 case EXEC_OMP_PARALLEL_DO:
3333 case EXEC_OMP_PARALLEL_SECTIONS:
3334 case EXEC_OMP_PARALLEL_WORKSHARE:
3335 case EXEC_OMP_SECTIONS:
3336 case EXEC_OMP_SINGLE:
3338 case EXEC_OMP_TASKWAIT:
3339 case EXEC_OMP_WORKSHARE:
3344 c->ext.entry->sym->name );
3346 case EXEC_LABEL_ASSIGN:
3361 return return_instruction;
3367 pips_assert(
"CASE expr require at least an high OR a low bound !",
3369 if(
cp->low ==
cp->high) {
3389 }
else if(!low && high) {
3400 list list_of_statements = NULL;
3402 gfc_code *d = c->block;
3419 list_of_statements);
3432 statement selectcase = NULL, current_case = NULL, default_stmt = NULL;
3433 for (; d; d = d->block) {
3437 for (
cp = d->ext.case_list;
cp;
cp =
cp->next) {
3438 if(!
cp->low && !
cp->high) {
3440 pips_assert(
"We should have default case, but it doesn't seem to be"
3463 if(current_case != NULL) {
3467 current_case = casetest;
3469 selectcase = casetest;
3482 selectcase = default_stmt;
3486 if(selectcase != NULL) {
3491 return list_of_statements;
3534 if(sym->value && sym->value->expr_type == EXPR_ARRAY) {
3535 gfc_constructor *constr = sym->value->value.constructor;
3536 gfc_constructor *prec = NULL;
3538 for (; constr; constr = constr->next) {
3539 gfc2pips_debug( 9,
"offset: %zu\trepeat: %zu\n", mpz_get_si(constr->n.offset), mpz_get_si(constr->repeat) );
3542 if(prec == NULL && mpz_get_si(constr->n.offset) > 0) {
3543 gfc2pips_debug(9,
"we do not start the DATA statement at the beginning !\n");
3557 if(mpz_get_si(prec->repeat)) {
3558 offset = mpz_get_si(constr->n.offset) - mpz_get_si(prec->n.offset)
3559 - mpz_get_si(prec->repeat);
3561 offset = mpz_get_si(constr->n.offset) - mpz_get_si(prec->n.offset);
3578 if(mpz_get_si(constr->repeat)) {
3599 if(sym->ts.type == BT_COMPLEX)
3601 if(sym->ts.type == BT_CHARACTER)
3609 if(mpz_get_si(prec->repeat)) {
3610 offset_end = mpz_get_si(prec->n.offset) + mpz_get_si(prec->repeat);
3612 offset_end = mpz_get_si(prec->n.offset);
3616 if(prec && offset_end + 1 < ((
double)total_size) / (
double)size_of_unit) {
3617 gfc2pips_debug(9,
"We fill all the remaining space in the DATA %d\n",offset_end);
3621 / size_of_unit - offset_end - 1 ),
3630 }
else if(sym->value) {
3648 if(sym->ts.type == BT_CHARACTER)
3650 if(sym->ts.type == BT_COMPLEX) {
3653 }
else if(sym->ts.type == BT_REAL) {
3672 list local_list = l, last_pointer_on_list = NULL;
3673 int nb_of_occurences = 0;
3692 }
else if(nb_of_occurences > 1) {
3695 last_pointer_on_list->car.e
3699 last_pointer_on_list->cdr = local_list;
3701 nb_of_occurences = 1;
3702 last_pointer_on_list = local_list;
3705 nb_of_occurences = 1;
3706 last_pointer_on_list = local_list;
3710 nb_of_occurences = 1;
3711 last_pointer_on_list = local_list;
3716 if(nb_of_occurences > 1) {
3720 "reduce2 %s %d %p\n",
3723 last_pointer_on_list
3725 if(last_pointer_on_list) {
3726 last_pointer_on_list->car.e
3730 last_pointer_on_list->cdr = local_list;
3733 pips_user_warning(
"We don't know what to do ! We do not have a current pointer (and we should).\n" );
3736 nb_of_occurences = 0;
3737 last_pointer_on_list = local_list->
cdr;
3742 if(nb_of_occurences > 1) {
3745 last_pointer_on_list->car.e
3749 last_pointer_on_list->cdr = local_list;
3750 last_pointer_on_list = local_list;
3762 "test label: %lu %lu %lu %lu\t"
3763 "next %lu block %lu %lu\n",
3764 (
_int)(c->label?c->label->value:0),
3765 (
_int)(c->label2?c->label2->value:0),
3766 (
_int)(c->label3?c->label3->value:0),
3767 (
_int)(c->here?c->here->value:0),
3782 "test label2: %lu %lu %lu %lu\t"
3783 "next %lu block %lu %lu\n",
3784 (
_int)(c->label?c->label->value:0),
3785 (
_int)(c->label2?c->label2->value:0),
3786 (
_int)(c->label3?c->label3->value:0),
3787 (
_int)(c->here?c->here->value:0),
3800 "test label2: %lu %lu %lu %lu\t"
3801 "next %lu block %lu %lu\n",
3802 (
_int)(c->label?c->label->value:0),
3803 (
_int)(c->label2?c->label2->value:0),
3804 (
_int)(c->label3?c->label3->value:0),
3805 (
_int)(c->here?c->here->value:0),
3818 "test label2: %lu %lu %lu %lu\t"
3819 "next %lu block %lu %lu\n",
3820 (
_int)(c->label?c->label->value:0),
3821 (
_int)(c->label2?c->label2->value:0),
3822 (
_int)(c->label3?c->label3->value:0),
3823 (
_int)(c->here?c->here->value:0),
3848 switch(expr->expr_type) {
3851 const char *c = NULL;
3852 switch(expr->value.op.op) {
3854 case INTRINSIC_UPLUS:
3855 case INTRINSIC_PLUS:
3858 case INTRINSIC_UMINUS:
3859 case INTRINSIC_MINUS:
3862 case INTRINSIC_TIMES:
3865 case INTRINSIC_DIVIDE:
3868 case INTRINSIC_POWER:
3871 case INTRINSIC_CONCAT:
3883 case INTRINSIC_NEQV:
3888 case INTRINSIC_EQ_OS:
3892 case INTRINSIC_NE_OS:
3896 case INTRINSIC_GT_OS:
3900 case INTRINSIC_GE_OS:
3904 case INTRINSIC_LT_OS:
3908 case INTRINSIC_LE_OS:
3916 case INTRINSIC_PARENTHESES:
3921 (
int) expr->value.op.op );
3933 "is null or undefined\n", c);
3935 if(expr->value.op.op2 == NULL) {
3937 switch(expr->value.op.op) {
3938 case INTRINSIC_UMINUS:
3943 case INTRINSIC_UPLUS:
3960 pips_user_error(
"intrinsic( (string)%s ) : 2nd arg is null or undefined\n", c);
3967 case EXPR_VARIABLE: {
3974 list args_list = NULL;
4001 gfc_ref *r = expr->ref;
4015 case REF_SUBSTRING: {
4082 case EXPR_CONSTANT: {
4084 (
_int)expr->ts.type);
4085 switch(expr->ts.type) {
4094 double value = mpfr_get_d(expr->value.real, GFC_RND_MODE);
4098 case BT_CHARACTER: {
4101 expr->value.character.length);
4124 case EXPR_FUNCTION: {
4132 if(strncmp(expr->symtree->n.sym->name,
"__convert_", strlen(
"__convert_"))
4135 gfc_expr *arg = expr->value.function.actual->expr;
4140 expr->value.function.name );
4147 pips_debug(5,
"Func name : %s\n",expr->value.function.name);
4148 if(strncmp(expr->value.function.name,
"__", strlen(
"__")) == 0
4149 || strncmp(expr->value.function.name,
4151 strlen(
"_gfortran_")) == 0) {
4153 expr->value.function.name = expr->symtree->n.sym->name;
4159 list list_of_arguments = NULL, list_of_arguments_p = NULL;
4160 gfc_actual_arglist *act = expr->value.function.actual;
4171 if(list_of_arguments_p) {
4173 list_of_arguments_p =
CDR( list_of_arguments_p );
4177 if(list_of_arguments == NULL) {
4178 list_of_arguments = list_of_arguments_p;
4185 }
while((act = act->next) != NULL);
4210 case EXPR_STRUCTURE:
4211 pips_user_error(
"gfc2pips_expr2expression: dump of EXPR_STRUCTURE not "
4212 "yet implemented\n" );
4213 case EXPR_SUBSTRING:
4214 pips_user_error(
"gfc2pips_expr2expression: dump of EXPR_SUBSTRING not "
4215 "yet implemented\n" );
4217 pips_user_error(
"gfc2pips_expr2expression: dump of EXPR_NULL not yet "
4220 pips_user_error(
"gfc2pips_expr2expression: dump of EXPR_ARRAY not yet "
4223 pips_user_error(
"gfc2pips_expr2expression: dump not yet implemented, "
4224 "type of gfc_expr not recognized %d\n",
4225 (
int) expr->expr_type );
4228 return returned_expr;
4239 return mpz_get_si(expr->value.integer);
4243 return expr && expr->expr_type == EXPR_VARIABLE;
4252 if(expr->expr_type == EXPR_VARIABLE) {
4253 message_assert(
"No symtree in the expression.", expr->symtree );
4254 message_assert(
"No symbol in the expression.", expr->symtree->n.sym );
4255 message_assert(
"No name in the expression.", expr->symtree->n.sym->name );
4272 if(expr->expr_type == EXPR_CONSTANT) {
4273 if(expr->ts.type == BT_INTEGER) {
4276 if(expr->ts.type == BT_LOGICAL) {
4279 if(expr->ts.type == BT_REAL) {
4284 message_assert(
"No entity to extract from this expression", 0 );
4288 list list_of_arguments = NULL, list_of_arguments_p = NULL;
4294 if(list_of_arguments_p) {
4296 list_of_arguments_p =
CDR( list_of_arguments_p );
4301 if(list_of_arguments == NULL)
4302 list_of_arguments = list_of_arguments_p;
4306 return list_of_arguments;
4423 for (;
eq;
eq =
eq->next) {
4431 int not_moved_entity_size;
4432 for (eq_ =
eq; eq_; eq_ = eq_->eq) {
4440 message_assert(
"expression to compute in equivalence\n", eq_->expr );
4441 gfc2pips_debug(9,
"equivalence of %s\n",eq_->expr->symtree->name);
4447 not_moved_entity = e;
4473 int offset_of_expression = 0;
4512 int personnal_shift = 0;
4514 personnal_shift -= shift;
4517 personnal_shift -= size;
instruction make_instruction_loop(loop _field_)
dummy make_dummy_identifier(entity _field_)
functional make_functional(list a1, type a2)
language make_language_fortran95(void)
evaluation make_evaluation_before(void)
call make_call(entity a1, list a2)
basic make_basic_complex(intptr_t _field_)
value make_value_unknown(void)
basic make_basic_derived(entity _field_)
value make_value_expression(expression _field_)
parameter make_parameter(type a1, mode a2, dummy a3)
syntax make_syntax_call(call _field_)
expression make_expression(syntax a1, normalized a2)
whileloop make_whileloop(expression a1, statement a2, entity a3, evaluation a4)
value make_value_code(code _field_)
loop make_loop(entity a1, range a2, statement a3, entity a4, execution a5, list a6)
subscript make_subscript(expression a1, list a2)
storage make_storage_rom(void)
value make_value_constant(constant _field_)
mode make_mode_reference(void)
type copy_type(type p)
TYPE.
instruction make_instruction_expression(expression _field_)
type make_type_struct(list _field_)
basic make_basic_int(intptr_t _field_)
ram make_ram(entity a1, entity a2, intptr_t a3, list a4)
type make_type_functional(functional _field_)
type make_type_void(list _field_)
basic make_basic_pointer(type _field_)
value make_value(enum value_utype tag, void *val)
reference make_reference(entity a1, list a2)
test make_test(expression a1, statement a2, statement a3)
constant make_constant_int(intptr_t _field_)
basic make_basic_float(intptr_t _field_)
dimension make_dimension(expression a1, expression a2, list a3)
execution make_execution_sequential(void)
statement make_statement(entity a1, intptr_t a2, intptr_t a3, string a4, instruction a5, list a6, string a7, extensions a8, synchronization a9)
type make_type_area(area _field_)
instruction make_instruction_test(test _field_)
instruction make_instruction_call(call _field_)
value copy_value(value p)
VALUE.
basic make_basic_logical(intptr_t _field_)
area make_area(intptr_t a1, list a2)
basic make_basic_string(value _field_)
code make_code(list a1, string a2, sequence a3, list a4, language a5)
storage make_storage_formal(formal _field_)
type make_type_unknown(void)
constant make_constant_litteral(void)
syntax make_syntax(enum syntax_utype tag, void *val)
synchronization make_synchronization_none(void)
storage make_storage_ram(ram _field_)
sequence make_sequence(list a)
storage make_storage_return(entity _field_)
instruction make_instruction_whileloop(whileloop _field_)
void free_statement(statement p)
instruction make_instruction_goto(statement _field_)
callees make_callees(list a)
syntax make_syntax_subscript(subscript _field_)
range make_range(expression a1, expression a2, expression a3)
formal make_formal(entity a1, intptr_t a2)
syntax make_syntax_reference(reference _field_)
struct _newgen_struct_entity_ * entity
static reference ref
Current stmt (an integer)
struct _newgen_struct_expression_ * expression
entity DynamicArea
These global variables are declared in ri-util/util.c.
bool expression_is_constant_p(expression e)
BEGIN_EOLE.
expression MakeCharacterConstantExpression(string s)
END_EOLE.
entity MakeConstant(string name, tag bt)
Make a Fortran constant.
expression MakeComplexConstantExpression(expression r, expression i)
value MakeValueSymbolic(expression e)
this function creates a value for a symbolic constant.
int CurrentOffsetOfArea(entity a, entity v)
void set_common_to_size(entity a, size_t size)
void reset_common_size_map()
void initialize_common_size_map()
static bool variable_p(entity e)
lready exist in cprettyprint but in mode static.
const char * global_name_to_user_name(const char *global_name)
functions on strings for entity names
const char * local_name(const char *s)
Does not take care of block scopes and returns a pointer.
const char * module_name(const char *s)
Return the module part of an entity name.
void ResetChains()
undefine chains between two successives calls to parser
FILE * safe_fopen(const char *filename, const char *what)
int safe_fclose(FILE *stream, const char *filename)
#define gen_chunk_undefined
static int array_size(dim)
ARRAY_SIZE returns the number of elements in the array whose dimension list is DIM.
gen_chunk * gen_copy_tree(gen_chunk *obj)
void gen_write(FILE *fd, gen_chunk *obj)
GEN_WRITE writes the OBJect on the stream FD.
static char start[1024]
The name of the variable from which to start counting domain numbers.
static char * package
The package name in which functions will be defined.
list gen_union(list a, list b)
generate an union of unique elements taken from A and B
gfc2pips_main_entity_type
void gfc2pips_truncate_useless_zeroes(char *s)
expurgates a string representing a REAL, could be a pre-prettyprinter processing
int fcopy(const char *old, const char *new)
copy the content of the first file to the second one
void gfc2pips_add_to_callees(entity e)
Add an entity to the list of callees.
int strcmp_(__const char *__s1, __const char *__s2)
compare the strings in upper case mode
gfc_code * gfc2pips_get_last_loop(void)
gfc_symtree * gfc2pips_getSymtreeByName(const char *name, gfc_symtree *st)
list gfc_module_callees
Store the list of callees.
list get_use_entities_list(struct gfc_namespace *ns)
int strncmp_(__const char *__s1, __const char *__s2, size_t __n)
compare the strings in upper case mode
list gfc2pips_list_of_declared_code
void gfc2pips_push_loop(gfc_code *c)
char * str2upper(char s[])
put the given char table to upper case
void gfc2pips_pop_loop(void)
list gfc2pips_dumpSELECT(gfc_code *c)
expression gfc2pips_buildCaseTest(gfc_expr *test, gfc_case *cp)
bool gfc2pips_get_commons(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree __attribute__((__unused__)) *st)
test function to know if it is a common, always true because the tree is completely separated therefo...
void gfc2pips_computeAdressesDynamic(void)
compute the addresses of the entities declared in DynamicArea
entity gfc2pips_code2get_label(gfc_code *c)
list gfc2pips_parameters(gfc_namespace *ns, gfc2pips_main_entity_type bloc_token)
expression gfc2pips_make_zero_for_symbol(gfc_symbol *sym)
entity gfc2pips_symbol2top_entity(gfc_symbol *s)
translate a gfc symbol to a top-level entity
void gfc2pips_computeAdressesStatic(void)
compute the addresses of the entities declared in StaticArea
list gfc2pips_args(gfc_namespace *ns)
Retrieve the list of names of every argument of the function, if any.
list gfc2pips_exprIO(char *s, gfc_expr *e, list l)
expression gfc2pips_expr2expression(gfc_expr *expr)
int gfc2pips_computeAdressesOfArea(entity _area)
compute the addresses of the entities declared in the given entity
void gfc2pips_getTypesDeclared(gfc_namespace *ns)
list gfc2pips_exprIO3(char *s, string e, list l)
__attribute__((warn_unused_result))
Look for a specific symbol in a tree Check current entry first, then recurse left then right.
entity gfc2pips_int2label(int n)
dump an integer to a PIPS label entity
bool gfc2pips_test_data(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
test if there is a value to stock
bool gfc2pips_last_statement_is_loop
char * gfc2pips_get_safe_name(const char *str)
gfc replace some functions by an homemade one, we check and return a copy of the original one if it i...
static int gfc2pips_last_created_label
bool gfc2pips_test_arg(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
test if it is a dummy parameter (formal parameter)
entity gfc2pips_check_entity_doesnt_exists(char *s)
list gfc2pips_get_list_of_dimensions2(gfc_symbol *s)
build a list - if any - of dimension elements from the gfc_symbol given
void gfc2pips_generate_parameters_list(list parameters)
replace a list of entities by a list of parameters to those entities
bool gfc2pips_test_dimensions(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
type gfc2pips_symbol2type(gfc_symbol *s)
try to create the PIPS type that would be associated by the PIPS default parser
entity gfc2pips_real2entity(double r)
dump reals to PIPS entities
void gfc2pips_computeAdresses(void)
compute addresses of the stack, heap, dynamic and static areas
list getSymbolBy(gfc_namespace *ns, gfc_symtree *st, bool(*func)(gfc_namespace *, gfc_symtree *))
Look for a set of symbols filtered by a predicate function.
instruction gfc2pips_code2instruction_(gfc_code *c)
this function create an atomic statement, no block of data
instruction gfc2pips_code2instruction(gfc_code *c, bool force_sequence)
Build an instruction sequence.
list gfc2pips_exprIO2(char *s, int e, list l)
char * strdup(const char *)
EXPR_STRUCTURE, EXPR_SUBSTRING, EXPR_NULL, EXPR_ARRAY are not dumped.
list gfc2pips_get_extern_entities(gfc_namespace *ns)
build a list of externals entities
char * gfc2pips_gfc_char_t2string_(gfc_char_t *c, int nb)
translate a string from a table of integers in gfc to one of chars in PIPS, escape all ' in the strin...
list gfc2pips_get_data_vars(gfc_namespace *ns)
return a list of elements needing a DATA statement
list gfc2pips_get_list_of_dimensions(gfc_symtree *st)
build a list - if any - of dimension elements from the gfc_symtree given
list gfc2pips_get_save(gfc_namespace *ns)
return a list of SAVE elements
entity gfc2pips_int_const2entity(int n)
translate an integer to a PIPS constant, assume n is positive (or it will not be handled properly)
void gfc2pips_namespace(gfc_namespace *ns)
Entry point for gfc2pips translation This will be called each time the parser encounter subroutine,...
entity gfc2pips_symbol2entity(gfc_symbol *s)
translate a gfc symbol to a PIPS entity, check if it is a function, program, subroutine or else
entity gfc2pips_code2get_label4(gfc_code *c)
void gfc2pips_computeEquiv(gfc_equiv *eq)
entity gfc2pips_check_entity_block_data_exists(char *s)
bool gfc2pips_test_subroutine(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
bool gfc2pips_test_allocatable(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
test if it is a allocatable entity
instruction gfc2pips_code2instruction__TOP(gfc_namespace *ns, gfc_code *c)
Declaration of instructions.
bool gfc2pips_test_extern(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
test if it is an external function
list gfc2pips_arglist2arglist(gfc_actual_arglist *act)
expression gfc2pips_int2expression(int n)
translate a int to an expression
instruction gfc2pips_symbol2data_instruction(gfc_symbol *sym)
build a DATA statement, filling blanks with zeroes.
entity gfc2pips_code2get_label2(gfc_code *c)
gfc2pips_main_entity_type get_symbol_token(gfc_symbol *root_sym)
bool gfc2pips_test_variable2(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
bool gfc2pips_test_save(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
test if there is a SAVE to do
gfc_option_t gfc_option
Cmd line options.
expression gfc2pips_logical2expression(bool b)
translate a bool to an expression
bool gfc2pips_exprIsVariable(gfc_expr *expr)
type gfc2pips_symbol2specialType(gfc_symbol *s)
expression gfc2pips_real2expression(double r)
translate a real to an expression
int gfc2pips_symbol2sizeArray(gfc_symbol *s)
calculate the total size of the array whatever the bounds are: A(-5,5)
statement gfc_function_body
entity gfc2pips_check_entity_module_exists(char *s)
list gfc2pips_array_ref2indices(gfc_array_ref *ar)
convert a list of indices from gfc to PIPS, assume there is no range (dump only the min range element...
list gfc2pips_vars(gfc_namespace *ns)
Extract every and each variable from a namespace.
entity gfc2pips_char2entity(char *package, char *s)
a little bit more elaborated FindOrCreateEntity
char * gfc2pips_gfc_char_t2string2(gfc_char_t *c)
translate the <nb> first elements of from a wide integer representation to a char representation
int global_current_offset
void gfc2pips_computeAdressesHeap(void)
compute the addresses of the entities declared in StaticArea
bool gfc2pips_test_derived(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
dimension gfc2pips_int2dimension(int n)
create a <dimension> from the integer value given
basic gfc2pips_getbasic(gfc_symbol *s)
int gfc2pips_symbol2size(gfc_symbol *s)
return the size of an elementary element: REAL*16 A CHARACTER*17 B
entity gfc2pips_expr2entity(gfc_expr *expr)
create an entity based on an expression, assume it is used only for incremented variables in loops
entity gfc2pips_check_entity_program_exists(char *s)
bool gfc2pips_test_variable(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree *st)
get variables who are not implicit or are needed to be declared for data statements hence variable th...
char * gfc2pips_gfc_char_t2string(gfc_char_t *c, int length)
translate a string from a table of integers in gfc to one of chars in PIPS, escape all ' in the strin...
list gfc2pips_reduce_repeated_values(list l)
look for repeated values (integers or real) in the list (list for DATA instructions) and transform th...
static int gfc2pips_last_created_label_step
entity gfc2pips_main_entity
entity gfc2pips_check_entity_exists(const char *s)
entity gfc2pips_logical2entity(bool b)
translate a boolean to a PIPS/fortran entity
const char * CurrentPackage
the name of the current package, i.e.
bool gfc2pips_get_incommon(gfc_namespace __attribute__((__unused__)) *ns, gfc_symtree __attribute__((__unused__)) *st)
void gfc2pips_shiftAdressesOfArea(entity _area, int old_offset, int size, int max_offset, int shift)
int gfc2pips_expr2int(gfc_expr *expr)
entity gfc2pips_code2get_label3(gfc_code *c)
list gfc2pips_vars_(gfc_namespace *ns, list variables_p)
Convert the list of gfc symbols into a list of pips entities with storage, type, everything.
statement instruction_to_statement(instruction)
Build a statement from a give instruction.
statement make_empty_block_statement(void)
Build an empty statement (block/sequence)
void reset_current_module_entity(void)
Reset the current module entity.
const char * get_current_module_name(void)
Get the name of the current module.
entity set_current_module_entity(entity)
static.c
entity get_current_module_entity(void)
Get the entity of the current module.
instruction make_instruction_block(list statements)
Build an instruction block from a list of statements.
instruction make_continue_instruction()
Creates a CONTINUE instruction, that is the FORTRAN nop, the ";" in C or the "pass" in Python for exa...
instruction make_assign_instruction(expression l, expression r)
instruction MakeUnaryCallInst(entity f, expression e)
Creates a call instruction to a function with one argument.
instruction MakeNullaryCallInst(entity f)
Creates a call instruction to a function with no argument.
list gen_nreverse(list cp)
reverse a list in place
void gen_remove(list *cpp, const void *o)
remove all occurences of item o from list *cpp, which is thus modified.
#define POP(l)
Modify a list pointer to point on the next element of the list.
#define NIL
The empty list (nil in Lisp)
list gen_copy_seq(list l)
Copy a list structure.
size_t gen_length(const list l)
list gen_cons(const void *item, const list next)
#define CONS(_t_, _i_, _l_)
List element cell constructor (insert an element at the beginning of a list)
list gen_nconc(list cp1, list cp2)
physically concatenates CP1 and CP2 but do not duplicates the elements
#define CAR(pcons)
Get the value of the first element of a list.
#define FOREACH(_fe_CASTER, _fe_item, _fe_list)
Apply/map an instruction block on all the elements of a list.
#define CDR(pcons)
Get the list less its first element.
void * gen_find_eq(const void *item, const list seq)
test statement_test(statement)
Get the test of a statement.
statement make_continue_statement(entity)
#define full_name(dir, name)
static void symbol(Pproblem XX, int v)
N note: if use janus.c then not static DN.
#define pips_debug
these macros use the GNU extensions that allow variadic macros, including with an empty list.
#define pips_user_warning
#define pips_assert(what, predicate)
common macros, two flavors depending on NDEBUG
#define pips_internal_error
#define DYNAMIC_AREA_LOCAL_NAME
#define LIST_DIRECTED_FORMAT_NAME
#define ALLOCATABLE_AREA_LOCAL_NAME
#define TOP_LEVEL_MODULE_NAME
Module containing the global variables in Fortran and C.
#define STACK_AREA_LOCAL_NAME
#define STATIC_AREA_LOCAL_NAME
#define MODULE_SEP_STRING
#define BLANK_COMMON_LOCAL_NAME
#define STATEMENT_ORDERING_UNDEFINED
mapping.h inclusion
#define message_assert(msg, ex)
string strupper(string, const char *)
string concatenate(const char *,...)
Return the concatenation of the given strings.
void * gen_find_tabulated(const char *, int)
entity find_or_create_allocatable_struct(basic b, string name, int ndim)
This function try to find the allocatable structure corresponding to the number of dimensions request...
void print_expression(expression e)
no file descriptor is passed to make is easier to use in a debugging stage.
void UpdateFunctionalType(entity f, list l)
This function analyzes the CurrentFunction formal parameter list to determine the CurrentFunction fun...
#define UNBOUNDED_DIMENSION_NAME
#define READ_FUNCTION_NAME
#define ENDFILE_FUNCTION_NAME
#define SUBSTRING_FUNCTION_NAME
#define LESS_THAN_OPERATOR_NAME
#define EQUAL_OPERATOR_NAME
#define RETURN_FUNCTION_NAME
#define BACKSPACE_FUNCTION_NAME
#define DATA_LIST_FUNCTION_NAME
#define UNKNOWN_RAM_OFFSET
#define REWIND_FUNCTION_NAME
#define STATEMENT_NUMBER_UNDEFINED
default values
#define OPEN_FUNCTION_NAME
#define AND_OPERATOR_NAME
FI: intrinsics are defined at a third place after bootstrap and effects! I guess the name should be d...
#define CONTINUE_FUNCTION_NAME
#define ALLOCATE_FUNCTION_NAME
F95.
#define ADDRESS_OF_OPERATOR_NAME
#define entity_variable_p(e)
An entity_variable_p(e) may hide a typedef and hence a functional type.
#define WRITE_FUNCTION_NAME
#define CLOSE_FUNCTION_NAME
#define UNARY_MINUS_OPERATOR_NAME
#define STATIC_INITIALIZATION_FUNCTION_NAME
#define GREATER_OR_EQUAL_OPERATOR_NAME
#define STOP_FUNCTION_NAME
#define test_to_instruction
#define PAUSE_FUNCTION_NAME
#define empty_comments
Empty comments (i.e.
#define MULTIPLY_OPERATOR_NAME
#define LESS_OR_EQUAL_OPERATOR_NAME
#define DEALLOCATE_FUNCTION_NAME
#define INQUIRE_FUNCTION_NAME
#define NOT_OPERATOR_NAME
expression get_allocatable_data_expr(entity e)
This function produce an expression that is an access to the array inside the allocatable structure.
bool entity_allocatable_p(entity e)
Check if an entity is an allocatable.
entity FindEntity(const char *package, const char *name)
Retrieve an entity from its package/module name and its local name.
const char * entity_local_name(entity e)
entity_local_name modified so that it does not core when used in vect_fprint, since someone thought t...
entity FindOrCreateEntity(const char *package, const char *local_name)
Problem: A functional global entity may be referenced without parenthesis or CALL keyword in a functi...
entity make_empty_program(const char *name, language l)
code entity_code(entity e)
entity make_empty_blockdata(const char *name, language l)
entity make_empty_subroutine(const char *name, language l)
entity entity_empty_label(void)
entity make_new_common(string name, entity mod)
This function creates a common for a given name in a given module.
static int init
Maximal value set for Fortran 77.
const char * module_local_name(entity e)
Returns the module local user name.
code EntityCode(entity e)
this function checks that e has an initial value code.
entity CreateIntrinsic(string name)
this function does not create an intrinsic function because they must all be created beforehand by th...
entity entity_intrinsic(const char *name)
FI: I do not understand this function name (see next one!).
entity make_label(const char *module_name, const char *local_name)
entity make_empty_function(const char *name, type r, language l)
entity make_empty_f95module(const char *name, language l)
expression make_call_expression(entity e, list l)
Build an expression that call an function entity with an argument list.
expression entity_to_expression(entity e)
if v is a constant, returns a constant call.
expression MakeBinaryCall(entity f, expression eg, expression ed)
Creates a call expression to a function with 2 arguments.
expression int_to_expression(_int i)
transform an int into an expression and generate the corresponding entity if necessary; it is not cle...
expression MakeNullaryCall(entity f)
Creates a call expression to a function with zero arguments.
expression call_to_expression(call c)
Build an expression that call a function or procedure.
extensions empty_extensions(void)
extension.c
bool SizeOfArray(entity, int *)
This function computes the total size of a variable in bytes, ie.
void AddEntityToDeclarations(entity, entity)
END_EOLE.
type MakeTypeUnknown(void)
type MakeOverloadedResult(void)
this function creates a default fortran operator result, i.e.
type MakeTypeVariable(basic, cons *)
BEGIN_EOLE.
#define type_functional_p(x)
#define normalized_undefined
#define functional_result(x)
#define instruction_sequence_p(x)
#define syntax_reference(x)
#define instruction_loop_p(x)
#define reference_variable(x)
#define instruction_loop(x)
#define type_functional(x)
#define basic_derived_p(x)
#define entity_storage(x)
#define code_declarations(x)
#define EXPRESSION(x)
EXPRESSION.
#define instruction_undefined
#define statement_label(x)
#define expression_undefined
#define functional_parameters(x)
#define code_initializations(x)
#define sequence_statements(x)
#define instruction_call_p(x)
#define syntax_undefined_p(x)
#define instruction_call(x)
struct _newgen_struct_formal_ * formal
#define expression_syntax(x)
#define entity_domain
newgen_syntax_domain_defined
#define statement_undefined
#define STATEMENT(x)
STATEMENT.
#define storage_undefined
#define entity_initial(x)
Pcontrainte eq
element du vecteur colonne du systeme donne par l'analyse
Pvecteur cp
pointeur sur l'egalite ou l'inegalite courante
int fprintf()
test sc_min : ce test s'appelle par : programme fichier1.data fichier2.data ...
static int variables[MAX_VAR]
The structure used to build lists in NewGen.
struct cons * cdr
The pointer to the next element.
gen_chunk car
The data payload of a list element.
code taken from http://fast-edge.googlecode.com and adapted to c99
expression loop_to_implieddo(loop)
expression MakeFortranUnaryCall(entity op, expression e1)
void set_current_number_of_alternate_returns()
instruction MakeZeroOrOneArgCallInst(char *s, expression e)
this function creates a simple Fortran statement such as RETURN, CONTINUE, ...
A gen_chunk is used to store every object.
void * e
For externals (foreign objects)