Changeset 1200 for trunk/AGRIF/LIB/fortran.y
- Timestamp:
- 2008-09-24T15:05:20+02:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/AGRIF/LIB/fortran.y
r774 r1200 43 43 char c_selectorname[LONG_C]; 44 44 char ligne[LONG_C]; 45 char truename[LONGNOM]; 45 46 char identcopy[LONG_C]; 46 47 int c_selectorgiven=0; … … 61 62 listnom *ln; 62 63 listcouple *lc; 64 listname *lnn; 63 65 typedim dim1; 64 66 variable *v; … … 69 71 %right '=' 70 72 %left TOK_BINARY_OP 71 %left EQVNEQV73 %left TOK_EQV TOK_NEQV 72 74 %left TOK_OR TOK_XOR 73 75 %left TOK_AND … … 81 83 82 84 %token TOK_SEP 85 %token TOK_SEMICOLON 83 86 %token TOK_NEXTLINE 84 87 %token TOK_PARAMETER … … 110 113 %token TOK_EXIST 111 114 %token TOK_MIN 112 %token TOK_INT113 115 %token TOK_FLOAT 114 116 %token TOK_EXP … … 199 201 %token <nac> TOK_DASTER 200 202 %token <nac> TOK_EQ 203 %token <nac> TOK_EQV 201 204 %token <nac> TOK_GT 202 205 %token <nac> TOK_LT 203 206 %token <nac> TOK_GE 204 207 %token <nac> TOK_NE 208 %token <nac> TOK_NEQV 205 209 %token <nac> TOK_LE 206 210 %token <nac> TOK_OR … … 248 252 %token <nac> TOK_FILENAME 249 253 %token ',' 250 %token ';'251 254 %token ':' 252 255 %token '(' … … 291 294 %type <nac> opt_signe 292 295 %type <nac> filename 296 %type <na> attribute 293 297 %type <na> complex_const 294 298 %type <na> begin_array … … 322 326 %type <na> operation 323 327 %type <na> proper_lengspec 328 %type <lnn> use_name_list 329 %type <lnn> public 324 330 325 331 %left TOK_OP … … 336 342 ; 337 343 suite_line_list : suite_line 338 | suite_line ';' suite_line_list339 ; 340 suite_line : entry fin_line /* subroutine, function, module */344 | suite_line_list TOK_SEMICOLON suite_line 345 ; 346 suite_line : entry fin_line /* subroutine, function, module */ 341 347 | spec fin_line /* declaration */ 342 348 | before_include filename fin_line … … 561 567 if ( firstpass == 1 && couldaddvariable == 1) 562 568 { 569 strcpy(nameinttypenameback,nameinttypename); 570 strcpy(nameinttypename,""); 563 571 curvar=createvar($1,NULL); 572 strcpy(nameinttypename,nameinttypenameback); 564 573 curlistvar=insertvar(NULL,curvar); 565 574 $$=settype("",curlistvar); … … 570 579 if ( firstpass == 1 && couldaddvariable == 1) 571 580 { 581 strcpy(nameinttypenameback,nameinttypename); 582 strcpy(nameinttypename,""); 572 583 curvar=createvar($3,NULL); 584 strcpy(nameinttypename,nameinttypenameback); 573 585 $$=insertvar($1,curvar); 574 586 } … … 609 621 else Add_Parameter_Var_1($3); 610 622 pos_end = setposcur(); 611 623 RemoveWordSET_0(fortranout,pos_cur_decl, 612 624 pos_end-pos_cur_decl); 613 625 } … … 672 684 } 673 685 | public 686 { 687 if (firstpass == 0) 688 { 689 if ($1) 690 { 691 removeglobfromlist(&($1)); 692 pos_end = setposcur(); 693 RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur); 694 writelistpublic($1); 695 } 696 } 697 } 674 698 | private 675 699 | use_stat … … 752 776 { 753 777 pos_end = setposcur(); 754 RemoveWordSET_0(fortranout,pos_cur_decl, 778 /*if (insubroutinedeclare == 0) 779 { */ 780 RemoveWordSET_0(fortranout,pos_cur_decl, 755 781 pos_end-pos_cur_decl); 782 783 /* } 784 else 785 {*/ 786 ReWriteDeclarationAndAddTosubroutine_01($1); 787 pos_cur_decl = setposcur(); 788 789 /*}*/ 756 790 if ( firstpass == 0 && 757 791 GlobalDeclaration == 0 && … … 769 803 $$ = $1; 770 804 Add_Globliste_1($1); 805 771 806 if ( insubroutinedeclare == 0 ) 772 807 Add_GlobalParameter_Var_1($1); … … 780 815 /* if variables has been declared in a subroutine */ 781 816 if ( insubroutinedeclare == 1 ) 782 { 783 Add_SubroutineDeclaration_Var_1($1);817 { 818 /* Add_SubroutineDeclaration_Var_1($1);*/ 784 819 } 785 820 /* If there are a SAVE declarations in module's */ … … 845 880 writeheadnewsub_0(2); 846 881 } 882 strcpy(nameinttypename,""); 883 847 884 } 848 885 ; … … 998 1035 ; 999 1036 public : TOK_PUBLIC '\n' 1037 { 1038 $$=(listname *)NULL; 1039 } 1000 1040 | TOK_PUBLIC opt_sep use_name_list 1041 { 1042 $$=$3; 1043 } 1001 1044 ; 1002 1045 use_name_list : TOK_NAME 1046 { 1047 $$ = Insertname(NULL,$1); 1048 } 1003 1049 | use_name_list ',' TOK_NAME 1050 { 1051 $$ = Insertname($1,$3); 1052 } 1004 1053 ; 1005 1054 common : before_common var_common_list … … 1222 1271 before_typepar : TOK_TYPEPAR 1223 1272 { 1224 if ( couldaddvariable == 1 ) VarTypepar = 1 ;1273 /* if ( couldaddvariable == 1 ) VarTypepar = 1 ; 1225 1274 couldaddvariable = 0 ; 1226 pos_cur_decl = setposcur()-5; 1275 pos_cur_decl = setposcur()-5;*/ 1276 pos_cur_decl = setposcur()-5; 1227 1277 } 1228 1278 ; … … 1425 1475 | TOK_REAL '(' minmaxlist ')' 1426 1476 {sprintf($$,"REAL(%s)",$3);} 1427 | TOK_INT '(' expr ')'1428 {sprintf($$,"INT(%s)",$3);}1429 1477 | TOK_NINT '(' expr ')' 1430 1478 {sprintf($$,"NINT(%s)",$3);} … … 1492 1540 | TOK_EQ expr %prec TOK_EQ 1493 1541 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1542 | TOK_EQV expr %prec TOK_EQV 1543 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1494 1544 | TOK_GT expr %prec TOK_EQ 1495 1545 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} … … 1510 1560 | TOK_NE expr %prec TOK_EQ 1511 1561 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1562 | TOK_NEQV expr %prec TOK_EQV 1563 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1512 1564 | TOK_XOR expr 1513 1565 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} … … 1631 1683 strcpy(identcopy,$1); 1632 1684 pointedvar=0; 1685 strcpy(truename,$1); 1686 if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1)); 1687 /* 1633 1688 if ( VarIsNonGridDepend($1) == 0 && 1634 1689 Variableshouldberemove($1) == 0 ) … … 1638 1693 varispointer_0($1) == 1 ) 1639 1694 { 1640 ModifyTheVariableName_0($1); 1695 if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1)) 1696 { 1697 if (varistyped_0($1) == 0) 1698 { 1699 ModifyTheVariableName_0($1); 1700 } 1701 } 1702 else 1703 { 1704 } 1705 } 1706 if (variscoupled_0($1) == 1) 1707 { 1708 printf("mla variable %s est couplee %s\n",$1,getcoupledname_0($1)); 1709 ModifyTheVariableNamecoupled_0($1,getcoupledname_0($1)); 1641 1710 } 1642 1711 if ( inagrifcallargument != 1 || … … 1645 1714 } 1646 1715 NotifyAgrifFunction_0($1); 1716 */ 1717 if ( VarIsNonGridDepend(truename) == 0 && 1718 Variableshouldberemove(truename) == 0 ) 1719 { 1720 if ( inagrifcallargument == 1 || 1721 varisallocatable_0(truename) == 1 || 1722 varispointer_0(truename) == 1 ) 1723 { 1724 if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1)) 1725 { 1726 if (varistyped_0(truename) == 0) 1727 { 1728 ModifyTheVariableName_0(truename,strlen($1)); 1729 } 1730 } 1731 } 1732 if ( inagrifcallargument != 1 || 1733 sameagrifargument ==1 ) 1734 Add_UsedInSubroutine_Var_1(truename); 1735 } 1736 NotifyAgrifFunction_0(truename); 1647 1737 } 1648 1738 } … … 1801 1891 if ( inmoduledeclare == 0 ) 1802 1892 { 1803 pos_end = setposcur(); 1893 1894 pos_end = setposcur(); 1804 1895 RemoveWordSET_0(fortranout,pos_curuse, 1805 1896 pos_end-pos_curuse); 1897 if (oldfortranout) 1898 variableisglobalinmodule($6,$2,oldfortranout,pos_curuseold); 1899 1806 1900 } 1807 1901 else 1808 1902 { 1903 1809 1904 /* if we are in the module declare and if the */ 1810 1905 /* onlylist is a list of global variable */ 1811 variableisglobalinmodule($6, $2, fortranout );1906 variableisglobalinmodule($6, $2, fortranout,pos_curuse); 1812 1907 } 1813 1908 } … … 1818 1913 { 1819 1914 pos_curuse = setposcur()-strlen($1); 1915 if (firstpass == 0 && oldfortranout) { 1916 pos_curuseold = setposcurname(oldfortranout); 1917 } 1820 1918 } 1821 1919 ; … … 1888 1986 Add_SubroutineWhereAgrifUsed_1(subroutinename, 1889 1987 curmodulename); 1988 inallocate = 0; 1890 1989 } 1891 1990 | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' … … 1893 1992 Add_SubroutineWhereAgrifUsed_1(subroutinename, 1894 1993 curmodulename); 1994 inallocate = 0; 1895 1995 } 1896 1996 | TOK_NULLIFY '(' pointer_name_list ')' … … 1932 2032 insubroutinedeclare = 0; 1933 2033 /* */ 1934 pos_cur = setposcur(); 2034 pos_cur = setposcur(); 1935 2035 closeandcallsubloopandincludeit_0(2); 1936 2036 functiondeclarationisdone = 0; … … 1951 2051 insubroutinedeclare = 0; 1952 2052 /* */ 1953 pos_cur = setposcur(); 2053 pos_cur = setposcur(); 1954 2054 closeandcallsubloopandincludeit_0(3); 1955 2055 functiondeclarationisdone = 0; … … 1971 2071 /* */ 1972 2072 pos_cur = setposcur(); 2073 1973 2074 closeandcallsubloopandincludeit_0(1); 1974 2075 functiondeclarationisdone = 0; … … 1989 2090 /* */ 1990 2091 pos_cur = setposcur(); 2092 1991 2093 closeandcallsubloopandincludeit_0(0); 1992 2094 functiondeclarationisdone = 0; … … 2005 2107 { 2006 2108 /* if we never meet the contains keyword */ 2007 Remove_Word_end_module_0( );2109 Remove_Word_end_module_0(strlen($2)); 2008 2110 if ( inmoduledeclare == 1 ) 2009 2111 { … … 2012 2114 Write_GlobalParameter_Declaration_0(); 2013 2115 Write_NotGridDepend_Declaration_0(); 2116 Write_GlobalType_Declaration_0(); 2014 2117 Write_Alloc_Subroutine_For_End_0(); 2015 2118 } 2016 2119 } 2120 2017 2121 inmoduledeclare = 0 ; 2018 2122 inmodulemeet = 0 ; … … 2050 2154 Remove_Word_Contains_0(); 2051 2155 Write_GlobalParameter_Declaration_0(); 2156 Write_GlobalType_Declaration_0(); 2052 2157 Write_NotGridDepend_Declaration_0(); 2053 2158 Write_Alloc_Subroutine_0(); … … 2064 2169 insubroutinedeclare = 0; 2065 2170 /* */ 2171 2066 2172 closeandcallsubloop_contains_0(); 2067 2173 functiondeclarationisdone = 0; … … 2152 2258 Add_SubroutineWhereAgrifUsed_1(subroutinename, 2153 2259 curmodulename); 2260 inallocate = 0; 2154 2261 } 2155 2262 | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' … … 2157 2264 Add_SubroutineWhereAgrifUsed_1(subroutinename, 2158 2265 curmodulename); 2266 inallocate = 0; 2159 2267 } 2160 2268 | TOK_EXIT optexpr … … 2192 2300 callmpiinit == 1) 2193 2301 { 2194 pos_end = setposcur();2302 /* pos_end = setposcur(); 2195 2303 RemoveWordSET_0(fortranout,pos_curcall, 2196 2304 pos_end-pos_curcall); 2197 2305 fprintf(oldfortranout," Call MPI_Init (%s) \n" 2198 ,mpiinitvar); 2306 ,mpiinitvar);*/ 2199 2307 } 2200 2308 if ( oldfortranout && … … 2276 2384 io : iofctl ioctl 2277 2385 | read option_read 2386 | write ioctl 2387 | write ioctl outlist 2278 2388 | TOK_REWIND after_rewind 2279 2389 | TOK_FORMAT … … 2331 2441 read :TOK_READ 2332 2442 | TOK_INQUIRE 2333 | TOK_WRITE2334 2443 | TOK_PRINT 2335 2444 ; 2445 2446 write : TOK_WRITE 2447 ; 2448 2336 2449 fexpr : unpar_fexpr 2337 2450 | '(' fexpr ')' … … 2370 2483 | opt_operation operation 2371 2484 ; 2372 outlist : other {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2485 outlist : uexpr {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2486 | other {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2373 2487 | out2 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2374 2488 ; … … 2538 2652 couldaddvariable=1; 2539 2653 aftercontainsdeclare = 1; 2654 strcpy(nameinttypename,""); 2540 2655 /* Name of the file without format */ 2541 2656 tmp = strchr(fichier_entree, '.');
Note: See TracChangeset
for help on using the changeset viewer.