From ca05420451fe5f98d32c0039a9d3fec7c2b566f1 Mon Sep 17 00:00:00 2001 From: Alexander Date: Thu, 13 Mar 2025 12:48:07 +0300 Subject: [PATCH] moved dvm to submodule --- CMakeLists.txt | 20 +- projects/Fdvm/CMakeLists.txt | 7 +- projects/Parser/CMakeLists.txt | 8 +- projects/SageLib/CMakeLists.txt | 4 +- projects/SageNewSrc/CMakeLists.txt | 4 +- projects/SageOldSrc/CMakeLists.txt | 4 +- projects/dvm_svn/fdvm/CMakeLists.txt | 1 - projects/dvm_svn/fdvm/trunk/CMakeLists.txt | 7 - .../fdvm/trunk/InlineExpansion/CMakeLists.txt | 23 - .../fdvm/trunk/InlineExpansion/dvm_tag.h | 85 - .../fdvm/trunk/InlineExpansion/hlp.cpp | 622 - .../fdvm/trunk/InlineExpansion/inl_exp.cpp | 1750 -- .../fdvm/trunk/InlineExpansion/inline.h | 643 - .../fdvm/trunk/InlineExpansion/inliner.cpp | 2993 -- .../fdvm/trunk/InlineExpansion/intrinsic.h | 196 - .../fdvm/trunk/InlineExpansion/makefile.uni | 46 - .../fdvm/trunk/InlineExpansion/makefile.win | 61 - projects/dvm_svn/fdvm/trunk/Makefile | 17 - .../dvm_svn/fdvm/trunk/Sage/CMakeLists.txt | 4 - projects/dvm_svn/fdvm/trunk/Sage/LICENSE | 67 - projects/dvm_svn/fdvm/trunk/Sage/Makefile | 106 - .../fdvm/trunk/Sage/Sage++/CMakeLists.txt | 14 - .../dvm_svn/fdvm/trunk/Sage/Sage++/Makefile | 97 - .../fdvm/trunk/Sage/Sage++/libSage++.cpp | 9158 ------- .../fdvm/trunk/Sage/Sage++/makefile.uni | 40 - .../fdvm/trunk/Sage/Sage++/makefile.win | 49 - projects/dvm_svn/fdvm/trunk/Sage/h/Makefile | 20 - projects/dvm_svn/fdvm/trunk/Sage/h/bif.h | 453 - .../dvm_svn/fdvm/trunk/Sage/h/compatible.h | 77 - projects/dvm_svn/fdvm/trunk/Sage/h/db.h | 187 - projects/dvm_svn/fdvm/trunk/Sage/h/db.new.h | 190 - projects/dvm_svn/fdvm/trunk/Sage/h/defines.h | 56 - projects/dvm_svn/fdvm/trunk/Sage/h/defs.h | 131 - projects/dvm_svn/fdvm/trunk/Sage/h/dep.h | 39 - projects/dvm_svn/fdvm/trunk/Sage/h/dep_str.h | 173 - .../dvm_svn/fdvm/trunk/Sage/h/dep_struct.h | 147 - projects/dvm_svn/fdvm/trunk/Sage/h/elist.h | 79 - projects/dvm_svn/fdvm/trunk/Sage/h/f90.h | 27 - projects/dvm_svn/fdvm/trunk/Sage/h/fixcray.h | 10 - projects/dvm_svn/fdvm/trunk/Sage/h/fm.h | 10 - projects/dvm_svn/fdvm/trunk/Sage/h/head | 2 - .../dvm_svn/fdvm/trunk/Sage/h/leak_detector.h | 18 - projects/dvm_svn/fdvm/trunk/Sage/h/list.h | 34 - projects/dvm_svn/fdvm/trunk/Sage/h/ll.h | 163 - projects/dvm_svn/fdvm/trunk/Sage/h/prop.h | 24 - projects/dvm_svn/fdvm/trunk/Sage/h/sage.h | 21 - projects/dvm_svn/fdvm/trunk/Sage/h/sagearch.h | 2 - projects/dvm_svn/fdvm/trunk/Sage/h/sageroot.h | 1 - projects/dvm_svn/fdvm/trunk/Sage/h/sets.h | 86 - projects/dvm_svn/fdvm/trunk/Sage/h/symb.h | 225 - projects/dvm_svn/fdvm/trunk/Sage/h/symblob.h | 17 - projects/dvm_svn/fdvm/trunk/Sage/h/tag | 628 - projects/dvm_svn/fdvm/trunk/Sage/h/tag.doc | 274 - projects/dvm_svn/fdvm/trunk/Sage/h/tag.h | 630 - projects/dvm_svn/fdvm/trunk/Sage/h/tag_make | 7 - projects/dvm_svn/fdvm/trunk/Sage/h/version.h | 2 - projects/dvm_svn/fdvm/trunk/Sage/h/vextern.h | 167 - projects/dvm_svn/fdvm/trunk/Sage/h/vparse.h | 126 - projects/dvm_svn/fdvm/trunk/Sage/h/vpc.h | 182 - projects/dvm_svn/fdvm/trunk/Sage/h/window.h | 71 - .../fdvm/trunk/Sage/lib/CMakeLists.txt | 6 - projects/dvm_svn/fdvm/trunk/Sage/lib/Makefile | 55 - .../fdvm/trunk/Sage/lib/include/attributes.h | 95 - .../fdvm/trunk/Sage/lib/include/baseClasses.h | 124 - .../fdvm/trunk/Sage/lib/include/bif_node.def | 594 - .../fdvm/trunk/Sage/lib/include/dependence.h | 117 - .../fdvm/trunk/Sage/lib/include/ext_ann.h | 56 - .../fdvm/trunk/Sage/lib/include/ext_high.h | 29 - .../fdvm/trunk/Sage/lib/include/ext_lib.h | 24 - .../fdvm/trunk/Sage/lib/include/ext_low.h | 269 - .../fdvm/trunk/Sage/lib/include/ext_mid.h | 64 - .../fdvm/trunk/Sage/lib/include/extcxx_low.h | 272 - .../fdvm/trunk/Sage/lib/include/libSage++.h | 9921 ------- .../fdvm/trunk/Sage/lib/include/macro.h | 434 - .../trunk/Sage/lib/include/sage++callgraph.h | 123 - .../Sage/lib/include/sage++classhierarchy.h | 216 - .../trunk/Sage/lib/include/sage++extern.h | 34 - .../fdvm/trunk/Sage/lib/include/sage++proto.h | 40 - .../fdvm/trunk/Sage/lib/include/sage++user.h | 45 - .../fdvm/trunk/Sage/lib/include/symb.def | 30 - .../fdvm/trunk/Sage/lib/include/type.def | 69 - .../fdvm/trunk/Sage/lib/include/unparse.def | 1060 - .../trunk/Sage/lib/include/unparseC++.def | 833 - .../trunk/Sage/lib/include/unparseDVM.def | 448 - .../dvm_svn/fdvm/trunk/Sage/lib/makefile.uni | 35 - .../dvm_svn/fdvm/trunk/Sage/lib/makefile.win | 48 - .../fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt | 16 - .../fdvm/trunk/Sage/lib/newsrc/Makefile | 83 - .../fdvm/trunk/Sage/lib/newsrc/annotate.tab.c | 3145 --- .../fdvm/trunk/Sage/lib/newsrc/annotate.tab.h | 74 - .../fdvm/trunk/Sage/lib/newsrc/annotate.y | 1988 -- .../fdvm/trunk/Sage/lib/newsrc/comments.c | 694 - .../fdvm/trunk/Sage/lib/newsrc/low_level.c | 9147 ------- .../fdvm/trunk/Sage/lib/newsrc/makefile.uni | 40 - .../fdvm/trunk/Sage/lib/newsrc/makefile.win | 54 - .../fdvm/trunk/Sage/lib/newsrc/toolsann.c | 1043 - .../fdvm/trunk/Sage/lib/newsrc/unparse.c | 3265 --- .../fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt | 18 - .../fdvm/trunk/Sage/lib/oldsrc/Makefile | 123 - .../fdvm/trunk/Sage/lib/oldsrc/anal_ind.c | 1031 - .../dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db.c | 2308 -- .../fdvm/trunk/Sage/lib/oldsrc/db_unp.c | 1956 -- .../fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c | 10 - .../fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c | 1924 -- .../fdvm/trunk/Sage/lib/oldsrc/dbutils.c | 961 - .../fdvm/trunk/Sage/lib/oldsrc/garb_coll.c | 229 - .../fdvm/trunk/Sage/lib/oldsrc/glob_anal.c | 494 - .../fdvm/trunk/Sage/lib/oldsrc/ker_fun.c | 433 - .../dvm_svn/fdvm/trunk/Sage/lib/oldsrc/list.c | 655 - .../fdvm/trunk/Sage/lib/oldsrc/make_nodes.c | 641 - .../fdvm/trunk/Sage/lib/oldsrc/makefile.uni | 83 - .../fdvm/trunk/Sage/lib/oldsrc/makefile.win | 96 - .../fdvm/trunk/Sage/lib/oldsrc/mod_ref.c | 540 - .../fdvm/trunk/Sage/lib/oldsrc/ndeps.c | 1076 - .../fdvm/trunk/Sage/lib/oldsrc/readnodes.c | 1124 - .../dvm_svn/fdvm/trunk/Sage/lib/oldsrc/sets.c | 1818 -- .../fdvm/trunk/Sage/lib/oldsrc/setutils.c | 2518 -- .../fdvm/trunk/Sage/lib/oldsrc/symb_alg.c | 1050 - .../fdvm/trunk/Sage/lib/oldsrc/writenodes.c | 1018 - projects/dvm_svn/fdvm/trunk/Sage/makefile.uni | 35 - projects/dvm_svn/fdvm/trunk/Sage/makefile.win | 46 - .../CodeTransformer/CodeTransformer.vcxproj | 123 - .../CodeTransformer.vcxproj.filters | 74 - .../FDVM/FDVM.sln | 65 - .../FDVM/FDVM/FDVM.vcxproj | 131 - .../FDVM/FDVM/FDVM.vcxproj.filters | 96 - .../FDVM/NEWsrc/NEWsrc.vcxproj | 98 - .../FDVM/NEWsrc/NEWsrc.vcxproj.filters | 25 - .../FDVM/OLDsrc/OLDsrc.vcxproj | 114 - .../FDVM/OLDsrc/OLDsrc.vcxproj.filters | 73 - .../FDVM/Parser/Parser.vcxproj | 120 - .../FDVM/Parser/Parser.vcxproj.filters | 72 - .../FDVM/SageLib++/SageLib++.vcxproj | 97 - .../FDVM/SageLib++/SageLib++.vcxproj.filters | 22 - .../FDVM/inlineExp/inlineExp.vcxproj | 104 - .../FDVM/inlineExp/inlineExp.vcxproj.filters | 33 - .../fdvm/trunk/acrossDebugging/across.cpp | 494 - .../dvm_svn/fdvm/trunk/examples/gausf.fdv | 60 - .../dvm_svn/fdvm/trunk/examples/gausgb.fdv | 57 - .../dvm_svn/fdvm/trunk/examples/gaush.hpf | 45 - .../dvm_svn/fdvm/trunk/examples/gauswh.fdv | 53 - projects/dvm_svn/fdvm/trunk/examples/jac.fdv | 47 - .../dvm_svn/fdvm/trunk/examples/jacas.fdv | 62 - projects/dvm_svn/fdvm/trunk/examples/jach.hpf | 44 - .../dvm_svn/fdvm/trunk/examples/redbf.fdv | 46 - .../dvm_svn/fdvm/trunk/examples/redbh.hpf | 53 - projects/dvm_svn/fdvm/trunk/examples/sor.fdv | 38 - .../dvm_svn/fdvm/trunk/examples/task2j.fdv | 130 - .../dvm_svn/fdvm/trunk/examples/tasks.fdv | 126 - .../dvm_svn/fdvm/trunk/examples/taskst.fdv | 169 - .../dvm_svn/fdvm/trunk/fdvm/CMakeLists.txt | 27 - projects/dvm_svn/fdvm/trunk/fdvm/Makefile | 158 - projects/dvm_svn/fdvm/trunk/fdvm/acc.cpp | 15256 ----------- .../dvm_svn/fdvm/trunk/fdvm/acc_across.cpp | 6318 ----- .../fdvm/trunk/fdvm/acc_across_analyzer.cpp | 2249 -- .../dvm_svn/fdvm/trunk/fdvm/acc_analyzer.cpp | 4325 --- projects/dvm_svn/fdvm/trunk/fdvm/acc_data.cpp | 47 - projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c.cpp | 3584 --- .../fdvm/trunk/fdvm/acc_f2c_handlers.cpp | 305 - .../fdvm/trunk/fdvm/acc_index_analyzer.cpp | 58 - projects/dvm_svn/fdvm/trunk/fdvm/acc_rtc.cpp | 390 - .../fdvm/trunk/fdvm/acc_unused_code.cpp | 87 - .../dvm_svn/fdvm/trunk/fdvm/acc_utilities.cpp | 1038 - .../fdvm/trunk/fdvm/aks_analyzeLoops.cpp | 2567 -- .../fdvm/trunk/fdvm/aks_loopStructure.cpp | 615 - .../dvm_svn/fdvm/trunk/fdvm/aks_structs.cpp | 206 - projects/dvm_svn/fdvm/trunk/fdvm/calls.cpp | 2589 -- .../dvm_svn/fdvm/trunk/fdvm/checkpoint.cpp | 552 - projects/dvm_svn/fdvm/trunk/fdvm/debug.cpp | 1181 - projects/dvm_svn/fdvm/trunk/fdvm/dvm.cpp | 14930 ---------- projects/dvm_svn/fdvm/trunk/fdvm/funcall.cpp | 4999 ---- projects/dvm_svn/fdvm/trunk/fdvm/help.cpp | 1070 - projects/dvm_svn/fdvm/trunk/fdvm/hpf.cpp | 1698 -- projects/dvm_svn/fdvm/trunk/fdvm/io.cpp | 2905 -- projects/dvm_svn/fdvm/trunk/fdvm/makefile.uni | 151 - projects/dvm_svn/fdvm/trunk/fdvm/makefile.win | 148 - projects/dvm_svn/fdvm/trunk/fdvm/omp.cpp | 879 - projects/dvm_svn/fdvm/trunk/fdvm/ompdebug.cpp | 3557 --- projects/dvm_svn/fdvm/trunk/fdvm/parloop.cpp | 2587 -- projects/dvm_svn/fdvm/trunk/fdvm/stmt.cpp | 1583 -- .../fdvm/trunk/include/acc_across_analyzer.h | 157 - .../dvm_svn/fdvm/trunk/include/acc_analyzer.h | 1211 - .../dvm_svn/fdvm/trunk/include/acc_data.h | 76 - .../fdvm/trunk/include/aks_loopStructure.h | 136 - .../dvm_svn/fdvm/trunk/include/aks_structs.h | 207 - projects/dvm_svn/fdvm/trunk/include/calls.h | 74 - projects/dvm_svn/fdvm/trunk/include/dvm.h | 2386 -- projects/dvm_svn/fdvm/trunk/include/dvm_tag.h | 160 - projects/dvm_svn/fdvm/trunk/include/extern.h | 58 - projects/dvm_svn/fdvm/trunk/include/fdvm.h | 74 - .../dvm_svn/fdvm/trunk/include/fdvm_version.h | 1 - projects/dvm_svn/fdvm/trunk/include/inc.h | 11 - .../fdvm/trunk/include/leak_detector.h | 18 - .../dvm_svn/fdvm/trunk/include/libSageOMP.h | 2000 -- projects/dvm_svn/fdvm/trunk/include/libdvm.h | 341 - projects/dvm_svn/fdvm/trunk/include/libnum.h | 341 - .../dvm_svn/fdvm/trunk/include/unparse.hpf | 1127 - .../dvm_svn/fdvm/trunk/include/unparse1.hpf | 1097 - projects/dvm_svn/fdvm/trunk/include/user.h | 47 - projects/dvm_svn/fdvm/trunk/makefile.uni | 46 - projects/dvm_svn/fdvm/trunk/makefile.win | 69 - .../dvm_svn/fdvm/trunk/parser/CMakeLists.txt | 33 - projects/dvm_svn/fdvm/trunk/parser/Makefile | 196 - projects/dvm_svn/fdvm/trunk/parser/cftn.c | 922 - projects/dvm_svn/fdvm/trunk/parser/errors.c | 352 - projects/dvm_svn/fdvm/trunk/parser/facc.gram | 145 - projects/dvm_svn/fdvm/trunk/parser/fdvm.gram | 2257 -- projects/dvm_svn/fdvm/trunk/parser/fomp.gram | 644 - projects/dvm_svn/fdvm/trunk/parser/fspf.gram | 214 - projects/dvm_svn/fdvm/trunk/parser/ftn.gram | 4594 ---- .../dvm_svn/fdvm/trunk/parser/gram1.tab.c | 14474 ---------- .../dvm_svn/fdvm/trunk/parser/gram1.tab.h | 440 - projects/dvm_svn/fdvm/trunk/parser/gram1.y | 8211 ------ projects/dvm_svn/fdvm/trunk/parser/hash.c | 286 - projects/dvm_svn/fdvm/trunk/parser/head | 2 - projects/dvm_svn/fdvm/trunk/parser/init.c | 281 - projects/dvm_svn/fdvm/trunk/parser/lexfdvm.c | 3319 --- projects/dvm_svn/fdvm/trunk/parser/lists.c | 108 - projects/dvm_svn/fdvm/trunk/parser/low_hpf.c | 1006 - .../dvm_svn/fdvm/trunk/parser/makefile.uni | 99 - .../dvm_svn/fdvm/trunk/parser/makefile.win | 129 - projects/dvm_svn/fdvm/trunk/parser/misc.c | 212 - projects/dvm_svn/fdvm/trunk/parser/stat.c | 1449 - projects/dvm_svn/fdvm/trunk/parser/sym.c | 2012 -- projects/dvm_svn/fdvm/trunk/parser/tag | 628 - projects/dvm_svn/fdvm/trunk/parser/tag.h | 630 - projects/dvm_svn/fdvm/trunk/parser/tokdefs.h | 357 - projects/dvm_svn/fdvm/trunk/parser/tokens | 357 - projects/dvm_svn/fdvm/trunk/parser/types.c | 778 - .../dvm_svn/fdvm/trunk/parser/unparse_hpf.c | 4895 ---- .../fdvm/trunk/sageExample/SwapFors.cpp | 1565 -- .../fdvm/trunk/sageExample/makefile.uni | 42 - .../fdvm/trunk/sageExample/makefile.win | 59 - projects/dvm_svn/tools/Zlib/CMakeLists.txt | 1 - projects/dvm_svn/tools/Zlib/include/deflate.h | 318 - .../dvm_svn/tools/Zlib/include/infblock.h | 39 - .../dvm_svn/tools/Zlib/include/infcodes.h | 27 - projects/dvm_svn/tools/Zlib/include/inffast.h | 17 - .../dvm_svn/tools/Zlib/include/inffixed.h | 151 - .../dvm_svn/tools/Zlib/include/inftrees.h | 58 - projects/dvm_svn/tools/Zlib/include/infutil.h | 98 - projects/dvm_svn/tools/Zlib/include/trees.h | 128 - projects/dvm_svn/tools/Zlib/include/zconf.h | 283 - projects/dvm_svn/tools/Zlib/include/zlib.h | 913 - projects/dvm_svn/tools/Zlib/include/zutil.h | 227 - projects/dvm_svn/tools/Zlib/makefile.uni | 72 - projects/dvm_svn/tools/Zlib/makefile.win | 316 - .../dvm_svn/tools/Zlib/src/CMakeLists.txt | 12 - projects/dvm_svn/tools/Zlib/src/adler32.c | 45 - projects/dvm_svn/tools/Zlib/src/compress.c | 61 - projects/dvm_svn/tools/Zlib/src/crc32.c | 159 - projects/dvm_svn/tools/Zlib/src/deflate.c | 1308 - projects/dvm_svn/tools/Zlib/src/example.c | 556 - projects/dvm_svn/tools/Zlib/src/gzio.c | 851 - projects/dvm_svn/tools/Zlib/src/infblock.c | 395 - projects/dvm_svn/tools/Zlib/src/infcodes.c | 247 - projects/dvm_svn/tools/Zlib/src/inffast.c | 180 - projects/dvm_svn/tools/Zlib/src/inflate.c | 356 - projects/dvm_svn/tools/Zlib/src/inftrees.c | 458 - projects/dvm_svn/tools/Zlib/src/infutil.c | 85 - projects/dvm_svn/tools/Zlib/src/maketree.c | 85 - projects/dvm_svn/tools/Zlib/src/minigzip.c | 320 - projects/dvm_svn/tools/Zlib/src/trees.c | 1212 - projects/dvm_svn/tools/Zlib/src/uncompr.c | 55 - projects/dvm_svn/tools/Zlib/src/zutil.c | 210 - .../tools/pppa/branches/dvm4.07/makefile.uni | 28 - .../tools/pppa/branches/dvm4.07/makefile.win | 42 - .../tools/pppa/branches/dvm4.07/src/bool.h | 7 - .../tools/pppa/branches/dvm4.07/src/dvmvers.h | 2 - .../tools/pppa/branches/dvm4.07/src/inter.cpp | 350 - .../tools/pppa/branches/dvm4.07/src/inter.h | 72 - .../pppa/branches/dvm4.07/src/makefile.uni | 44 - .../pppa/branches/dvm4.07/src/makefile.win | 46 - .../pppa/branches/dvm4.07/src/potensyn.cpp | 175 - .../pppa/branches/dvm4.07/src/potensyn.h | 52 - .../pppa/branches/dvm4.07/src/statfile.cpp | 523 - .../tools/pppa/branches/dvm4.07/src/statist.h | 7 - .../pppa/branches/dvm4.07/src/statprintf.cpp | 83 - .../pppa/branches/dvm4.07/src/statprintf.h | 23 - .../pppa/branches/dvm4.07/src/statread.cpp | 961 - .../pppa/branches/dvm4.07/src/statread.h | 136 - .../tools/pppa/branches/dvm4.07/src/strall.h | 132 - .../tools/pppa/branches/dvm4.07/src/sysstat.h | 29 - .../pppa/branches/dvm4.07/src/treeinter.cpp | 296 - .../pppa/branches/dvm4.07/src/treeinter.h | 63 - .../tools/pppa/branches/dvm4.07/src/ver.h | 8 - .../pppa/stuff/Zlib_1.1.3/Include/deflate.h | 318 - .../pppa/stuff/Zlib_1.1.3/Include/infblock.h | 39 - .../pppa/stuff/Zlib_1.1.3/Include/infcodes.h | 27 - .../pppa/stuff/Zlib_1.1.3/Include/inffast.h | 17 - .../pppa/stuff/Zlib_1.1.3/Include/inffixed.h | 151 - .../pppa/stuff/Zlib_1.1.3/Include/inftrees.h | 58 - .../pppa/stuff/Zlib_1.1.3/Include/infutil.h | 98 - .../pppa/stuff/Zlib_1.1.3/Include/trees.h | 128 - .../pppa/stuff/Zlib_1.1.3/Include/zconf.h | 279 - .../pppa/stuff/Zlib_1.1.3/Include/zlib.h | 893 - .../pppa/stuff/Zlib_1.1.3/Include/zutil.h | 220 - .../tools/pppa/stuff/Zlib_1.1.3/Src/Makefile | 31 - .../pppa/stuff/Zlib_1.1.3/Src/Makefile.1 | 35 - .../tools/pppa/stuff/Zlib_1.1.3/Src/adler32.c | 48 - .../pppa/stuff/Zlib_1.1.3/Src/compress.c | 68 - .../tools/pppa/stuff/Zlib_1.1.3/Src/crc32.c | 162 - .../tools/pppa/stuff/Zlib_1.1.3/Src/deflate.c | 1350 - .../tools/pppa/stuff/Zlib_1.1.3/Src/example.c | 556 - .../tools/pppa/stuff/Zlib_1.1.3/Src/gzio.c | 875 - .../pppa/stuff/Zlib_1.1.3/Src/infblock.c | 398 - .../pppa/stuff/Zlib_1.1.3/Src/infcodes.c | 257 - .../tools/pppa/stuff/Zlib_1.1.3/Src/inffast.c | 170 - .../tools/pppa/stuff/Zlib_1.1.3/Src/inflate.c | 366 - .../pppa/stuff/Zlib_1.1.3/Src/inftrees.c | 455 - .../tools/pppa/stuff/Zlib_1.1.3/Src/infutil.c | 87 - .../pppa/stuff/Zlib_1.1.3/Src/makefile.uni | 31 - .../pppa/stuff/Zlib_1.1.3/Src/maketree.c | 85 - .../pppa/stuff/Zlib_1.1.3/Src/minigzip.c | 320 - .../tools/pppa/stuff/Zlib_1.1.3/Src/trees.c | 1214 - .../tools/pppa/stuff/Zlib_1.1.3/Src/uncompr.c | 58 - .../tools/pppa/stuff/Zlib_1.1.3/Src/zutil.c | 225 - .../tools/pppa/stuff/Zlib_1.1.3/Zlib.mak | 316 - .../tools/pppa/stuff/Zlib_1.1.3/readme | 148 - .../dvm_svn/tools/pppa/trunk/CMakeLists.txt | 1 - .../dvm_svn/tools/pppa/trunk/makefile.uni | 27 - .../dvm_svn/tools/pppa/trunk/makefile.win | 40 - .../tools/pppa/trunk/src/CMakeLists.txt | 20 - .../tools/pppa/trunk/src/LibraryImport.cpp | 50 - .../tools/pppa/trunk/src/LibraryImport.h | 21 - .../tools/pppa/trunk/src/PPPA/PPPA.sln | 37 - .../pppa/trunk/src/PPPA/PPPA/PPPA.vcxproj | 231 - .../trunk/src/PPPA/PPPA/PPPA.vcxproj.filters | 141 - projects/dvm_svn/tools/pppa/trunk/src/bool.h | 7 - .../dvm_svn/tools/pppa/trunk/src/dvmh_stat.h | 208 - .../dvm_svn/tools/pppa/trunk/src/dvmvers.h.in | 2 - .../dvm_svn/tools/pppa/trunk/src/inter.cpp | 409 - projects/dvm_svn/tools/pppa/trunk/src/inter.h | 178 - .../dvm_svn/tools/pppa/trunk/src/json.hpp | 22828 ---------------- .../dvm_svn/tools/pppa/trunk/src/makefile.uni | 44 - .../dvm_svn/tools/pppa/trunk/src/makefile.win | 46 - .../tools/pppa/trunk/src/makefileJnilib | 49 - .../dvm_svn/tools/pppa/trunk/src/potensyn.cpp | 175 - .../dvm_svn/tools/pppa/trunk/src/potensyn.h | 52 - .../dvm_svn/tools/pppa/trunk/src/stat.cpp | 269 - .../dvm_svn/tools/pppa/trunk/src/statfile.cpp | 1118 - .../tools/pppa/trunk/src/statinter.cpp | 704 - .../dvm_svn/tools/pppa/trunk/src/statinter.h | 93 - .../dvm_svn/tools/pppa/trunk/src/statist.h | 7 - .../dvm_svn/tools/pppa/trunk/src/statlist.cpp | 361 - .../dvm_svn/tools/pppa/trunk/src/statlist.h | 168 - .../tools/pppa/trunk/src/statprintf.cpp | 83 - .../dvm_svn/tools/pppa/trunk/src/statprintf.h | 23 - .../dvm_svn/tools/pppa/trunk/src/statread.cpp | 1242 - .../dvm_svn/tools/pppa/trunk/src/statread.h | 194 - .../dvm_svn/tools/pppa/trunk/src/strall.h | 178 - .../dvm_svn/tools/pppa/trunk/src/sysstat.h | 31 - .../tools/pppa/trunk/src/treeinter.cpp | 473 - .../dvm_svn/tools/pppa/trunk/src/treeinter.h | 86 - projects/dvm_svn/tools/pppa/trunk/src/ver.h | 8 - projects/paths.default.txt | 20 +- 356 files changed, 34 insertions(+), 265540 deletions(-) delete mode 100644 projects/dvm_svn/fdvm/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/dvm_tag.h delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/hlp.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/inl_exp.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/inline.h delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/inliner.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/intrinsic.h delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/LICENSE delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/Sage++/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/Sage++/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/Sage++/libSage++.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/bif.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/compatible.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/db.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/db.new.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/defines.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/defs.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/dep.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/dep_str.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/dep_struct.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/elist.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/f90.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/fixcray.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/fm.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/head delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/leak_detector.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/list.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/ll.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/prop.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/sage.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/sagearch.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/sageroot.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/sets.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/symb.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/symblob.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/tag delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/tag.doc delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/tag.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/tag_make delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/version.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/vextern.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/vparse.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/vpc.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/h/window.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/attributes.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/baseClasses.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/bif_node.def delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/dependence.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_ann.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_high.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_lib.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_low.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_mid.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/extcxx_low.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/libSage++.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/macro.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++callgraph.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++extern.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++proto.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++user.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/symb.def delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/type.def delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparse.def delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseC++.def delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseDVM.def delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.y delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/comments.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/low_level.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/toolsann.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/unparse.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/dbutils.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/list.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ndeps.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/readnodes.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/sets.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/setutils.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/writenodes.c delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/Sage/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj delete mode 100644 projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters delete mode 100644 projects/dvm_svn/fdvm/trunk/acrossDebugging/across.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/gausf.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/gausgb.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/gaush.hpf delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/gauswh.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/jac.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/jacas.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/jach.hpf delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/redbf.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/redbh.hpf delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/sor.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/task2j.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/tasks.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/examples/taskst.fdv delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_across.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_across_analyzer.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_analyzer.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_data.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c_handlers.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_index_analyzer.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_rtc.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_unused_code.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/acc_utilities.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/aks_analyzeLoops.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/aks_loopStructure.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/aks_structs.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/calls.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/checkpoint.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/debug.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/dvm.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/funcall.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/help.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/hpf.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/io.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/omp.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/ompdebug.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/parloop.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/fdvm/stmt.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/include/acc_across_analyzer.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/acc_analyzer.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/acc_data.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/aks_loopStructure.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/aks_structs.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/calls.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/dvm.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/dvm_tag.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/extern.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/fdvm.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/fdvm_version.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/inc.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/leak_detector.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/libSageOMP.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/libdvm.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/libnum.h delete mode 100644 projects/dvm_svn/fdvm/trunk/include/unparse.hpf delete mode 100644 projects/dvm_svn/fdvm/trunk/include/unparse1.hpf delete mode 100644 projects/dvm_svn/fdvm/trunk/include/user.h delete mode 100644 projects/dvm_svn/fdvm/trunk/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/CMakeLists.txt delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/Makefile delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/cftn.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/errors.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/facc.gram delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/fdvm.gram delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/fomp.gram delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/fspf.gram delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/ftn.gram delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/gram1.tab.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/gram1.tab.h delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/gram1.y delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/hash.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/head delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/init.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/lexfdvm.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/lists.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/low_hpf.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/makefile.win delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/misc.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/stat.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/sym.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/tag delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/tag.h delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/tokdefs.h delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/tokens delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/types.c delete mode 100644 projects/dvm_svn/fdvm/trunk/parser/unparse_hpf.c delete mode 100644 projects/dvm_svn/fdvm/trunk/sageExample/SwapFors.cpp delete mode 100644 projects/dvm_svn/fdvm/trunk/sageExample/makefile.uni delete mode 100644 projects/dvm_svn/fdvm/trunk/sageExample/makefile.win delete mode 100644 projects/dvm_svn/tools/Zlib/CMakeLists.txt delete mode 100644 projects/dvm_svn/tools/Zlib/include/deflate.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/infblock.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/infcodes.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/inffast.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/inffixed.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/inftrees.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/infutil.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/trees.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/zconf.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/zlib.h delete mode 100644 projects/dvm_svn/tools/Zlib/include/zutil.h delete mode 100644 projects/dvm_svn/tools/Zlib/makefile.uni delete mode 100644 projects/dvm_svn/tools/Zlib/makefile.win delete mode 100644 projects/dvm_svn/tools/Zlib/src/CMakeLists.txt delete mode 100644 projects/dvm_svn/tools/Zlib/src/adler32.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/compress.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/crc32.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/deflate.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/example.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/gzio.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/infblock.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/infcodes.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/inffast.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/inflate.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/inftrees.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/infutil.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/maketree.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/minigzip.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/trees.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/uncompr.c delete mode 100644 projects/dvm_svn/tools/Zlib/src/zutil.c delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/makefile.uni delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/makefile.win delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/bool.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/dvmvers.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/inter.cpp delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/inter.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/makefile.uni delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/makefile.win delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/potensyn.cpp delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/potensyn.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/statfile.cpp delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/statist.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/statprintf.cpp delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/statprintf.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/statread.cpp delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/statread.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/strall.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/sysstat.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/treeinter.cpp delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/treeinter.h delete mode 100644 projects/dvm_svn/tools/pppa/branches/dvm4.07/src/ver.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/deflate.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/infblock.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/infcodes.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/inffast.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/inffixed.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/inftrees.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/infutil.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/trees.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/zconf.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/zlib.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Include/zutil.h delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/Makefile delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/Makefile.1 delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/adler32.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/compress.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/crc32.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/deflate.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/example.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/gzio.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/infblock.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/infcodes.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/inffast.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/inflate.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/inftrees.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/infutil.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/makefile.uni delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/maketree.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/minigzip.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/trees.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/uncompr.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Src/zutil.c delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/Zlib.mak delete mode 100644 projects/dvm_svn/tools/pppa/stuff/Zlib_1.1.3/readme delete mode 100644 projects/dvm_svn/tools/pppa/trunk/CMakeLists.txt delete mode 100644 projects/dvm_svn/tools/pppa/trunk/makefile.uni delete mode 100644 projects/dvm_svn/tools/pppa/trunk/makefile.win delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/CMakeLists.txt delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/LibraryImport.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/LibraryImport.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/PPPA/PPPA.sln delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/PPPA/PPPA/PPPA.vcxproj delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/PPPA/PPPA/PPPA.vcxproj.filters delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/bool.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/dvmh_stat.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/dvmvers.h.in delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/inter.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/inter.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/json.hpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/makefile.uni delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/makefile.win delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/makefileJnilib delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/potensyn.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/potensyn.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/stat.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statfile.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statinter.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statinter.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statist.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statlist.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statlist.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statprintf.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statprintf.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statread.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/statread.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/strall.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/sysstat.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/treeinter.cpp delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/treeinter.h delete mode 100644 projects/dvm_svn/tools/pppa/trunk/src/ver.h diff --git a/CMakeLists.txt b/CMakeLists.txt index 3b345d9..6f9644e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -13,16 +13,16 @@ add_definitions("-D YYDEBUG") set(CMAKE_CXX_STANDARD 17) -set(fdvm_include projects/dvm_svn/fdvm/trunk/include) -set(fdvm_sources projects/dvm_svn/fdvm/trunk/fdvm/) -set(sage_include_1 projects/dvm_svn/fdvm/trunk/Sage/lib/include) -set(sage_include_2 projects/dvm_svn/fdvm/trunk/Sage/h/) -set(libdb_sources projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc) -set(sage_sources projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc) -set(sagepp_sources projects/dvm_svn/fdvm/trunk/Sage/Sage++) -set(parser_sources projects/dvm_svn/fdvm/trunk/parser) -set(pppa_sources projects/dvm_svn/tools/pppa/trunk/src) -set(zlib_sources projects/dvm_svn/tools/Zlib) +set(fdvm_include projects/dvm/fdvmh/include/fdvmh/) +set(fdvm_sources projects/dvm/fdvmh/tools/fdvmh/) +set(sage_include_1 projects/dvm/fdvmh/include/sage/lib/) +set(sage_include_2 projects/dvm/fdvmh/include/sage/h/) +set(libdb_sources projects/dvm/fdvmh/lib/sage/db/) +set(sage_sources projects/dvm/fdvmh/lib/sage/sage/) +set(sagepp_sources projects/dvm/fdvmh/lib/sage/sage++/) +set(parser_sources projects/dvm/fdvmh/tools/parser/) +set(pppa_sources projects/dvm/pppa/src/) +set(zlib_sources projects/dvm/third-party/Zlib/) include_directories(src) #Sage lib includes diff --git a/projects/Fdvm/CMakeLists.txt b/projects/Fdvm/CMakeLists.txt index 28bff03..e0f64d8 100644 --- a/projects/Fdvm/CMakeLists.txt +++ b/projects/Fdvm/CMakeLists.txt @@ -11,15 +11,16 @@ message("processing ${project}") # Read pathes to external sapfor directories if (EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../paths.txt") - message("Found paths.txt, using custom paths.") +# message("Found paths.txt, using custom paths.") FILE(STRINGS ../paths.txt SAPFOR_PATHS) else () - message("Not found paths.txt, using default paths.") +# message("Not found paths.txt, using default paths.") FILE(STRINGS ../paths.default.txt SAPFOR_PATHS) endif () + foreach (NameAndValue ${SAPFOR_PATHS}) # Strip leading spaces - string(REGEX REPLACE "^[ ]+" "" NameAndValue ${NameAndValue}) + string(REGEX REPLACE "^[ ]+" "" NameAndValue ${NameAndValue}) # Find variable name string(REGEX MATCH "^[^=]+" Name ${NameAndValue}) # Find the value diff --git a/projects/Parser/CMakeLists.txt b/projects/Parser/CMakeLists.txt index 1638e23..20b50a6 100644 --- a/projects/Parser/CMakeLists.txt +++ b/projects/Parser/CMakeLists.txt @@ -11,10 +11,10 @@ message("processing ${project}") # Read pathes to external sapfor directories if (EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../paths.txt") - message("Found paths.txt, using custom paths.") +# message("Found paths.txt, using custom paths.") FILE(STRINGS ../paths.txt SAPFOR_PATHS) else () - message("Not found paths.txt, using default paths.") +# message("Not found paths.txt, using default paths.") FILE(STRINGS ../paths.default.txt SAPFOR_PATHS) endif () foreach (NameAndValue ${SAPFOR_PATHS}) @@ -47,8 +47,8 @@ set(SOURCE_EXE ${parser_sources}/unparse_hpf.c ${PARSER_HEADERS}) -# if not default ${sage_include_1}, ${sage_include_2} must be set in ../paths.txt -include_directories(${sage_include_1} ${sage_include_2}) +# if not default ${fdvm_include} ${sage_include_1}, ${sage_include_2} must be set in ../paths.txt +include_directories(${fdvm_include} ${sage_include_1} ${sage_include_2}) add_executable(Parser ${SOURCE_EXE}) if (MSVC_IDE) diff --git a/projects/SageLib/CMakeLists.txt b/projects/SageLib/CMakeLists.txt index e072b03..21dc798 100644 --- a/projects/SageLib/CMakeLists.txt +++ b/projects/SageLib/CMakeLists.txt @@ -10,10 +10,10 @@ message("processing ${project}") # Read pathes to external sapfor directories if (EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../paths.txt") - message("Found paths.txt, using custom paths.") +# message("Found paths.txt, using custom paths.") FILE(STRINGS ../paths.txt SAPFOR_PATHS) else () - message("Not found paths.txt, using default paths.") +# message("Not found paths.txt, using default paths.") FILE(STRINGS ../paths.default.txt SAPFOR_PATHS) endif () foreach (NameAndValue ${SAPFOR_PATHS}) diff --git a/projects/SageNewSrc/CMakeLists.txt b/projects/SageNewSrc/CMakeLists.txt index 1b822d5..8869d39 100644 --- a/projects/SageNewSrc/CMakeLists.txt +++ b/projects/SageNewSrc/CMakeLists.txt @@ -11,10 +11,10 @@ message("processing ${project}") # Read pathes to external sapfor directories if (EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../paths.txt") - message("Found paths.txt, using custom paths.") +# message("Found paths.txt, using custom paths.") FILE(STRINGS ../paths.txt SAPFOR_PATHS) else () - message("Not found paths.txt, using default paths.") +# message("Not found paths.txt, using default paths.") FILE(STRINGS ../paths.default.txt SAPFOR_PATHS) endif () foreach (NameAndValue ${SAPFOR_PATHS}) diff --git a/projects/SageOldSrc/CMakeLists.txt b/projects/SageOldSrc/CMakeLists.txt index 7b1dcc2..0e5b9b0 100644 --- a/projects/SageOldSrc/CMakeLists.txt +++ b/projects/SageOldSrc/CMakeLists.txt @@ -11,10 +11,10 @@ message("processing ${project}") # Read pathes to external sapfor directories if (EXISTS "${CMAKE_CURRENT_SOURCE_DIR}/../paths.txt") - message("Found paths.txt, using custom paths.") +# message("Found paths.txt, using custom paths.") FILE(STRINGS ../paths.txt SAPFOR_PATHS) else () - message("Not found paths.txt, using default paths.") +# message("Not found paths.txt, using default paths.") FILE(STRINGS ../paths.default.txt SAPFOR_PATHS) endif () foreach (NameAndValue ${SAPFOR_PATHS}) diff --git a/projects/dvm_svn/fdvm/CMakeLists.txt b/projects/dvm_svn/fdvm/CMakeLists.txt deleted file mode 100644 index d6b5e2b..0000000 --- a/projects/dvm_svn/fdvm/CMakeLists.txt +++ /dev/null @@ -1 +0,0 @@ -add_subdirectory(trunk) \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/CMakeLists.txt deleted file mode 100644 index f4a5851..0000000 --- a/projects/dvm_svn/fdvm/trunk/CMakeLists.txt +++ /dev/null @@ -1,7 +0,0 @@ -set(DVM_FORTRAN_INCLUDE_DIRS ${CMAKE_CURRENT_SOURCE_DIR}/include) - -add_subdirectory(Sage) -add_subdirectory(parser) -add_subdirectory(fdvm) -add_subdirectory(InlineExpansion) - diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/InlineExpansion/CMakeLists.txt deleted file mode 100644 index faac3be..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/CMakeLists.txt +++ /dev/null @@ -1,23 +0,0 @@ -set(INLINE_SOURCES inl_exp.cpp inliner.cpp hlp.cpp) - -if(MSVC_IDE) - file(GLOB_RECURSE INLINE_HEADERS RELATIVE - ${CMAKE_CURRENT_SOURCE_DIR} *.h) - foreach(DIR ${DVM_FORTRAN_INCLUDE_DIRS}) - file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} "${DIR}/*.h") - set(INLINE_HEADERS ${INLINE_HEADERS} ${FILES}) - endforeach() -endif() - -add_executable(inl_exp ${INLINE_SOURCES} ${INLINE_HEADERS}) - -add_dependencies(inl_exp db sage sage++) -target_link_libraries(inl_exp db sage sage++) - -target_include_directories(inl_exp PRIVATE "${DVM_FORTRAN_INCLUDE_DIRS}") -set_target_properties(inl_exp PROPERTIES - FOLDER "${DVM_TOOL_FOLDER}" - RUNTIME_OUTPUT_DIRECTORY ${DVM_BIN_DIR} - COMPILE_PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ - PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ -) diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/dvm_tag.h b/projects/dvm_svn/fdvm/trunk/InlineExpansion/dvm_tag.h deleted file mode 100644 index 43ec990..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/dvm_tag.h +++ /dev/null @@ -1,85 +0,0 @@ -#define HPF_TEMPLATE_STAT 296 -#define HPF_ALIGN_STAT 297 -#define HPF_PROCESSORS_STAT 298 -#define DVM_DISTRIBUTE_DIR 277 -#define DVM_REDISTRIBUTE_DIR 299 -#define DVM_PARALLEL_ON_DIR 211 -#define DVM_SHADOW_START_DIR 212 -#define DVM_SHADOW_GROUP_DIR 213 -#define DVM_SHADOW_WAIT_DIR 214 -#define DVM_REDUCTION_START_DIR 215 -#define DVM_REDUCTION_GROUP_DIR 216 -#define DVM_REDUCTION_WAIT_DIR 217 -#define DVM_DYNAMIC_DIR 218 -#define DVM_ALIGN_DIR 219 -#define DVM_REALIGN_DIR 220 -#define DVM_REALIGN_NEW_DIR 221 -#define DVM_REMOTE_ACCESS_DIR 222 -#define HPF_INDEPENDENT_DIR 223 -#define DVM_SHADOW_DIR 224 -#define DVM_NEW_VALUE_DIR 247 -#define DVM_VAR_DECL 248 -#define DVM_POINTER_DIR 249 -#define DVM_DEBUG_DIR 146 -#define DVM_ENDDEBUG_DIR 147 -#define DVM_TRACEON_DIR 148 -#define DVM_TRACEOFF_DIR 149 -#define DVM_INTERVAL_DIR 128 -#define DVM_ENDINTERVAL_DIR 129 -#define DVM_TASK_REGION_DIR 605 -#define DVM_END_TASK_REGION_DIR 606 -#define DVM_ON_DIR 607 -#define DVM_END_ON_DIR 608 -#define DVM_TASK_DIR 609 -#define DVM_MAP_DIR 610 -#define DVM_PARALLEL_TASK_DIR 611 -#define DVM_INHERIT_DIR 612 -#define DVM_INDIRECT_GROUP_DIR 613 -#define DVM_INDIRECT_ACCESS_DIR 614 -#define DVM_REMOTE_GROUP_DIR 615 -#define DVM_RESET_DIR 616 -#define DVM_PREFETCH_DIR 617 -#define DVM_OWN_DIR 618 -#define DVM_HEAP_DIR 619 -#define DVM_ASYNCID_DIR 620 -#define DVM_ASYNCHRONOUS_DIR 621 -#define DVM_ENDASYNCHRONOUS_DIR 622 -#define DVM_ASYNCWAIT_DIR 623 -#define DVM_F90_DIR 624 -#define DVM_BARRIER_DIR 625 -#define FORALL_STAT 626 -#define DVM_CONSISTENT_GROUP_DIR 627 -#define DVM_CONSISTENT_START_DIR 628 -#define DVM_CONSISTENT_WAIT_DIR 629 -#define DVM_CONSISTENT_DIR 630 - -#define BLOCK_OP 705 -#define NEW_SPEC_OP 706 -#define REDUCTION_OP 707 -#define SHADOW_RENEW_OP 708 -#define SHADOW_START_OP 709 -#define SHADOW_WAIT_OP 710 -#define DIAG_OP 711 -#define REMOTE_ACCESS_OP 712 -#define TEMPLATE_OP 713 -#define PROCESSORS_OP 714 -#define DYNAMIC_OP 715 -#define ALIGN_OP 716 -#define DISTRIBUTE_OP 717 -#define SHADOW_OP 718 -#define INDIRECT_ACCESS_OP 719 -#define ACROSS_OP 720 -#define NEW_VALUE_OP 721 -#define SHADOW_COMP_OP 722 -#define STAGE_OP 723 -#define FORALL_OP 724 -#define CONSISTENT_OP 725 -#define SHADOW_GROUP_NAME 523 -#define REDUCTION_GROUP_NAME 524 -#define REF_GROUP_NAME 525 -#define ASYNC_ID 526 -#define CONSISTENT_GROUP_NAME 527 - - - - diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/hlp.cpp b/projects/dvm_svn/fdvm/trunk/InlineExpansion/hlp.cpp deleted file mode 100644 index 39f8816..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/hlp.cpp +++ /dev/null @@ -1,622 +0,0 @@ -/**************************************************************\ -* Inline Expansion * -* * -* Miscellaneous help routines * -\**************************************************************/ - -#include "inline.h" -#include -#include -#ifdef __SPF -#include -#endif - -//************************************************************* -/* - * Error - formats the error message then call "err" to print it - * - * input: - * s - string that specifies the conversion format - * t - string that to be formated according to s - * num - error message number - * stmt - pointer to the statement - */ - //************************************************************* -void Error(const char *s, const char *t, int num, SgStatement *stmt) - -{ - char *buff = new char[strlen(s) + strlen(t) + 32]; - sprintf(buff, s, t); - err(buff, num, stmt); - delete[]buff; -} - -/* - * Err_g - formats and prints the special kind error message (without statement reference) - * - * input: - * s - string that specifies the conversion format - * t - string that to be formated according to s - * num - error message number - */ - -void Err_g(const char *s, const char *t, int num) - -{ - char *buff = new char[strlen(s) + strlen(t) + 32]; - char num3s[16]; - sprintf(buff, s, t); - format_num(num, num3s); - errcnt++; - (void)fprintf(stderr, "Error %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); - delete[]buff; -} -/* - * err -- prints the error message - * - * input: - * s - string to be printed out - * num - error message number - * stmt - pointer to the statement - */ -void err(const char *s, int num, SgStatement *stmt) - -{ - char num3s[16]; - format_num(num, num3s); - errcnt++; - // printf( "Error on line %d : %s\n", stmt->lineNumber(), s); -#ifdef __SPF - char message[256]; - sprintf(message, "Error %d: %s", num, s); - - std::string toPrint = "|"; - toPrint += std::to_string(1) + " "; // ERROR - toPrint += std::string(stmt->fileName()) + " "; - toPrint += std::to_string(stmt->lineNumber()) + " "; - toPrint += std::to_string(0); - toPrint += "|" + std::string(message); - - printf("@%s@\n", toPrint.c_str()); -#else - (void)fprintf(stderr, "Error %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); -#endif -} - -/* - * Warning -- formats a warning message then call "warn" to print it out - * - * input: - * s - string that specifies the conversion format - * t - string that to be converted according to s - * num - warning message number - * stmt - pointer to the statement - */ -void Warning(const char *s, const char *t, int num, SgStatement *stmt) -{ - char *buff = new char[strlen(s) + strlen(t) + 32]; - sprintf(buff, s, t); - warn(buff, num, stmt); - delete[]buff; -} - -/* - * warn -- print the warning message if specified - * - * input: - * s - string to be printed - * num - warning message number - * stmt - pointer to the statement - */ -void warn(const char *s, int num, SgStatement *stmt) -{ - char num3s[16]; - format_num(num, num3s); - // printf( "Warning on line %d: %s\n", stmt->lineNumber(), s); - (void)fprintf(stderr, "Warning %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); -} - -void Warn_g(const char *s, const char *t, int num) -{ - char *buff = new char[strlen(s) + strlen(t) + 32]; - char num3s[16]; - format_num(num, num3s); - sprintf(buff, s, t); - (void)fprintf(stderr, "Warning %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); - delete[]buff; -} -//********************************************************************* -void printVariantName(int i) { - if ((i >= 0 && i < MAXTAGS) && tag[i]) printf("%s", tag[i]); - else printf("not a known node variant"); -} -//*********************************** - -char *UnparseExpr(SgExpression *e) -{ - char *buf; - int l; - Init_Unparser(); - buf = Tool_Unparse2_LLnode(e->thellnd); - l = strlen(buf); - char *ustr = new char[l + 1]; - strcpy(ustr, buf); - //ustr[l] = ' '; - //ustr[l+1] = '\0'; - return(ustr); -} -//************************************ - -const char* header(int i) { - switch (i) { - case(PROG_HEDR): - return("program"); - case(PROC_HEDR): - return("subroutine"); - case(FUNC_HEDR): - return("function"); - default: - return("error"); - } -} - -SgLabel* firstLabel(SgFile *f) -{ - SetCurrentFileTo(f->filept); - SwitchToFile(GetFileNumWithPt(f->filept)); - return LabelMapping(PROJ_FIRST_LABEL()); -} - -int isLabel(int num) { - PTR_LABEL lab; - for (lab = PROJ_FIRST_LABEL(); lab; lab = LABEL_NEXT(lab)) - if (num == LABEL_STMTNO(lab)) - return 1; - return 0; -} - -SgLabel *isLabelWithScope(int num, SgStatement *stmt) { - PTR_LABEL lab; - for (lab = PROJ_FIRST_LABEL(); lab; lab = LABEL_NEXT(lab)) - //if( num == LABEL_STMTNO(lab) && LABEL_BODY(lab)->scope == stmt->thebif) - if (num == LABEL_STMTNO(lab) && LABEL_SCOPE(lab) == stmt->thebif) - return LabelMapping(lab); - return NULL; -} - - -SgLabel * GetLabel() -{ - static int lnum = 90000; - if (lnum > max_lab) - return (new SgLabel(lnum--)); - while (isLabel(lnum)) - lnum--; - return (new SgLabel(lnum--)); -} - -SgLabel * GetNewLabel() -{ - static int lnum = 99999; - if (lnum > max_lab) /* for current file must be set before first call GetNewLabel() :max_lab = getLastLabelId(); */ - return (new SgLabel(lnum--)); - while (isLabel(lnum)) - lnum--; - return (new SgLabel(lnum--)); - /* - int lnum; - if(max_lab <99999) - return(new SgLabel(++max_lab)); - lnum = 1; - while(isLabel(lnum)) - lnum++; - return(new SgLabel(lnum)); - */ -} - -SgLabel * NewLabel() -{ - if (max_lab < 99999) - return(new SgLabel(++max_lab)); - ++num_lab; - while (isLabel(num_lab)) - ++num_lab; - return(new SgLabel(num_lab)); -} - -void SetScopeOfLabel(SgLabel *lab, SgStatement *scope) -{ - LABEL_SCOPE(lab->thelabel) = scope->thebif; -} - -/* -SgLabel * NewLabel(int lnum) -{ - if(max_lab <99999) - return(new SgLabel(++max_lab)); - - while(isLabel(lnum)) - ++lnum; - return(new SgLabel(lnum)); -} -*/ - -int isSymbolName(char *name) -// -{ - SgSymbol *s; - for (s = current_file->firstSymbol(); s; s = s->next()) - if (!strcmp(name, s->identifier())) - return 1; - return 0; -} - -int isSymbolNameInScope(char *name, SgStatement *scope) -{ - SgSymbol *s; - for (s = current_file->firstSymbol(); s; s = s->next()) - if (scope == s->scope() && !strcmp(name, s->identifier())) - return 1; - return 0; -} -/* -{ - PTR_SYMB sym; - for(sym=PROJ_FIRST_SYMB(); sym; sym=SYMB_NEXT(sym)) - if( SYMB_SCOPE(sym) == scope->thebif && (!strcmp(name,SYMB_IDENT(sym)) ) ) - return 1; - return 0; -} -*/ - -void format_num(int num, char num3s[]) -{ - if (num > 99) - num3s[sprintf(num3s, "%3d", num)] = 0; - else if (num > 9) - num3s[sprintf(num3s, "0%2d", num)] = 0; - else - num3s[sprintf(num3s, "00%1d", num)] = 0; -} - -SgExpression *ConnectList(SgExpression *el1, SgExpression *el2) -{ - SgExpression *el; - if (!el1) - return(el2); - if (!el2) - return(el1); - for (el = el1; el->rhs(); el = el->rhs()) - ; - el->setRhs(el2); - return(el1); -} - -int is_integer_value(char *str) -{ - char *p; - p = str; - for (; *str != '\0'; str++) - if (!isdigit(*str)) - return 0; - return (atoi(p)); -} - -void PrintSymbolTable(SgFile *f) -{ - SgSymbol *s; - printf("\nS Y M B O L T A B L E \n"); - for (s = f->firstSymbol(); s; s = s->next()) - //printf(" %s/%d/ ", s->identifier(), s->id() ); - printSymb(s); -} - -void printSymb(SgSymbol *s) -{ - const char *head; - head = isHeaderStmtSymbol(s) ? "HEADER " : " "; - printf("SYMB[%3d] scope=STMT[%3d] : %s %s", s->id(), (s->scope()) ? (s->scope())->id() : -1, s->identifier(), head); - printType(s->type()); - printf("\n"); -} - -void printType(SgType *t) -{ - SgArrayType *arrayt; - /*SgExpression *e = new SgExpression(TYPE_RANGES(t->thetype));*/ - int i, n; - if (!t) { printf("no type "); return; } - else printf("TYPE[%d]:", t->id()); - if ((arrayt = isSgArrayType(t)) != 0) - { - printf("dimension("); - n = arrayt->dimension(); - for (i = 0; i < n; i++) - { - (arrayt->sizeInDim(i))->unparsestdout(); - if (i < n - 1) printf(", "); - } - printf(") "); - } - else - { - switch (t->variant()) - { - case T_INT: printf("integer "); break; - case T_FLOAT: printf("real "); break; - case T_DOUBLE: printf("double precision "); break; - case T_CHAR: printf("character "); break; - case T_STRING: printf("Character "); - UnparseLLND(TYPE_RANGES(t->thetype)); - /*if(t->length()) printf("[%d]",t->length()->variant());*/ - /*((SgArrayType *) t)->getDimList()->unparsestdout();*/ - break; - case T_BOOL: printf("logical "); break; - case T_COMPLEX: printf("complex "); break; - case T_DCOMPLEX: printf("double complex "); break; - - default: break; - } - } - /* if(e) e->unparsestdout();*/ - if (t->hasBaseType()) - { - printf("of "); - printType(t->baseType()); - } -} - -void PrintTypeTable(SgFile *f) -{ - SgType *t; - printf("\nT Y P E T A B L E \n"); - for (t = f->firstType(); t; t = t->next()) - { - printType(t); printf("\n"); - } - -} - -SgExpression *ReplaceParameter(SgExpression *e) -{ - if (!e) - return(e); - if (e->variant() == CONST_REF) { - SgConstantSymb * sc = isSgConstantSymb(e->symbol()); - return(ReplaceParameter(&(sc->constantValue()->copy()))); - } - e->setLhs(ReplaceParameter(e->lhs())); - e->setRhs(ReplaceParameter(e->rhs())); - return(e); -} - -SgExpression *ReplaceIntegerParameter(SgExpression *e) -{ - if (!e) - return(e); - if (e->variant() == CONST_REF && e->type()->variant() == T_INT) { - SgConstantSymb * sc = isSgConstantSymb(e->symbol()); - return(ReplaceIntegerParameter(&(sc->constantValue()->copy()))); - } - e->setLhs(ReplaceIntegerParameter(e->lhs())); - e->setRhs(ReplaceIntegerParameter(e->rhs())); - return(e); -} - -/* -SgExpression *ReplaceFuncCall(SgExpression *e) -{ - if(!e) - return(e); - if(isSgFunctionCallExp(e) && e->symbol()) {//function call - if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"number_of_processors") || !strcmp(e->symbol()->identifier(),"actual_num_procs"))) { //NUMBER_OF_PROCESSORS() or - // ACTUAL_NUM_PROCS() - SgExprListExp *el1,*el2; - if(!strcmp(e->symbol()->identifier(),"number_of_processors")) - el1 = new SgExprListExp(*ParentPS()); - else - el1 = new SgExprListExp(*CurrentPS()); - el2 = new SgExprListExp(*ConstRef(0)); - e->setSymbol(fdvm[GETSIZ]); - fmask[GETSIZ] = 1; - el1->setRhs(el2); - e->setLhs(el1); - return(e); - } - - if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"processors_rank"))) { - //PROCESSORS_RANK() - SgExprListExp *el1; - el1 = new SgExprListExp(*ParentPS()); - e->setSymbol(fdvm[GETRNK]); - fmask[GETRNK] = 1; - e->setLhs(el1); - return(e); - } - - if(!strcmp(e->symbol()->identifier(),"processors_size")) { - //PROCESSORS_SIZE() - SgExprListExp *el1; - el1 = new SgExprListExp(*ParentPS()); - e->setSymbol(fdvm[GETSIZ]); - fmask[GETSIZ] = 1; - el1->setRhs(*(e->lhs())+(*ConstRef(0))); //el1->setRhs(e->lhs()); - e->setLhs(el1); - return(e); - } - } - e->setLhs(ReplaceFuncCall(e->lhs())); - e->setRhs(ReplaceFuncCall(e->rhs())); - return(e); -} -*/ - -/* version from dvm.cpp -SgExpression *Calculate(SgExpression *e) -{ SgExpression *er; - er = ReplaceParameter( &(e->copy())); - if(er->isInteger()) - return( new SgValueExp(er->valueInteger())); - else - return(e); -} -*/ - -/* new version */ -SgExpression *Calculate(SgExpression *e) -{ - if (e->isInteger()) - return(new SgValueExp(e->valueInteger())); - else - return(e); -} - - -SgExpression *Calculate_List(SgExpression *e) -{ - SgExpression *el; - for (el = e; el; el = el->rhs()) - el->setLhs(Calculate(el->lhs())); - return(e); -} - - -int ExpCompare(SgExpression *e1, SgExpression *e2) -{//compares two expressions -// returns 1 if they are textually identical - if (!e1 && !e2) // both expressions are null - return(1); - if (!e1 || !e2) // one of them is null - return(0); - if (e1->variant() != e2->variant()) // variants are not equal - return(0); - switch (e1->variant()) { - case INT_VAL: - return(NODE_IV(e1->thellnd) == NODE_IV(e2->thellnd)); - case FLOAT_VAL: - case DOUBLE_VAL: - case BOOL_VAL: - case CHAR_VAL: - case STRING_VAL: - return(!strcmp(NODE_STR(e1->thellnd), NODE_STR(e2->thellnd))); - case COMPLEX_VAL: - return(ExpCompare(e1->lhs(), e2->lhs()) && ExpCompare(e1->rhs(), e2->rhs())); - case CONST_REF: - case VAR_REF: - return(e1->symbol() == e2->symbol()); - case ARRAY_REF: - case FUNC_CALL: - if (e1->symbol() == e2->symbol()) - return(ExpCompare(e1->lhs(), e2->lhs())); // compares subscript/argument lists - else - return(0); - case EXPR_LIST: - {SgExpression *el1, *el2; - for (el1 = e1, el2 = e2; el1&&el2; el1 = el1->rhs(), el2 = el2->rhs()) - if (!ExpCompare(el1->lhs(), el2->lhs())) // the corresponding elements of lists are not identical - return(0); - if (el1 || el2) //one list is shorter than other - return(0); - else - return(1); - } - case MINUS_OP: //unary operations - case NOT_OP: - return(ExpCompare(e1->lhs(), e2->lhs())); // compares operands - default: - return(ExpCompare(e1->lhs(), e2->lhs()) && ExpCompare(e1->rhs(), e2->rhs())); - } -} - - -SgExpression *LowerBound(SgSymbol *ar, int i) -// lower bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) -{ - SgArrayType *artype; - SgExpression *e; - SgSubscriptExp *sbe; - //if(IS_POINTER(ar)) - // return(new SgValueExp(1)); - artype = isSgArrayType(ar->type()); - if (!artype) - return(NULL); - e = artype->sizeInDim(i); - if (!e) - return(NULL); - if ((sbe = isSgSubscriptExp(e)) != NULL) { - if (sbe->lbound()) - return(sbe->lbound()); - - //else if(IS_ALLOCATABLE_POINTER(ar)){ - // if(HEADER(ar)) - // return(header_ref(ar,Rank(ar)+3+i)); - // else - // return(LBOUNDFunction(ar,i+1)); - //} - - else - return(new SgValueExp(1)); - } - else - return(new SgValueExp(1)); // by default lower bound = 1 -} - -int Rank(SgSymbol *s) -{ - SgArrayType *artype; - //if(IS_POINTER(s)) - // return(PointerRank(s)); - artype = isSgArrayType(s->type()); - if (artype) - return (artype->dimension()); - else - return (0); -} - -SgExpression *UpperBound(SgSymbol *ar, int i) -// upper bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) -{ - SgArrayType *artype; - SgExpression *e; - SgSubscriptExp *sbe; - - - artype = isSgArrayType(ar->type()); - if (!artype) - return(NULL); - e = artype->sizeInDim(i); - if (!e) - return(NULL); - if ((sbe = isSgSubscriptExp(e)) != NULL) { - if (sbe->ubound()) - return(sbe->ubound()); - - //else if(HEADER(ar)) - // return(&(*GetSize(HeaderRefInd(ar,1),i+1)-*HeaderRefInd(ar,Rank(ar)+3+i)+*new SgValueExp(1))); - //else - // return(UBOUNDFunction(ar,i+1)); - - } - else - return(e); - // !!!! test case "*" - return(e); -} - -symb_list *AddToSymbList(symb_list *ls, SgSymbol *s) -{ - symb_list *l; - //adding the symbol 's' to symb_list 'ls' - if (!ls) { - ls = new symb_list; - ls->symb = s; - ls->next = NULL; - } - else { - l = new symb_list; - l->symb = s; - l->next = ls; - ls = l; - } - return(ls); -} diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/inl_exp.cpp b/projects/dvm_svn/fdvm/trunk/InlineExpansion/inl_exp.cpp deleted file mode 100644 index 3fcbb4f..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/inl_exp.cpp +++ /dev/null @@ -1,1750 +0,0 @@ -/*********************************************************************/ -/* Inline Expansion 2006 */ -/*********************************************************************/ - - -/*********************************************************************/ -/* Inliner Driver */ -/*********************************************************************/ - -#include -#include -#include -#include -#include -#include -#include -#include -//#define IN_DVM_ -//#include "dvm.h" -//#undef IN_DVM_ - -#define IN_M_ -#include "inline.h" -#undef IN_M_ - -// Inliner version -#define VERSION_NUMBER "4" - -using std::string; -using std::map; -using std::set; -using std::vector; - -const char *name_loop_var[8] = { "idvm00","idvm01","idvm02","idvm03", "idvm04","idvm05","idvm06","idvm07" }; -const char *name_bufIO[6] = { "i000io","r000io", "d000io","c000io","l000io","dc00io" }; -SgSymbol *rmbuf[6]; -const char *name_rmbuf[6] = { "i000bf","r000bf", "d000bf","c000bf","l000bf","dc00bf" }; -SgSymbol *dvmcommon; -SgSymbol *heapcommon; -SgSymbol *redcommon; -SgSymbol *dbgcommon; -int lineno; // number of line in file -SgStatement *first_exec; // first executable statement in procedure -int nproc, ndis, nblock, ndim, nblock_all; -int iblock, isg, iacross; -int saveall; //= 1 if there is SAVE without name-list in current function(procedure) -int mem_use[6] = { 0,0,0,0,0,0 }; -int buf_use[6] = { 0,0,0,0,0,0 }; -base_list *mem_use_structure; -int lab; // current label -int v_print = 0; //set to 1 by -v flag -int warn_all = 0; //set to 1 by -w flag -int own_exe; -symb_list *new_red_var_list; -SgSymbol *file_var_s; -int nloopred; //counter of parallel loops with reduction group -int nloopcons; //counter of parallel loops with consistent group -stmt_list *wait_list; // list of REDUCTION_WAIT directives -int task_ps = 0; -SgStatement *end_of_unit; // last node (END statement) of program unit -SgStatement *has_contains; //node for CONTAINS statement -int dvm_const_ref; - -extern "C" int out_free_form; -// -//----------------------------------------------------------------------- -// FOR DEBUGGING -//#include "dump_info.C" -//----------------------------------------------------------------------- - -set needToInline; -#ifdef __SPF -void removeIncludeStatsAndUnparse(SgFile *file, const char *fileName, const char *fout); -#endif - -int main(int argc, char *argv[]) -{ - FILE *fout; - char *fout_name = (char *)"out.f"; - //char *fout_name = NULL; - int level, hpf, openmp, isz; - // initialisation - initialize(); - -#ifdef __SPF - if (argc == 1) - { - printf("Usage:\n"); - printf("Parse project with 'Parser' command first.\n"); - printf("Specify functions to inline by parameter:\n"); - printf(" -toInlined N name1 name2 name3... nameN, \n"); - printf("where N - number of functions to inline, nameI - name of each function.\n"); - printf("NOTE: count of nameI and N must be equal.\n"); - return 0; - } -#endif - openmp = hpf = 0; - argv++; - while ((argc > 1) && (*argv)[0] == '-') - { - if ((*argv)[1] == 'o' && ((*argv)[2] == '\0')) - { - fout_name = argv[1]; - argv++; - argc--; - } - else if (!strcmp(argv[0], "-dc")) - with_cmnt = 1; - else if ((*argv)[1] == 'd') - { - switch ((*argv)[2]) - { - /*case '0': level = 0; break;*/ - case '1': level = 1; break; - case '2': level = 2; break; - case '3': level = 3; break; - case '4': level = 4; break; - /* case '5': level = -1; many_files=1; break;*/ - default: level = -1; - } - if (level > 0) - deb_reg = level; - } - else if (!strcmp(argv[0], "-p")) { - only_debug = 0; hpf = 0; - } - else if (!strcmp(argv[0], "-s")) { - only_debug = 1; hpf = 0; - } - else if (!strcmp(argv[0], "-v")) - v_print = 1; - else if (!strcmp(argv[0], "-w")) - warn_all = 1; - else if (!strcmp(argv[0], "-bind0")) - bind = 0; - else if (!strcmp(argv[0], "-bind1")) { - bind = 1; len_long = 8; - } - else if (!strcmp(argv[0], "-hpf") || !strcmp(argv[0], "-hpf1") || !strcmp(argv[0], "-hpf2")) - hpf = 1; - else if (!strcmp(argv[0], "-mp")) - openmp = 1; - else if (!strcmp(argv[0], "-ffo")) - out_free_form = 1; - else if (!strncmp(argv[0], "-bufio", 6)) - { - if ((*argv)[6] != '\0' && (isz = is_integer_value(*argv + 6))) - IOBufSize = isz; - } - else if (!strcmp(argv[0], "-ver")) - { - (void)fprintf(stderr, "inliner version is \"%s\"\n", VERSION_NUMBER); - exit(0); - } -#ifdef __SPF - else if (!strcmp(argv[0], "-toInlined")) - { - argc--; - argv++; - int count = 0; - int err = sscanf(argv[0], "%d", &count); - //TODO: check err - argc--; - argv++; - for (int z = 0; z < count; ++z) - { - needToInline.insert(argv[0]); - if (z != count - 1) - { - argc--; - argv++; - } - } - - if (needToInline.size() > 0) - { - printf("need to inline:\n"); - for (auto it = needToInline.begin(); it != needToInline.end(); ++it) - printf("%s\n", (*it).c_str()); - } - } -#endif - argc--; - argv++; - } - - SgProject project((char *)"dvm.proj"); - SgFile *file; - int i; - //printf("Number Of Files: %d\n",project.numberOfFiles()); - - for (i = 0; i < project.numberOfFiles(); i++) - { - SgFile *f; - f = &(project.file(i)); - if (deb_reg) - printf(" FILE[%d]: %s\n", i, project.fileName(i)); - } - - file = &(project.file(0)); - fin_name = new char[80]; - sprintf(fin_name, "%s%s", project.fileName(0), " "); - //fin_name = strcat(project.fileName(0)," "); - // for call of function 'tpoint' - //added one symbol to input-file name - initVariantNames(); - initIntrinsicNames(); - //InitDVM(file); - - current_file = file; // global variable (used in SgTypeComplex) - max_lab = getLastLabelId(); - //if(dbg_if_regim) GetLabel(); //set maxlabval=90000 - /* - printf("Labels:\n"); - printf("first:%d max: %d \n",firstLabel(file)->thelabel->stateno, getLastLabelId()); - for(int num=1; num<=getLastLabelId(); num++) - if(isLabel(num)) - printf("%d is label\n",num); - else - printf("%d isn't label\n",num); - */ - if (v_print) - (void)fprintf(stderr, "<<<<< Inline Expansion >>>>>\n"); - - //build CallGraph of all files - for (int i = 0; i < project.numberOfFiles(); i++) - { - SgFile *currF = &(project.file(i)); - // Building a directed acyclic call multigrahp (call DAMG) - // which represents calls between routines of the program - // which are to be (or not to be) expanded - - for (int k = 0; k < currF->numberOfFunctions(); ++k) - { - SgStatement *func = currF->functions(k); - cur_func = func; - cur_symb = func->symbol(); - CallGraph(func); - } - } - InlinerDriver(file); - - /* - { SgSymbol *s, *scop; - - s= file->functions(0)->symbol(); - //file =&(project.file(1)); - //scop= &(s->copyAcrossFiles(*(file->firstStatement()))); - scop= &(s->copySubprogram(*(file->firstStatement()))); - printf(" \n****** BODY COPY FUNCTION(0) %s ********\n", scop->identifier()); - scop->body()->unparsestdout(); - printf(" \n****** AFTER COPY FUNCTION(0) ********\n"); - file->unparsestdout(); - } - */ - - if (v_print) - (void)fprintf(stderr, "<<<<< End Inline Expansion >>>>>\n"); - - /* DEBUG */ - /* classifyStatements(file); - printf("**************************************************\n"); - printf("**** Expression Table ****************************\n"); - printf("**************************************************\n"); - classifyExpressions(file); - printf("**************************************************\n"); - printf("**** Symbol Table *******************************\n"); - printf("**************************************************\n"); - classifySymbols(file); - printf("**************************************************\n"); - */ - /* end DEBUG */ - - - if (errcnt) { - (void)fprintf(stderr, "%d error(s)\n", errcnt); - //!!! exit(1); - return 1; - } - //file->saveDepFile("dvm.dep"); - // DVMFileUnparse(file); - // file->saveDepFile("f.dep"); - if (!fout_name) { //outfile is not specified, output result to stdout - file->unparsestdout(); - return 0; - } -#ifdef __SPF - string outFile; - //printf("out file is %s\n", fout_name); - if (string("out.f") == fout_name) - { - outFile = file->filept->filename; - auto itS = outFile.end(); - itS--; - size_t pos = outFile.size() - 1; - while (itS[0] != '.' && itS != outFile.begin()) - { - itS--; - pos--; - } - - FILE *check = NULL; - string insert = "_inl"; - do - { - string copy(outFile); - copy.insert(pos, insert); - if (check) - fclose(check); - check = fopen(copy.c_str(), "r"); - if (check) - insert += "_"; - } while (check); - - outFile.insert(pos, insert); - } - else - outFile = fout_name; - printf("out file is %s\n", outFile.c_str()); - removeIncludeStatsAndUnparse(file, file->filept->filename, outFile.c_str()); -#else - //writing result of converting into file - if ((fout = fopen(fout_name, "w")) == NULL) { - (void)fprintf(stderr, "Can't open file %s for write\n", fout_name); - // exit (1); - return 1; - } - - if (v_print) - (void)fprintf(stderr, "<<<<< Unparsing %s >>>>>\n", fout_name); - - file->unparse(fout); - - if ((fclose(fout)) < 0) - { - fprintf(stderr, "Could not close %s\n", fout_name); - return 1; - } - - if (v_print) - fprintf(stderr, "\n***** Done *****\n"); -#endif - return 0; -} - -void initialize() -{ - node_list = NULL; - do_dummy = 0; do_stmtfn = 0; - gcount = 0; - deb_reg = 0; - with_cmnt = 0; -} - -void initVariantNames() -{ - for (int i = 0; i < MAXTAGS; i++) - tag[i] = NULL; - /*!!!*/ -#include "tag.h" -} - -void initIntrinsicNames() -{ - for (int i = 0; i < MAX_INTRINSIC_NUM; i++) - { - intrinsic_type[i] = 0; - intrinsic_name[i] = NULL; - } -#include "intrinsic.h" -} - - - -/***********************************************************************/ - -void InlinerDriver(SgFile *f) -{ - // function is program unit accept BLOCKDATA and MODULE (F90),i.e. - // PROGRAM, SUBROUTINE, FUNCTION - //if(debug_fragment || perf_fragment) // is debugging or performance analizing regime specified ? - // BeginDebugFragment(0,NULL);// begin the fragment with number 0 (involving whole file(program) - - if (deb_reg > 1) - PrintWholeGraph(); - - //Removing nodes representing "dead" subprogram - RemovingDeadSubprograms(); - - //Removing nodes representing "nobody" subprogram - NoBodySubprograms(); - - if (deb_reg > 1) - { - PrintWholeGraph(); - PrintWholeGraph_kind_2(); - } - - //Building a list of header nodes to represent "top level" routines - BuildingHeaderNodeList(); - - // for debug - //PrintSymbolTable(f); - - // Looking through the list of header nodes, - // splitting header node n which has "inlined" edges representing inlined calls to n - { - graph_node *gnode, *gnode_new; - graph_node_list *ln; - edge *edg; - global_st = f->firstStatement(); - if (deb_reg > 1) - printf("\nLooking header node list ....\n"); - for (ln = header_node_list; ln; ln = ln->next) - { - gnode = ln->node; - if (deb_reg > 1) - printf("\nlooking NODE[%d] %s\n", gnode->id, gnode->symb->identifier()); - - // looking through the incoming edges list of gnode - for (edg = gnode->from_calling; edg; edg = edg->next) - { - if (edg->inlined) //gnode has "inlined" incoming edge - { - //split gnode, creating node gnode_new - gnode_new = SplittingNode(gnode); - //reset all edges representing inlined calls to gnode to point to gnode_new - ReseatEdges(gnode, gnode_new); - break; - } - } - } - } - - // Removing all edges representing uninlined calls - RemovingUninlinedEdges(); - - // for debug - if (deb_reg > 1) - { - PrintWholeGraph(); - PrintWholeGraph_kind_2(); - PrintSymbolTable(f); - PrintTypeTable(f); - } - - // Parttion the call graph into inline flow graphs - Partition(); - if (deb_reg) - { - PrintWholeGraph(); - PrintWholeGraph_kind_2(); - } - - // For each non-trivial inline flow graph - // call the inliner to create the corresconding "top level" routine - for (graph_node_list *ln = header_node_list; ln; ln = ln->next) - { - if (ln->node->to_called) - Inliner(ln->node); - } - //(f->functions(0)->symbol())->copyAcrossFiles(*(f->firstStatement())); - //printf(" \n****** AFTER COPY FUNCTION(0) ********\n"); - if (deb_reg > 1) - f->unparsestdout(); - return; - - /* - has_contains = NULL; - //all_replicated=1; - for(stat=stat->lexNext(); stat; stat=end_of_unit->lexNext()) { - //end of external procedure with CONTAINS statement - if(has_contains && stat->variant() == CONTROL_END && has_contains->controlParent() == stat->controlParent()){ - end_of_unit = stat; has_contains = NULL; - continue; - } - if( stat->variant() == BLOCK_DATA){//BLOCK_DATA header - end_of_unit = stat->lastNodeOfStmt(); - //TransModule(stat); //changing variant VAR_DECL with VAR_DECL_90 - continue; - } - // PROGRAM, SUBROUTINE, FUNCTION header - func = stat; - cur_func = func; - - //scanning the Symbols Table of the function - // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); - - // all_replicated= has_contains ? 0 : 1; - // translating the function - // if(only_debug) - // InsertDebugStat(func); - // else - // TransFunc(func); - - } - - */ -} - - -void CallGraph(SgStatement *func) -{ - // Build a directed acyclic call multigrahp (call DAMG) - // which represents calls between routines of the program - // which are to be (or not to be) expanded - - SgStatement *stmt, *last, *data_stf, *first, *last_spec, *stam; - //SgExpression *e; - //SgStatement *task_region_parent, *on_parent, *mod_proc, *begbl; - //SgStatement *copy_proc = NULL; - SgLabel *lab_exec; - - //int i; - //stmt_list *pstmt = NULL; - //initialization - data_stf = NULL; - - DECL(func->symbol()) = 1; - if (func->variant() == PROG_HEDR) - PROGRAM_HEADER(func->symbol()) = func->thebif; - - //creating graph node for header of function (procedure, program) - cur_node = CreateGraphNode(func->symbol(), func); - - first = func->lexNext(); - //printf("\n%s header_id= %d \n", func->symbol()->identifier(), func->symbol()->id()); - //!!!debug - //if(fsymb) - //printf("\n%s %s \n", header(func->variant()),fsymb->identifier()); - //else { - //printf("Function name error \n"); - //return; - //} - //get the last node of the program unit(function) - last = func->lastNodeOfStmt(); - end_of_unit = last; - if (!(last->variant() == CONTROL_END)) - printf(" END Statement is absent\n"); - - //********************************************************************** - // Specification Directives Processing - //********************************************************************** - // follow the statements of the function in lexical order - // until first executable statement - for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { - - if (!isSgExecutableStatement(stmt)) //is Fortran specification statement - // isSgExecutableStatement: - // FALSE - for specification statement of Fortan 90 - // TRUE - for executable statement of Fortan 90 and - // all directives of F-DVM - { - //!!!debug - // printVariantName(stmt->variant()); //for debug - // printf("\n"); - - - if ((stmt->variant() == DATA_DECL) || (stmt->variant() == STMTFN_STAT)) { - /* if(stmt->variant() == STMTFN_STAT && stmt->expr(0) && stmt->expr(0)->symbol() && ((!strcmp(stmt->expr(0)->symbol()->identifier(),"number_of_processors")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_rank")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_size")))){ - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); - //deleting the statement-function declaration named - // NUMBER_OF_PROCESSORS or PROCESSORS_RANK or PROCESSORS_SIZE - continue; - } - */ - if (!data_stf) - data_stf = stmt; //first statement in data-or-function statement part - continue; - } - if (stmt->variant() == ENTRY_STAT) { - //err("ENTRY statement is not permitted in FDVM", stmt); - //warn("ENTRY among specification statements", 81,stmt); - continue; - } - - continue; - } - - if ((stmt->variant() == FORMAT_STAT)) - continue; - - - // processing the DVM Specification Directives - - /* //including the DVM specification directive to list of these directives - pstmt = addToStmtList(pstmt, stmt); - - switch(stmt->variant()) { - - case(HPF_TEMPLATE_STAT): - case(HPF_PROCESSORS_STAT): - continue; - } - */ - // all declaration statements are processed, - // current statement is executable (F77/DVM) - - break; - } - - //********************************************************************** - // LibDVM References Generation - // for distributed and aligned arrays - //********************************************************************** - - - first_exec = stmt; // first executable statement - - lab_exec = first_exec->label(); // store the label of first ececutable statement - last_spec = first_exec->lexPrev();//may be extracted after - where = first_exec; //before first executable statement will be inserted new statements - stam = NULL; - - - //********************************************************************** - // Executable Directives Processing - //********************************************************************** - - //initialization - // . . . - //follow the executable statements in lexical order until last statement - // of the function - - for (stmt = first_exec; stmt && (stmt != last); stmt = stmt->lexNext()) { //for(stmt=first_exec;stmt ; stmt=stmt->lexNext()) - cur_st = stmt; - - switch (stmt->variant()) { - - case ENTRY_STAT: - // !!!!!!! - break; - - case CONTROL_END: - case STOP_STAT: - case PAUSE_NODE: - case GOTO_NODE: // GO TO - break; - - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case WHILE_NODE: // DO WHILE (...) - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - case LOGIF_NODE: // Logical IF - FunctionCallSearch(stmt->expr(0)); - break; - - case COMGOTO_NODE: // Computed GO TO - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - FunctionCallSearch(stmt->expr(1)); - break; - - case PROC_STAT: { // CALL - SgExpression *el; -#ifdef __SPF - if (needToInline.find(stmt->symbol()->identifier()) != needToInline.end()) - Call_Site(stmt->symbol(), 1); - else - Call_Site(stmt->symbol(), 0); -#else - Call_Site(stmt->symbol(), 1); -#endif - // looking through the arguments list - for (el = stmt->expr(0); el; el = el->rhs()) - Arg_FunctionCallSearch(el->lhs()); // argument - } - break; - - case ASSIGN_STAT: // Assign statement - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - case FOR_NODE: - FunctionCallSearch(stmt->expr(0)); // left part - FunctionCallSearch(stmt->expr(1)); // right part - break; - - default: - break; - } - - } // end of processing executable statement/directive - - //END_: - // for debugging - if (deb_reg > 1) - PrintGraphNode(cur_node); - return; -} - - - - - -void Replace(SgStatement *stfun) { - SgSymbol *fname, *name; - fname = stfun->symbol(); - SYMB_IDENT(fname->thesymb) = (char*)"DEBUG"; - name = stfun->lexNext()->expr(0)->lhs()->symbol(); - SYMB_IDENT(name->thesymb) = (char*)"dvdvdv"; -} - -/* -void TransFunc(SgStatement *func) { - SgStatement *stmt,*last,*rmout, *data_stf, *first, *first_dvm_exec, *last_spec, *stam; - SgStatement *st_newv = NULL;// for NEW_VALUE directives - SgExpression *e; - SgStatement *task_region_parent, *on_parent, *mod_proc, *begbl; - SgStatement *copy_proc = NULL; - SgLabel *lab_exec; - - int i; - int begin_block; - distribute_list *distr = NULL; - distribute_list *dsl,*distr_last; - align *pal = NULL; - align *node, *root; - stmt_list *pstmt = NULL; - int inherit_is = 0; - int contains[2]; - CallGraph(func); -return; - if(func->variant() != PROG_HEDR){ - stmt=func->copyPtr(); - Replace(stmt); - func->insertStmtBefore(*stmt,*(func->controlParent())); - } - return; -} -*/ - - - -void FunctionCallSearch(SgExpression *e) -{ - SgExpression *el; - if (!e) - return; - - /* if(isSgArrayRefExp(e)) { - for(el=e->lhs(); el; el=el->rhs()) - FunctionCallSearch(el->lhs()); - - return; - } - */ - - if (isSgFunctionCallExp(e)) - { -#ifdef __SPF - if (needToInline.find(e->symbol()->identifier()) != needToInline.end()) - Call_Site(e->symbol(), 1); - else - Call_Site(e->symbol(), 0); -#else - Call_Site(e->symbol(), 1); -#endif - for (el = e->lhs(); el; el = el->rhs()) - Arg_FunctionCallSearch(el->lhs()); - return; - } - FunctionCallSearch(e->lhs()); - FunctionCallSearch(e->rhs()); - return; -} - -void Arg_FunctionCallSearch(SgExpression *e) -{ - FunctionCallSearch(e); - return; -} - -void FunctionCallSearch_Left(SgExpression *e) -{ - FunctionCallSearch(e); -} - - -void Call_Site(SgSymbol *s, int inlined) -{ - graph_node * gnode; - //printf("\n%s id= %d \n", s->identifier(), s->id()); - if (!do_dummy && isDummyArgument(s)) - return; - if (!do_stmtfn && isStatementFunction(s)) - return; - // if(isIntrinsicFunction(s)) return; - //printf("\nLINE %d", cur_st->lineNumber()); - gnode = CreateGraphNode(s, NULL); - CreateOutcomingEdge(gnode, inlined); // for node 'cur_node' edge: [cur_node]-> gnode - CreateIncomingEdge(gnode, inlined); // for node 'gnode' edge: cur_node ->[gnode] -} - -graph_node *CreateGraphNode(SgSymbol *s, SgStatement *header_st) -{ - graph_node * gnode; - graph_node **pnode = new (graph_node *); - gnode = NodeForSymbInGraph(s, header_st); - if (!gnode) - gnode = NewGraphNode(s, header_st); - - *pnode = gnode; - if (!ATTR_NODE(s)) - { - s->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); - if (deb_reg > 1) - printf("attribute NODE[%d] for %s[%d]\n", GRAPHNODE(s)->id, s->identifier(), s->id()); - } - return gnode; -} - -graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader) -{ - graph_node *ndl; - for (ndl = node_list; ndl; ndl = ndl->next) - { -#ifdef __SPF - //TODO: improve this! - if (std::string(s->identifier()) == ndl->symb->identifier()) - { - if (ndl->st_header == NULL) - { - ndl->st_header = stheader; - ndl->symb = s; - } - return ndl; - } -#else - if (s == ndl->symb) - return ndl; - if ((ndl->st_header == NULL) && !strcmp(ndl->symb->identifier(), s->identifier()) && (ndl->symb->scope() == s->scope())) - { - if (stheader) - { - ndl->st_header = stheader; - ndl->symb = s; - } - return ndl; - } -#endif - /* else //if(s->thesymb->decl == NULL) - { Err_g("Call graph error '%s' ", s->identifier(), 1); - (void) fprintf( stderr,"%s %d %d in line %d\n",s->identifier(),s->id(),ndl->symb->id(),cur_st->lineNumber()); - } - */ - } - return NULL; -} - -graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st) -{ - graph_node * gnode; - - gnode = new graph_node; - gnode->id = ++gcount; - gnode->next = node_list; - node_list = gnode; - gnode->file = current_file; - gnode->st_header = header_st; - gnode->symb = s; - gnode->to_called = NULL; - gnode->from_calling = NULL; - gnode->split = 0; - gnode->tmplt = 0; - gnode->clone = 0; - gnode->count = 0; - return(gnode); -} - -edge *CreateOutcomingEdge(graph_node *gnode, int inlined) -{ - edge *out_edge, *edgl; - //SgSymbol *sunit; - //sunit = cur_func->symbol(); - - // testing outcoming edge list of current (calling) routine graph-node: cur_node - for (edgl = cur_node->to_called; edgl; edgl = edgl->next) - if ((edgl->to->symb == gnode->symb) && (edgl->inlined == inlined)) //there is outcoming edge: [cur_node]->gnode - return(edgl); - // creating new edge: [cur_node]->gnode - out_edge = NewEdge(NULL, gnode, inlined); //NULL -> cur_node - out_edge->next = cur_node->to_called; - cur_node->to_called = out_edge; - return(out_edge); -} - -edge *CreateIncomingEdge(graph_node *gnode, int inlined) -{ - edge *in_edge, *edgl; - //SgSymbol *sunit; - //sunit = cur_func->symbol(); - - // testing incoming edge list of called routine graph-node: gnode - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - if ((edgl->from->symb == cur_node->symb) && (edgl->inlined == inlined)) //there is incoming edge: : cur_node->[gnode] - return(edgl); - // creating new edge: cur_node->[gnode] - in_edge = NewEdge(cur_node, NULL, inlined); //NULL -> gnode - in_edge->next = gnode->from_calling; - gnode->from_calling = in_edge; - return(in_edge); -} - -edge *NewEdge(graph_node *from, graph_node *to, int inlined) -{ - edge *nedg; - nedg = new edge; - nedg->from = from; - nedg->to = to; - nedg->inlined = inlined; - return(nedg); -} -/**********************************************************************/ - -/* Testing Functions */ - -/**********************************************************************/ - -int isDummyArgument(SgSymbol *s) -{ - if (s->thesymb->entry.var_decl.local == IO) // is dummy argument - return(1); - else - return(0); -} - -int isHeaderStmtSymbol(SgSymbol *s) -{ - return(DECL(s) == 1 && (s->variant() == FUNCTION_NAME || s->variant() == PROCEDURE_NAME || s->variant() == PROGRAM_NAME)); -} - -int isStatementFunction(SgSymbol *s) -{ - if (s->scope() == cur_func && s->variant() == FUNCTION_NAME) - return 1; //is statement function symbol - else - return 0; -} - -int isHeaderNode(graph_node *gnode) -{ - //header node represent a "top level" routine: - //main program, or any subprogram which was called - //without inline expansion somewhere in the original program - edge * edgl; -#ifdef __SPF - if (needToInline.find(gnode->symb->identifier()) == needToInline.end()) -#else - if (gnode->symb->variant() == PROGRAM_NAME) -#endif - return 1; - - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - if (!edgl->inlined) - return 1; - return 0; -} - -int isDeadNode(graph_node *gnode) -{ - // dead node represent a "dead" routine: - // a subprogram which was not called -#ifdef __SPF - if (gnode->from_calling || needToInline.find(gnode->symb->identifier()) == needToInline.end()) -#else - if (gnode->from_calling || gnode->symb->variant() == PROGRAM_NAME) -#endif - return 0; - else - return 1; -} - -int isNoBodyNode(graph_node *gnode) -{ - // nobody node represent a "nobody" routine: intrinsic or absent - - if (gnode->st_header) - return(0); - else - return(1); -} - -/**********************************************************************/ -stmt_list* addToStmtList(stmt_list *pstmt, SgStatement *stat) -{ - // adding the statement to the beginning of statement list - // pstmt-> stat -> stmt-> ... -> stmt - stmt_list * stl; - if (!pstmt) - { - pstmt = new stmt_list; - pstmt->st = stat; - pstmt->next = NULL; - } - else - { - stl = new stmt_list; - stl->st = stat; - stl->next = pstmt; - pstmt = stl; - } - return pstmt; -} - -stmt_list* delFromStmtList(stmt_list *pstmt) -{ - // deletinging last statement from the statement list - // pstmt-> stat -> stmt-> ... -> stmt - pstmt = pstmt->next; - return (pstmt); -} - - -graph_node_list* addToNodeList(graph_node_list *pnode, graph_node *gnode) -{ - // adding the node to the beginning of node list - // pnode-> gnode -> gnode-> ... -> gnode - graph_node_list * ndl; - if (!pnode) { - pnode = new graph_node_list; - pnode->node = gnode; - pnode->next = NULL; - } - else { - ndl = new graph_node_list; - ndl->node = gnode; - ndl->next = pnode; - pnode = ndl; - } - return (pnode); -} - -graph_node_list* delFromNodeList(graph_node_list *pnode, graph_node *gnode) -{ - // deleting the node from the node list - - graph_node_list *ndl, *l; - if (!pnode) - return NULL; - - if (pnode->node == gnode) - return pnode->next; - l = pnode; - for (ndl = pnode->next; ndl; ndl = ndl->next) - { - if (ndl->node == gnode) - { - l->next = ndl->next; - return pnode; - } - else - l = ndl; - } - return pnode; -} - -graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode) -{ - // testing: is there node in the node list - - graph_node_list * ndl; - if (!pnode) return (NULL); - for (ndl = pnode; ndl; ndl = ndl->next) - { - if (ndl->node == gnode) - return(ndl); - } - return (NULL); -} - - -void PrintGraphNode(graph_node *gnode) -{ - edge * edgl; - printf("%s(%d) -> ", gnode->symb->identifier(), gnode->symb->id()); - for (edgl = gnode->to_called; edgl; edgl = edgl->next) - printf(" %s(%d)", edgl->to->symb->identifier(), edgl->to->symb->id()); - printf("\n"); -} - -void PrintGraphNodeWithAllEdges(graph_node *gnode) -{ - edge * edgl; - printf("\n"); - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - printf(" %s(%d)", edgl->from->symb->identifier(), edgl->from->symb->id()); - if (!gnode->from_calling) - printf(" "); - printf(" ->%s(%d)-> ", gnode->symb->identifier(), gnode->symb->id()); - for (edgl = gnode->to_called; edgl; edgl = edgl->next) - printf(" %s(%d)", edgl->to->symb->identifier(), edgl->to->symb->id()); -} - -void PrintWholeGraph() -{ - graph_node *ndl; - printf("\n%s\n", "C a l l G r a p h"); - for (ndl = node_list; ndl; ndl = ndl->next) - PrintGraphNode(ndl); - printf("\n"); - fflush(NULL); -} - -void PrintWholeGraph_kind_2() -{ - graph_node *ndl; - printf("\nC a l l G r a p h 2\n"); - for (ndl = node_list; ndl; ndl = ndl->next) - PrintGraphNodeWithAllEdges(ndl); - printf("\n"); - fflush(NULL); -} - - -void BuildingHeaderNodeList() -{ - //Build a list of header nodes to represent "top level" routines - - graph_node *ndl; - if (deb_reg) - printf("\nH e a d e r N o d e L i s t\n"); - for (ndl = node_list; ndl; ndl = ndl->next) { - if (isHeaderNode(ndl)) - { - header_node_list = addToNodeList(header_node_list, ndl); - if (deb_reg) - printf("%s\n", ndl->symb->identifier()); - } - } -} - -void RemovingDeadSubprograms() -{ - //Prune the call graph by removing nodes representing "dead" subprogram - - graph_node *ndl, *lnode; - int dead; - edge *edgl; - - do - { - lnode = NULL; dead = 0; - for (ndl = node_list; ndl; ndl = ndl->next) { - if (isDeadNode(ndl)) //removing node ndl - { - if (deb_reg) - printf("\n%s(%d) dead ", ndl->symb->identifier(), ndl->symb->id()); - dead = 1; - //removing dead node from node_list - if (lnode) - lnode->next = ndl->next; - else - node_list = ndl->next; - //removing edges that are incomig to any node from dead node - for (edgl = ndl->to_called; edgl; edgl = edgl->next) - DeleteIncomingEdgeFrom(edgl->to, ndl); - //removing the code of subpogram (extracting statements) - //????????? - //includind dead node in dead_node_list - dead_node_list = addToNodeList(dead_node_list, ndl); - } - else - lnode = ndl; - } - } while (dead == 1); - - if (dead_node_list && deb_reg) { - graph_node_list *dl; - printf("\n%s\n", "D e a d N o d e L i s t"); - for (dl = dead_node_list; dl; dl = dl->next) - printf("\n%s\n", dl->node->symb->identifier()); - } -} - - -void NoBodySubprograms() -{ - //looking through the call graph for nodes representing "no body" subprogram: intrinsic or absent - - graph_node *ndl, *lnode; - int empty; - edge *edgl; - - do - { - lnode = NULL; empty = 0; - for (ndl = node_list; ndl; ndl = ndl->next) { - if (isNoBodyNode(ndl)) //removing node ndl - { - empty = 1; - - //removing empty node from node_list - if (lnode) - lnode->next = ndl->next; - else - node_list = ndl->next; - //removing edges that are incoming to empty node from any node - for (edgl = ndl->from_calling; edgl; edgl = edgl->next) - DeleteOutcomingEdgeTo(edgl->from, ndl); - //includind empty node in nobody_node_list - nobody_node_list = addToNodeList(nobody_node_list, ndl); - - } - else - lnode = ndl; - } - } while (empty == 1); - - if (nobody_node_list && deb_reg) { - graph_node_list *dl; - printf("\n\nN o B o d y N o d e L i s t\n"); - for (dl = nobody_node_list; dl; dl = dl->next) - printf("%s\n", dl->node->symb->identifier()); - } - //deleting nobody nodes - //?????????? there are references to node from attribute(GRAPH_NODE) of symbols -} - -void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from) -{ - // deleting edge that is incoming to node 'gnode' from node 'from' - edge *edgl, *ledge; - ledge = NULL; - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) { - if (edgl->from == from) { - if (deb_reg > 1) - printf("\n%s(%d)-%s(%d) edge dead ", from->symb->identifier(), from->symb->id(), gnode->symb->identifier(), gnode->symb->id()); - - if (ledge) - ledge->next = edgl->next; - else - gnode->from_calling = edgl->next; - } - else - ledge = edgl; - } -} - -void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto) -{ - // deleting edge that is outcoming from node 'gnode' to node 'gto' - edge *edgl, *ledge; - ledge = NULL; - for (edgl = gnode->to_called; edgl; edgl = edgl->next) { - if (edgl->to == gto) { - if (deb_reg > 1) - printf("\n%s(%d)-%s(%d) edge empty ", gnode->symb->identifier(), gnode->symb->id(), gto->symb->identifier(), gto->symb->id()); - - if (ledge) - ledge->next = edgl->next; - else - gnode->to_called = edgl->next; - } - else - ledge = edgl; - } -} - - -void ScanSymbolTable(SgFile *f) -{ - SgSymbol *s; - for (s = f->firstSymbol(); s; s = s->next()) - if (isHeaderStmtSymbol(s)) - printSymb(s); -} - -void ScanTypeTable(SgFile *f) -{ - SgType *t; - for (t = f->firstType(); t; t = t->next()) - { // printf("TYPE[%d] : ", t->id()); - printType(t); - } -} - -void ReseatEdges(graph_node *gnode, graph_node *newnode) -{//reseat all edges representing inlined calls to gnode to point to newnode - edge *edgl, *tol, *ledge, *curedg; - graph_node *from; - ledge = NULL; - // for(edgl=gnode->from_calling; edgl; edgl=edgl->next) -// looking through the incoming edge list of gnode - edgl = gnode->from_calling; - while (edgl) - { - if (edgl->inlined) - { - from = edgl->from; - // reseating outcoming edge to 'gnode' to point to 'newnode' - for (tol = from->to_called; tol; tol = tol->next) - if (tol->to == gnode && tol->inlined) - { - tol->to = newnode; break; - } - // removing "inlined" incoming edge of gnode - if (ledge) - ledge->next = edgl->next; - else - gnode->from_calling = edgl->next; - - curedg = edgl; // set curedg to point at removed edge - edgl = edgl->next; // to next node of list - - // adding removed edge to 'newnode' - curedg->next = newnode->from_calling; - newnode->from_calling = curedg; - - } - else - { - ledge = edgl; - edgl = edgl->next; - } - } //end while -} - -graph_node *SplittingNode(graph_node *gnode) -{ - if (!gnode->split) - { // . . . !!! new COMMON block and BLOCK DATA - gnode->split = 1; - } - if (deb_reg) - printf("\nSplitting NODE[%d] %s\n", gnode->id, gnode->symb->identifier()); - - return (CloneNode(gnode)); -} - -graph_node *CloneNode(graph_node *gnode) -{// Clone gnode to create a new node gnew - graph_node *gnew; - SgSymbol *scopy; - graph_node **pnode = new (graph_node *); - // copying subprogram, inserting after END statement of last subroutine of current file - scopy = &((gnode->symb)->copySubprogram(*(global_st))); // copyAcrossFiles(*(cur_st))); - // for debug - //printf(" \n****** BODY COPY FUNCTION(0) %s [%d] ********\n", scopy->identifier(), scopy->id()); - //scopy->body()->unparsestdout(); - - // creating new graph node - gnew = NewGraphNode(scopy, scopy->body()); - gnew->clone = 1; - // copying edges - //CopyIncomingEdges (gnode,gnew); - CopyOutcomingEdges(gnode, gnew); - // adding the attribute GRAPH_NODE to new symbol: scopy - *pnode = gnew; - scopy->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); - if (deb_reg > 1) - printf("\n attribute NODE[%d] for %s[%d] CLONE of NODE[%d]\n", GRAPHNODE(scopy)->id, scopy->identifier(), scopy->id(), gnode->id); - - return(gnew); -} - -void CopyOutcomingEdges(graph_node *gnode, graph_node *gnew) -{ - edge *out_edge, *in_edge, *edgl; - graph_node *s; - // looking through the outcoming edge list of gnode - for (edgl = gnode->to_called; edgl; edgl = edgl->next) - { - s = edgl->to; // successor of gnode - // creating new edge of gnew (copy of edgl) - out_edge = NewEdge(NULL, edgl->to, edgl->inlined); - out_edge->next = gnew->to_called; - gnew->to_called = out_edge; - // creating new edge of s (successor of gnode) - in_edge = NewEdge(gnew, NULL, edgl->inlined); - in_edge->next = s->from_calling; - s->from_calling = in_edge; - } - return; -} - -void CopyIncomingEdges(graph_node *gnode, graph_node *gnew) -{ - edge *in_edge, *out_edge, *edgl; - graph_node *p; - // looking through the incoming edge list of gnode - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - { - p = edgl->from; // predecessor of gnode - // creating new edge of gnew (copy of edgl) - in_edge = NewEdge(edgl->from, NULL, edgl->inlined); - in_edge->next = gnew->from_calling; - gnew->from_calling = in_edge; - // creating new edge of p (predecessor of gnode) - out_edge = NewEdge(NULL, gnew, edgl->inlined); - out_edge->next = p->to_called; - p->to_called = out_edge; - - } - return; -} - -void RemovingUninlinedEdges() -{ - // Removing all edges representing uninlined calls - graph_node *ndl; - edge *edgl, *ledge; - for (ndl = node_list; ndl; ndl = ndl->next) - { - ledge = NULL; - // looking through the incoming edge list - for (edgl = ndl->from_calling; edgl; edgl = edgl->next) - { - if (!edgl->inlined) - {//removing uninlined edge - if (ledge) - ledge->next = edgl->next; - else - ndl->from_calling = edgl->next; - } - else - ledge = edgl; - } - ledge = NULL; - // looking through the outcoming edge list - for (edgl = ndl->to_called; edgl; edgl = edgl->next) - { - if (!edgl->inlined) - {//removing uninlined edge - if (ledge) - ledge->next = edgl->next; - else - ndl->to_called = edgl->next; - } - else - ledge = edgl; - } - } -} - - -/************************ P A R T I T I O N ************************************/ -void Partition() -{ - graph_node_list *ndl, *replication, *interval, *Ilist; - graph_node *hnode, *n, *s, *nnew; - edge *edg; - for (ndl = header_node_list; ndl; ndl = ndl->next) - { - hnode = ndl->node; - replication = NULL; interval = NULL; - interval = addToNodeList(interval, hnode); - hnode->Inext = NULL; DAG_list = hnode; - - while (replication || unvisited_in(interval)) - {//------------------------------------------------------- - do - for (Ilist = interval; Ilist; Ilist = Ilist->next) - { - n = Ilist->node; - if (n->visited == 1) continue; - n->visited = 1; - for (edg = n->to_called; edg; edg = edg->next) - { - s = edg->to; - if (inInterval(s, interval)) continue; - if (allPredecessorInInterval(s, interval)) - { - interval = addToNodeList(interval, s); - s->Inext = DAG_list; DAG_list = s; - MoveEdgesPointTo(s); - replication = delFromNodeList(replication, s); - } - else - { - if (!isInNodeList(replication, s)) - replication = addToNodeList(replication, s); - } - } - } - while (unvisited_in(interval)); - //-------------------------------------------------------- - for (Ilist = replication; Ilist; Ilist = Ilist->next) - { - n = Ilist->node; - replication = delFromNodeList(replication, n); - nnew = SplittingNode(n); - interval = addToNodeList(interval, n); - n->Inext = DAG_list; DAG_list = n; - ReseatEdgesOutsideToNew(n, nnew, interval); - MoveEdgesPointTo(n); - } - } - } - return; -} - -int unvisited_in(graph_node_list *interval) -{ - graph_node_list *Ilist; - for (Ilist = interval; Ilist; Ilist = Ilist->next) - if (Ilist->node->visited == 0) return(1); - return(0); -} - -int inInterval(graph_node *gnode, graph_node_list *interval) -{ - graph_node_list *Ilist; - for (Ilist = interval; Ilist; Ilist = Ilist->next) - if (Ilist->node == gnode) return(1); - return(0); -} - -int allPredecessorInInterval(graph_node *gnode, graph_node_list *interval) -{ - edge *edg; - for (edg = gnode->from_calling; edg; edg = edg->next) - if (!inInterval(edg->from, interval)) return(0); - return(1); -} - -void MoveEdgesPointTo(graph_node *gnode) -{ - edge *edg, *el; - for (edg = gnode->from_calling; edg; edg = edg->next) - { - edg->inlined = 2; - for (el = edg->from->to_called; el; el = el->next) - if (el->to == gnode) - { - el->inlined = 2; break; - } - } -} - -void ReseatEdgesOutsideToNew(graph_node *gnode, graph_node *gnew, graph_node_list *interval) -{//reseat all edges from nodes outside interval to 'gnode' to point to 'gnew' - edge *edgl, *tol, *ledge, *curedg; - ledge = NULL; - //looking through the incoming edge list of 'gnode' - edgl = gnode->from_calling; - while (edgl) - //for(edgl=gnode->from_calling; edgl; edgl=edgl->next) - { - if (inInterval(edgl->from, interval)) { ledge = edgl; edgl = edgl->next; continue; } - // reseating outcoming edge to 'gnode' to point to 'gnew' - for (tol = edgl->from->to_called; tol; tol = tol->next) - if (tol->to == gnode) - { - tol->to = gnew; break; - } - // removing incoming edge of 'gnode' - if (ledge) - ledge->next = edgl->next; - else - gnode->from_calling = edgl->next; - - curedg = edgl; // set curedg to point at removed edge - edgl = edgl->next; // to next node of list - - // adding removed edge to 'gnew' - curedg->next = gnew->from_calling; - gnew->from_calling = curedg; - } -} - -#ifdef __SPF -static void splitString(const string &strIn, const char delim, vector &result) -{ - std::stringstream ss; - ss.str(strIn); - - std::string item; - while (std::getline(ss, item, delim)) - result.push_back(item); -} - -void removeIncludeStatsAndUnparse(SgFile *file, const char *fileName, const char *fout) -{ - fflush(NULL); - int funcNum = file->numberOfFunctions(); - FILE *currFile = fopen(fileName, "r"); - if (currFile == NULL) - { - printf("ERROR: Can't open file %s for read\n", fileName); - //addToGlobalBufferAndPrint(buf); - //throw(-1); - } - - // name -> unparse comment - map includeFiles; - - // TODO: extend buff size in dynamic - char buf[8192]; - while (!feof(currFile)) - { - char *read = fgets(buf, 8192, currFile); - if (read) - { - string line(read); - size_t posF = line.find("include"); - if (posF != string::npos) - { - posF += sizeof("include") - 1; - int tok = 0; - size_t st = -1, en; - for (size_t k = posF; k < line.size(); ++k) - { - if (line[k] == '\'' && tok == 1) - break; - else if (line[k] == '\'') - tok++; - else if (tok == 1 && st == -1) - st = k; - else - en = k; - } - string inclName(line.begin() + st, line.begin() + en + 1); - - auto toInsert = includeFiles.find(inclName); - if (toInsert == includeFiles.end()) - includeFiles.insert(toInsert, make_pair(inclName, line)); - //printf("insert %s -> %s\n", inclName.c_str(), line.c_str()); - } - } - } - - vector needDel; - - vector removeFunctions; - for (int i = 0; i < funcNum; ++i) - { - SgStatement *st = file->functions(i); - if (string(st->fileName()) != fileName) - { - removeFunctions.push_back(st); - continue; - } - SgStatement *lastNode = st->lastNodeOfStmt(); - - set toInsert; - SgStatement *first = NULL; - bool start = false; - - while (st != lastNode) - { - if (st == NULL) - { - printf("Internal error\n"); - break; - } - - if (strcmp(st->fileName(), fileName)) - { - toInsert.insert(st->fileName()); - start = true; - } - else if (start && first == NULL) - first = st; - st = st->lexNext(); - } - - for (auto it = toInsert.begin(); it != toInsert.end(); ++it) - { - auto foundIt = includeFiles.find(*it); - if (foundIt != includeFiles.end()) - { - if (first) - { - if (first->comments() == NULL) - first->addComment(foundIt->second.c_str()); - else - { - const char *comments = first->comments(); - if (strstr(comments, foundIt->second.c_str()) == NULL) - first->addComment(foundIt->second.c_str()); - } - } - else //TODO - printf("Internal error\n"); - } - } - - // remove code from 'include' only from file, not from Sage structures - start = file->functions(i); - st = file->functions(i); - lastNode = st->lastNodeOfStmt(); - - while (st != lastNode) - { - if (st == NULL) - { - printf("Internal error\n"); - break; - } - - if (strcmp(st->fileName(), fileName)) - splitString(st->unparse(), '\n', needDel); - st = st->lexNext(); - } - } - - for (int i = 0; i < removeFunctions.size(); ++i) - removeFunctions[i]->extractStmt(); - - FILE *fOut = fopen(fout, "w"); - if (fOut == NULL) - printf("Internal error\n"); - file->unparse(fOut); - fclose(fOut); - - if (needDel.size() > 0) - { - fOut = fopen(fout, "r"); - - string currFile = ""; - int idxDel = 0; - while (!feof(fOut)) - { - fgets(buf, 8192, fOut); - const int len = strlen(buf); - if (len > 0) - buf[len - 1] = '\0'; - - if (needDel.size() > idxDel) - { - if (needDel[idxDel] == buf) - idxDel++; - else - { - currFile += buf; - currFile += "\n"; - } - } - else - { - currFile += buf; - currFile += "\n"; - } - } - fclose(fOut); - - fOut = fopen(fout, "w"); - fwrite(currFile.c_str(), sizeof(char), currFile.length(), fOut); - fclose(fOut); - } -} -#endif \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/inline.h b/projects/dvm_svn/fdvm/trunk/InlineExpansion/inline.h deleted file mode 100644 index 5f5e4c7..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/inline.h +++ /dev/null @@ -1,643 +0,0 @@ -#include "user.h" - -#define MAXTAGS 1000 -#include "dvm_tag.h" - - -#ifdef IN_M_ -#define EXTERN -#else -#define EXTERN extern -#endif - -struct graph_node { - int id; //a number of node - graph_node *next; - graph_node *next_header_node; //??? - graph_node *Inext; - SgFile *file; - SgStatement *st_header; - SgSymbol *symb; //??? st_header->symbol() - struct edge *to_called; //outcoming - struct edge *from_calling; //incoming - int split; //flag - int tmplt; //flag - int visited; //flag for partition algorithm - int clone; //flag is clone node - int count; //counter of inline expansions -}; - -struct graph_node_list { - graph_node_list *next; - graph_node *node; -}; - -struct edge { - edge *next; - graph_node *from; - graph_node *to; - int inlined; //1 - inlined, 0 - not inlined -}; - -struct edge_list { - edge_list *next; - edge *edg; -}; - - -struct block_list { - block_list *next; - block_list *same_name; - SgExpression *block; -}; - - -struct distribute_list { - distribute_list *next; - SgStatement *stdis; -}; - -struct stmt_list { - stmt_list *next; - SgStatement *st; -}; - -struct label_list { - label_list *next; - SgLabel *lab; - SgLabel *newlab; -}; - -struct dist_symb_list { - dist_symb_list *next; - SgSymbol *symb; -}; - - -struct align { - SgSymbol * symb; - align * next; - align * alignees; - SgStatement * align_stmt; -}; -struct mod_attr{ - SgSymbol *symb; - SgSymbol *symb_list; -}; -struct algn_attr { - int type; - align *ref; -}; -struct rem_var { - int index; - int amv; - int ncolon; -}; -struct rem_acc { - SgExpression *rml; - SgStatement *rmout; - int rmbuf_use[5]; - rem_acc *next; -}; -struct group_name_list { - group_name_list *next; - SgSymbol *symb; -}; -struct symb_list { - symb_list *next; - SgSymbol *symb; -}; -struct base_list { - base_list *next; - SgSymbol *type_symbol; - SgSymbol *base_symbol; -}; -struct D_do_list { - D_do_list *next; - int No; - int num_line; - SgLabel *end_lab; - SgSymbol *do_var; -}; -struct interval_list { - interval_list *prev; - int No; - SgStatement *begin_st; -}; -struct D_fragment { - D_fragment *next; - int No; -}; - -struct fragment_list { - int No; - SgStatement *begin_st; - int dlevel; - int elevel; - int dlevel_spec; - int elevel_spec; - fragment_list *next; -}; -struct fragment_list_in { - int N1; - int N2; - int level; - fragment_list_in *next; -}; -struct reduction_list { - reduction_list *next; - int red_op; - SgExpression *red_var; - int ind; -}; -struct IND_ref_list { - IND_ref_list *next; - SgExpression *rmref; - SgExpression *axis[7]; - SgExpression *coef[7]; - SgExpression *cons[7]; - int nc; - int ind; -}; - -struct coeffs { - SgSymbol *sc[10]; - int use; -}; - -struct heap_pointer_list { - heap_pointer_list *next; - SgSymbol *symb_heap; - SgSymbol *symb_p; -}; - -struct filename_list { - filename_list *next; - char *name; - SgSymbol *fns; -}; - -const int ROOT = 1; -const int NODE = 2; -const int GRAPH_NODE = 1000; -const int PRE_BOUND = 1001; -const int CONSTANT_MAP = 1002; -const int ARRAY_MAP = 1003; -const int ARRAY_MAP_1 = 1004; -const int ARRAY_MAP_2 = 1005; -const int ADJUSTABLE_ = 1006; - -const int MAX_INTRINSIC_NUM =300; - -const int MAX_LOOP_LEVEL = 10; // 7 - maximal number of loops in parallel loop nest -const int MAX_LOOP_NEST = 25; // maximal number of nested loops -const int MAX_FILE_NUM = 100; // maximal number of file reference in procedure -const int SIZE_IO_BUF = 262144; //4185600; // IO buffer size in elements -const int ANTIDEP = 0; -const int FLOWDEP = 1; -#define FICT_INT 2000000000 /* -2147483648 0x7FFFFFFFL*/ - -//enum{ Integer, Real, Double, Complex, Logical, DoubleComplex}; -enum {UNIT_,FMT_,REC_,ERR_,IOSTAT_,END_,NML_,EOR_,SIZE_,ADVANCE_}; -enum {U_,FILE_,STATUS_,ER_,IOST_,ACCESS_,FORM_,RECL_,BLANK_,EXIST_, -OPENED_,NUMBER_,NAMED_,NAME_,SEQUENTIAL_,DIRECT_,NEXTREC_,FORMATTED_, -UNFORMATTED_,POSITION_,ACTION_,READWRITE_,READ_,WRITE_,DELIM_,PAD_}; - -enum {ICHAR, CHAR,INT,IFIX,IDINT,FLOAT,REAL,SNGL,DBLE,CMPLX,DCMPLX,AINT,DINT,ANINT,DNINT,NINT,IDNINT,ABS,IABS,DABS,CABS, - MOD,AMOD,DMOD, SIGN,ISIGN, DSIGN, DIM,IDIM,DDIM, MAX,MAX0, AMAX1,DMAX1, AMAX0,MAX1, MIN,MIN0, - AMIN1,DMIN1,AMIN0,MIN1,LEN,INDEX,AIMAG,DIMAG,CONJG,DCONJG,SQRT,DSQRT,CSQRT,EXP,DEXP,CEXP,LOG,ALOG,DLOG,CLOG, - LOG10,ALOG10,DLOG10,SIN,DSIN,CSIN,COS,DCOS,CCOS,TAN,DTAN,ASIN,DASIN,ACOS,DACOS,ATAN,DATAN, - ATAN2,DATAN2,SINH,DSINH,COSH,DCOSH,TANH,DTANH, LGE,LGT,LLE,LLT}; -//universal: ANINT,NINT,ABS, MOD,SIGN,DIM,MAX,MIN,SQRT,EXP,LOG,LOG10,SIN,COS,TAN,ASIN,ACOS,ATAN,ATAN2,SINH,COSH,TANH -//enum {SIZE,LBOUND,UBOUND,LEN,CHAR,KIND,F_INT,F_REAL,F_CHAR,F_LOGICAL,F_CMPLX}; //intrinsic functions of Fortran 90 - -const int Integer = 0; -const int Real = 1; -const int Double = 2; -const int Complex = 3; -const int Logical = 4; -const int DComplex = 5; - - - -#define ATTR_NODE(A) ((graph_node **)(A)->attributeValue(0,GRAPH_NODE)) -#define GRAPHNODE(A) (*((graph_node **)(A)->attributeValue(0,GRAPH_NODE))) -#define PREBOUND(A) ((SgExpression **)(A)->attributeValue(0,PRE_BOUND)) -#define ARRAYMAP(A) ((SgExpression *)(A)->attributeValue(0,ARRAY_MAP_1)) -#define ARRAYMAP2(A) ((SgExpression *)(A)->attributeValue(0,ARRAY_MAP_2)) -#define CONSTANTMAP(A) ((SgExpression *)(A)->attributeValue(0,CONSTANT_MAP)) -#define ADJUSTABLE(A) ((SgExpression *)(A)->attributeValue(0,ADJUSTABLE_)) - - -#define HEADER(A) ((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_HEADER)) -#define INDEX(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_HEADER))) -#define DVM000(N) (new SgArrayRefExp(*dvmbuf, *new SgValueExp(N))) -#define SH_GROUP(S) (*((int *) (S) -> attributeValue(0, SHADOW_GROUP_IND))) -#define RED_GROUP(S) (*((int *) (S) -> attributeValue(0, RED_GROUP_IND))) -#define SHADOW_(A) ((SgExpression **)(ORIGINAL_SYMBOL(A))->attributeValue(0,SHADOW_WIDTH)) -#define POINTER_DIR(A) ((SgStatement **)(ORIGINAL_SYMBOL(A))->attributeValue(0,POINTER_)) -#define DISTRIBUTE_DIRECTIVE(A) ((SgStatement **)(ORIGINAL_SYMBOL(A))->attributeValue(0,DISTRIBUTE_)) -#define ARRAY_BASE_SYMBOL(A) ((SgSymbol **)(ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_BASE)) -#define INDEX_SYMBOL(A) ((SgSymbol **)(A)->attributeValue(0,INDEX_DELTA)) -#define INIT_LOOP_VAR(A) ((SgSymbol **)(A)->attributeValue(0,INIT_LOOP)) -#define CONSISTENT_HEADER(A) (*((SgSymbol **)(ORIGINAL_SYMBOL(A))->attributeValue(0,CONSISTENT_ARRAY_HEADER))) -#define POINTER_INDEX(A) (*((int *)(A)->attributeValue(0,HEAP_INDEX))) -#define BUFFER_INDEX(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,BUFFER_COUNT))) -#define BUFFER_COUNT_PLUS_1(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,BUFFER_COUNT))) = (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,BUFFER_COUNT)))+1; -#define PS_INDEX(A) (*((int *)(A)->attributeValue(0,TASK_INDEX))) -#define DEBUG_INDEX(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,DEBUG_AR_INDEX))) -#define TASK_SYMBOL(A) (*((SgSymbol **)(ORIGINAL_SYMBOL(A))->attributeValue(0,TSK_SYMBOL))) -#define AR_COEFFICIENTS(A) ((coeffs *) (ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_COEF)) -#define MAX_DVM maxdvm = (maxdvm < ndvm) ? ndvm-1 : maxdvm -#define FREE_DVM(A) maxdvm = (maxdvm < ndvm) ? ndvm-1 : maxdvm; ndvm-=A -#define SET_DVM(A) maxdvm = (maxdvm < ndvm) ? ndvm-1 : maxdvm; ndvm=A -#define FREE_HPF(A) maxhpf = (maxhpf < nhpf) ? nhpf-1 : maxhpf; nhpf-=A -#define SET_HPF(A) maxhpf = (maxhpf < nhpf) ? nhpf-1 : maxhpf; nhpf=A -#define HPF000(N) (new SgArrayRefExp(*hpfbuf, *new SgValueExp(N))) -#define IS_DUMMY(A) ((A)->thesymb->entry.var_decl.local == IO) -#define IS_TEMPLATE(A) ((A)->attributes() & TEMPLATE_BIT) -#define IN_COMMON(A) ((A)->attributes() & COMMON_BIT) -#define IN_DATA(A) ((A)->attributes() & DATA_BIT) -#define IN_EQUIVALENCE(A) ((A)->attributes() & EQUIVALENCE_BIT) -#define IS_ARRAY(A) ((A)->attributes() & DIMENSION_BIT) -#define IS_ALLOCATABLE(A) ((A)->attributes() & ALLOCATABLE_BIT) -#define IS_ALLOCATABLE_POINTER(A) (((A)->attributes() & ALLOCATABLE_BIT) || ((A)->attributes() & POINTER_BIT)) -#define IS_POINTER_F90(A) ((A)->attributes() & POINTER_BIT) -#define CURRENT_SCOPE(A) (((A)->scope() == cur_func) && ((A)->thesymb->entry.var_decl.local != BY_USE) ) -#define IS_BY_USE(A) ((A)->thesymb->entry.Template.base_name != 0) -/*#define ORIGINAL_SYMBOL(A) (OriginalSymbol(A)) */ -#define ORIGINAL_SYMBOL(A) (IS_BY_USE(A) ? (A)->moduleSymbol() : (A)) -#define IS_SAVE(A) (((A)->attributes() & SAVE_BIT) || (saveall && !IS_TEMPLATE(A) && !IN_COMMON(A) && !IS_DUMMY(A)) ) -#define IS_POINTER(A) ((A)->attributes() & DVM_POINTER_BIT) -#define IS_SH_GROUP_NAME(A) ((A)->variant() == SHADOW_GROUP_NAME) -#define IS_RED_GROUP_NAME(A) ((A)->variant() == REDUCTION_GROUP_NAME) -#define IS_GROUP_NAME(A) (((A)->variant() == SHADOW_GROUP_NAME) || ((A)->variant() == REDUCTION_GROUP_NAME) || ((A)->variant() == REF_GROUP_NAME)) -#define IS_DVM_ARRAY(A) (((A)->attributes() & DISTRIBUTE_BIT) || ((A)->attributes() & ALIGN_BIT) || ((A)->attributes() & INHERIT_BIT)) -#define IS_DISTR_ARRAY(A) (((A)->attributes() & DISTRIBUTE_BIT) || ((A)->attributes() & ALIGN_BIT) || ((A)->attributes() & INHERIT_BIT)) -#define IN_MODULE (cur_func->variant() == MODULE_STMT) -#define IN_MAIN_PROGRAM (cur_func->variant() == PROG_HEDR) -#define DVM_PROC_IN_MODULE(A) ((mod_attr *)(A)->attributeValue(0,MODULE_STR)) -#define LINE_NUMBER_BEFORE(ST,WHERE) doAssignStmtBefore(new SgValueExp((ST)->lineNumber()),WHERE); ndvm--; InsertNewStatementBefore((many_files ? D_FileLine(ndvm,ST) : D_Lnumb(ndvm)) ,WHERE) -#define LINE_NUMBER_STL_BEFORE(STL,ST,WHERE) doAssignStmtBefore(new SgValueExp((ST)->lineNumber()),WHERE); ndvm--; InsertNewStatementBefore(STL= (many_files ? D_FileLine(ndvm,ST) : D_Lnumb(ndvm)),WHERE) -#define LINE_NUMBER_AFTER(ST,WHERE) InsertNewStatementAfter ((many_files ? D_FileLine(ndvm,ST) : D_Lnumb(ndvm)),WHERE,(WHERE)->controlParent()); doAssignStmtBefore(new SgValueExp((ST)->lineNumber()),cur_st); ndvm-- -#define LINE_NUMBER_N_AFTER(N,WHERE,CP) InsertNewStatementAfter((many_files ? D_FileLine(ndvm,CP): D_Lnumb(ndvm)),WHERE,CP); doAssignStmtBefore(new SgValueExp(N),cur_st); ndvm-- -#define LINE_NUMBER_NEXP_AFTER(NE,WHERE,CP) InsertNewStatementAfter((many_files ? D_DummyFileLine(ndvm,"dvm_check"): D_Lnumb(ndvm)),WHERE,CP); doAssignStmtBefore((NE),cur_st); ndvm-- -#define ALIGN_RULE_INDEX(A) ((int*)(A)->attributeValue(0,ALIGN_RULE)) -#define INTERVAL_LINE (St_frag->begin_st->lineNumber()) -#define INTERVAL_NUMBER (St_frag->No) -#define GROUP_REF(S,I) (new SgArrayRefExp(*(S),*new SgValueExp(I))) -#define IS_DO_VARIABLE_USE(E) ((SgExpression **)(E)->attributeValue(0,DO_VARIABLE_USE)) -#define HEADER_SIZE(A) (1+(maxbuf+1)*2*(Rank(A)+1)) -#define HSIZE(R) (2*R + 2) -#define ARRAY_ELEMENT(A,I) (new SgArrayRefExp(*A, *new SgValueExp(I))) -#define INTEGER_VALUE(E,C) ((E)->variant() == INT_VAL && (E)->valueInteger() == (C)) -#define IS_INTRINSIC_TYPE(T) (!TYPE_RANGES((T)->thetype) && !TYPE_KIND_LEN((T)->thetype) && ((T)->variant() != T_DERIVED_TYPE)) - -//---------------------------------------------------------------------------------------- - -#define DECL(A) ((A)->thesymb->decl) -#define HEDR(A) ((A)->thesymb->entry.Template.func_hedr) -#define PROGRAM_HEADER(A) ((A)->thesymb->entry.prog_decl.prog_hedr) - -#define NON_CONFORMABLE 0 -#define _IDENTICAL_ 1 -#define _CONSTANT_ 2 -#define _ARRAY_ 3 -#define SCALAR_ARRAYREF 4 -#define VECTOR_ARRAYREF 5 -#define _SUBARRAY_ 6 - -EXTERN SgConstantSymb *Iconst[10]; -EXTERN const char *tag[MAXTAGS]; -EXTERN int ndvm; // index for buffer array 'dvm000' -EXTERN int maxdvm; // size of array 'dvm000' -EXTERN int loc_distr; -EXTERN int send; //set to 1 if I/O statement require 'send' operation -EXTERN char *fin_name; //input file name -EXTERN SgFile *current_file; //current file -EXTERN SgStatement *where;//used in doAssignStmt: new statement is inserted before 'where' statement -EXTERN int nio; -EXTERN SgSymbol *bufIO[6]; -EXTERN SgSymbol *loop_var[8]; // for generatig DO statements - - -EXTERN SgStatement *par_do; // first DO statement of current parallel loop -EXTERN int iplp; //dvm000 element number for storing ParLoopRef -EXTERN int irg; //dvm000 element number for storing RedGroupRef -EXTERN int irgts; //dvm000 element number for storing RedGroupRef(task_region) -EXTERN int idebrg; //dvm000 element number for storing DebRedGroupRef -EXTERN SgExpression *redgref; // reduction group reference -EXTERN SgExpression *redgrefts; // reduction group reference for TASK_REGION -EXTERN SgExpression *debredgref; // debug reduction group reference -EXTERN SgExpression *red_list; // reduction operation list in FDVM program -EXTERN SgExpression *task_red_list; // reduction operation list (in TASK_REGION directive) -EXTERN int iconsg; //dvm000 element number for storing ConsistGroupRef -EXTERN int iconsgts; //dvm000 element number for storing ConsistGroupRef(task_region) -EXTERN int idebcg; //dvm000 element number for storing DebRedGroupRef -EXTERN SgExpression *consgref; // consistent group reference -EXTERN SgExpression *consgrefts; // consistent group reference for TASK_REGION -EXTERN SgExpression *debconsgref; // debug reduction(consistent) group reference -EXTERN SgExpression *cons_list; // consistent array list in FDVM program -EXTERN SgExpression *task_cons_list; // consistent array list (in TASK_REGION directive) -EXTERN SgLabel *end_lab, *begin_lab; //labels for parallel loop nest -EXTERN D_do_list *cur_do; -EXTERN D_do_list *free_list; -EXTERN int Dloop_No; -EXTERN int pardo_No; -EXTERN int taskreg_No; -EXTERN int pardo_line; -EXTERN int D_end_do; -EXTERN int nfrag ; //counter of intervals for performance analizer -EXTERN interval_list *St_frag ; -EXTERN interval_list *St_loop_first; -EXTERN interval_list *St_loop_last; -EXTERN int perf_analysis ; //set to 1 by -e1 -EXTERN int close_loop_interval; -EXTERN stmt_list *goto_list; -EXTERN int len_int; //set by option -bind -EXTERN int len_long;//set by option -bind -EXTERN int bind;//set by option -bind -EXTERN int dvm_debug ; //set to 1 by -d1 or -d2 or -d3 or -d4 flag -EXTERN int only_debug ; //set to 1 by -s flag -EXTERN int level_debug ; //set to 1 by -d1, to 2 by -d2, ... -EXTERN fragment_list_in *debug_fragment; //set by option -d -EXTERN fragment_list_in *perf_fragment; //set by option -e -EXTERN int debug_regim; //set by option -d -EXTERN int check_regim; //set by option -dc -EXTERN int dbg_if_regim; //set by option -dbif -EXTERN int IOBufSize; //set by option -bufio -EXTERN SgSymbol *dbg_var; -EXTERN int HPF_program; -EXTERN int rmbuf_size[6]; -EXTERN int first_time; -EXTERN SgStatement *indep_st; //first INDEPENDENT directive of loop nest -EXTERN SgStatement *ins_st1, *ins_st2; // for INDEPENDENT loop -EXTERN SgSymbol *DoVar[MAX_LOOP_NEST], **IND_var, **IEX_var; -EXTERN int iarg; // for INDEPENDENT loop -//--------------------------------------------------------------------- -EXTERN int errcnt; // counter of errors in file -EXTERN graph_node *first_node, *node_list, *first_header_node, *cur_node, *DAG_list, *top_node; -EXTERN graph_node_list *all_node_list, *header_node_list, *dead_node_list, *nobody_node_list; -EXTERN SgStatement *cur_func; // current function -EXTERN SgSymbol *cur_symb, *top_symb_list, *sub_symb_list; -EXTERN int do_dummy, do_stmtfn; // flag for building call graph: by default do_dummy=0, do_stmtfn=0 -EXTERN int gcount; -EXTERN SgStatement *cur_st; // current statement (for inserting) -EXTERN SgStatement *global_st; // first statement of file (global_bfnd) -EXTERN stmt_list *entryst_list; -//EXTERN stmt_list *DATA_list; -EXTERN int max_lab; // maximal label in file -EXTERN int num_lab; // maximal(last) new label -EXTERN int vcounter; -EXTERN SgStatement *top_header, *top_last,* top_first_executable,*top_last_declaration, *top_global; -EXTERN label_list *format_labels, *top_labels, *proc_labels; -EXTERN SgSymbol *do_var[10]; -EXTERN symb_list *top_temp_vars; -EXTERN block_list *common_list, *common_list_l, *equiv_list, *equiv_list_l; -EXTERN block_list *top_common_list, *top_common_list_l, *top_equiv_list, *top_equiv_list_l; -EXTERN int modified; -EXTERN int intrinsic_type[MAX_INTRINSIC_NUM]; -EXTERN const char *intrinsic_name[MAX_INTRINSIC_NUM]; -EXTERN int deb_reg, with_cmnt; -//--------------------------------------------------------------------- -/* inl_exp.cpp */ -void initialize(); -void InlinerDriver(SgFile *f); -void CallGraph(SgStatement *func); -void initVariantNames(); -int isDummyArgument(SgSymbol *s); -int isStatementFunction(SgSymbol *s); -void FunctionCallSearch(SgExpression *e); -void FunctionCallSearch_Left(SgExpression *e); -void Arg_FunctionCallSearch(SgExpression *e); -stmt_list *addToStmtList(stmt_list *pstmt, SgStatement *stat); -stmt_list *delFromStmtList(stmt_list *pstmt); -graph_node_list *addToNodeList(graph_node_list *pnode, graph_node *gnode); -graph_node_list *delFromNodeList(graph_node_list *pnode, graph_node *gnode); -graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode); -graph_node *CreateGraphNode(SgSymbol *s, SgStatement *header_st); -graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st); -void PrintGraphNode(graph_node *gnode); -void PrintGraphNodeWithAllEdges(graph_node *gnode); -void PrintWholeGraph(); -void PrintWholeGraph_kind_2 (); -graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader); -void Call_Site(SgSymbol *s, int inlined); -edge *CreateOutcomingEdge(graph_node *gnode, int inlined); -edge *CreateIncomingEdge(graph_node *gnode, int inlined); -edge *NewEdge(graph_node *from, graph_node *to, int inlined); -void BuildingHeaderNodeList(); -void RemovingDeadSubprograms(); -int isHeaderNode(graph_node *gnode); -int isDeadNode(graph_node *gnode); -int isHeaderStmtSymbol(SgSymbol *s); -void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from); -void ScanSymbolTable(SgFile *f); -void NoBodySubprograms(); -void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto); -int isNoBodyNode(graph_node *gnode); -void ReseatEdges(graph_node *gnode, graph_node *newnode); -graph_node *SplittingNode(graph_node *gnode); -graph_node *CloneNode(graph_node *gnode); -void CopyOutcomingEdges(graph_node *gnode, graph_node *gnew); -void CopyIncomingEdges (graph_node *gnode, graph_node *gnew); -void RemovingUninlinedEdges(); -void Partition(); -void MoveEdgesPointTo(graph_node *gnode); -int unvisited_in(graph_node_list *interval); -int inInterval(graph_node *gnode,graph_node_list *interval); -int allPredecessorInInterval(graph_node *gnode,graph_node_list *interval); -void ReseatEdgesOutsideToNew(graph_node *gnode, graph_node *gnew,graph_node_list *interval); -void initIntrinsicNames(); - - -/* hlp.cpp */ -SgLabel * firstLabel(SgFile *f); -int isLabel(int num) ; -SgLabel * GetLabel(); -SgLabel * GetNewLabel(); -SgLabel * NewLabel(); -//SgLabel * NewLabel(int lnum); -const char* header(int i); -char *UnparseExpr(SgExpression *e) ; -void printVariantName(int i); -void Error(const char *s, const char *t, int num, SgStatement *stmt); -void err(const char *s, int num, SgStatement *stmt); -void Err_g(const char *s, const char *t, int num); -void Warning(const char *s, const char *t, int num, SgStatement *stmt); -void warn(const char *s, int num, SgStatement *stmt); -void Warn_g(const char *s, const char *t, int num); -void errN(const char *s, int num, SgStatement *stmt); -void format_num (int num, char num3s[]); -SgExpression *ConnectList(SgExpression *el1, SgExpression *el2); -int is_integer_value(char *str); -void PrintSymbolTable(SgFile *f); -void printSymb(SgSymbol *s); -void printType(SgType *t); -void PrintTypeTable(SgFile *f); -int isSymbolNameInScope(char *name, SgStatement *scope); -int isSymbolName(char *name); -SgExpression *ReplaceIntegerParameter(SgExpression *e); -void SetScopeOfLabel(SgLabel *lab, SgStatement *scope); -SgLabel *isLabelWithScope(int num, SgStatement *stmt) ; -SgExpression *UpperBound(SgSymbol *ar, int i); -SgExpression *LowerBound(SgSymbol *ar, int i); -int Rank (SgSymbol *s); -symb_list *AddToSymbList ( symb_list *ls, SgSymbol *s); -void MakeDeclarationForTempVarsInTop(); -SgExpression *Calculate(SgExpression *er); -int ExpCompare(SgExpression *e1, SgExpression *e2); -SgExpression *Calculate_List(SgExpression *e); - - -/* inliner.cpp */ -void Inliner(graph_node *gtop); -void EntryPointList(SgFile *file); -void IntegerConstantSubstitution(SgStatement *header); -int isIntrinsicFunctionName(char *name); -char *ChangeIntrinsicFunctionName(char *name); -void RoutineCleaning(SgStatement *header); -void StatementCleaning(SgStatement *stmt); -SgSymbol *SearchFunction(SgExpression *e,SgStatement *stmt); -SgSymbol *PrecalculateFtoVar(SgExpression *e,SgStatement *stmt); -void PrecalculateActualParameters(SgSymbol *s,SgExpression *e,SgStatement *stmt); -void PrecalculateExpression(SgSymbol *sp,SgExpression *e,SgStatement *stmt); -void InsertNewStatementBefore (SgStatement *stat, SgStatement *current); -void InsertNewStatementAfter (SgStatement *stat, SgStatement *current, SgStatement *cp); -int ParameterType(SgExpression *e,SgStatement *stmt); -int TestSubscripts(SgExpression *e,SgStatement *stmt); -int TestRange(SgExpression *e,SgStatement *stmt); -SgSymbol *GetTempVarForF(SgSymbol *sf, SgType *t); -SgSymbol *GetTempVarForArg(int i, SgSymbol *sf, SgType *t); -SgSymbol *GetTempVarForSubscr(SgType *t); -SgSymbol *GetTempVarForBound(SgSymbol *sa); -SgStatement *InlineExpansion(graph_node *gtop, SgStatement *stmt, SgSymbol *sf, SgExpression *args); -int isInSymbolTable(SgSymbol *sym); -SgStatement * CreateTemplate(graph_node *gnode); -void SiteIndependentTransformation(graph_node *gnode); //(SgStatement *header); -void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable); -void LogIf_to_IfThen(SgStatement *stmt); -void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable); -SgStatement *ReplaceByGoToBottomOfRoutine(SgStatement *retstmt, SgLabel *lab_return); -void MoveFormatToTopOfRoutine(SgStatement *format_stmt, SgStatement *last_declaration); -int TestFormatLabel(SgLabel *lab); -int isInlinedCall(graph_node *gtop, graph_node *gnode); -void ReplaceReturnByContinue(SgStatement *return_st); -SgStatement *MoveFormatIntoTopLevel(SgStatement *format_stmt, int clone); -graph_node *getNodeForSymbol(graph_node *gtop,char *name); -int isInlinedCallSite(SgStatement *stmt); -graph_node *getAttrNodeForSymbol(SgSymbol *sf); -label_list *addToLabelList(label_list *lablist, SgLabel *lab); -int isInLabelList(SgLabel *lab, label_list *lablist); -void ReplaceFormatLabelsInStmts(SgStatement *header); -int isLabelOfTop(SgLabel *lab); -void LabelList(SgStatement *header); -SgLabel *isInFormatMap(SgLabel *lab); -void SetScopeToLabels(SgStatement *header); -void AdjustableArrayBounds(SgStatement *header, SgStatement *after); -int isAdustableBound(SgExpression *bound); -int SearchVarRef(SgExpression *e); -void PrecalculateArrayBound(SgSymbol *ar,SgExpression *bound, SgStatement *after, SgStatement *header); -void ReplaceWholeArrayRefInIOStmts(SgStatement *header); -SgExpression *ImplicitLoop(SgSymbol *ar); -SgSymbol *GetImplicitDoVar(int j); -SgExpression * LowerLoopBound(SgSymbol *ar, int i); -SgExpression * UpperLoopBound(SgSymbol *ar, int i); -void RemapLocalVariables(SgStatement *header); -SgSymbol *CreateListOfLocalVariables(SgStatement *header); -void MakeDeclarationStmtInTop(SgSymbol *s); -SgSymbol *NextSymbol(SgSymbol *s); -SgSymbol *GetNewTopSymbol(SgSymbol *s); -int isInTopSymbList(SgSymbol *sym); -SgSymbol *GetImplicitDoVar(int j); -char *NewName(char *name); -SgSymbol *isTopName(char *name); -SgSymbol *isTopNameOfType(char *name, SgType *type); -void ReplaceIntegerParameterInTypeOfVars(SgStatement *header, SgStatement *last); -void ReplaceIntegerParameter_InType(SgType *t); -void MakeDeclarationStmtsForConstant(SgSymbol *s); -void RemapFunctionResultVar(SgExpression *topref, SgSymbol *sf); -SgStatement *TranslateSubprogramReferences(SgStatement *header); -//void TranslateExpression(SgExpression * e, int md[]); -SgExpression *TranslateExpression(SgExpression * e, int *md); -SgSymbol *SymbolMap(SgSymbol *s); -void InsertBlockAfter(SgStatement *after, SgStatement *first, SgStatement *last); -void ExtractSubprogramsOfCallGraph(graph_node *gtop); -int CompareConstants(SgSymbol *rs, SgSymbol *ts); -void RemapConstants(SgStatement *header,SgStatement *first_exec); -void RemapLocalObject(SgSymbol *s); -void CommonBlockList(SgStatement *stmt); -void TopCommonBlockList(SgStatement *stmt); -block_list *AddToBlockList(block_list *blist_last, SgExpression *eb); -void EquivBlockList(SgStatement *stmt); -void TranslateExpression_1(SgExpression *e); -void TranslateExpressionList(SgExpression *e) ; -SgStatement *DeclaringCommonBlock(SgExpression *bl); -void RemapCommonBlocks(SgStatement *header); -int isUnconflictingCommon(SgSymbol *s); -block_list *isConflictingCommon(SgSymbol *s); -SgType *BaseType(SgType *type); -block_list *isInCommonList(SgSymbol *s, block_list *blc ); -int areOfSameType(SgSymbol *st, SgSymbol *sr); -int IntrinsicTypeSize(SgType *t); -int TypeSize(SgType *t); -int TypeLength(SgType *t); -void MakeRefsConformable(SgExpression *tref, SgExpression *ref); -void CalculateTopLevelRef(SgSymbol *tops,SgExpression *tref, SgExpression *ref); -void CreateTopCommonBlockList(); -void RemapCommonObject(SgSymbol *s,SgSymbol *tops); -void RemapCommonList(SgExpression *el); -int CompareValues(PTR_LLND pe1,PTR_LLND pe2); -SgType * TypeOfResult(SgExpression *e); -int is_IntrinsicFunction(SgSymbol *sf); -int IntrinsicInd(SgSymbol *sf); -SgType *TypeF(int indf,SgExpression *e); -SgType * SgTypeComplex(SgFile *f); -SgType * SgTypeDoubleComplex(SgFile *f); -void ConformActualAndFormalParameters(SgSymbol *scopy,SgExpression *args,SgStatement *parentSt); -SgSymbol *FirstDummy(SgSymbol *sf); -SgSymbol *NextDummy(SgSymbol *s); -int TestConformability(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt); -int isScalar(SgSymbol *symb); -int SameType(SgSymbol *darg, SgExpression *fact); -int Same(SgType *ft,SgType *dt); -int isArray(SgSymbol *symb); -int TestShapes(SgArrayType *ftp, SgArrayType *dtp); -SgExpression *LowerBoundOfDim(SgExpression *e); -SgExpression *UpperBoundOfDim(SgExpression *e); -int IdenticalValues(SgExpression *e1, SgExpression *e2); -SgExpression *ArrayMap(SgSymbol *s); -//SgExpression *ArrayMap1(SgSymbol *s); -SgExpression *ArrayMap2(SgSymbol *s); -SgExpression *FirstIndexChange(SgExpression *e, SgExpression *index); -int SameShapes(SgArrayType *ftp, SgArrayType *dtp); -int is_NoExpansionFunction(SgSymbol *sf); -int isFormalProcedure(SgSymbol *symb); -int SameDims(SgExpression *fe,SgExpression *de); -SgExpression *FirstIndexesChange(SgExpression *mape, SgExpression *re); -void ConformReferences(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt); -void TranslateArrayTypeExpressions(SgSymbol *darg); -int isAdjustableArray(SgSymbol *param); -int TestBounds(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp); -void TransformForFortran77(); -SgExpression *IndexChange(SgExpression *e, SgExpression *index, SgExpression *lbe); -int TestVector(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp); -SgType *TypeOfArgument(SgExpression *e); -void ReplaceContext(SgStatement *stmt); -int isDoEndStmt(SgStatement *stmt); -void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab); -void EditExpressionList(SgExpression *e); -void Add_Comment(graph_node *g, SgStatement *stmt, int flag); -void PrintTopSymbList(); -void PrintSymbList(SgSymbol *slist, SgStatement *header); - -/* driver.cpp */ - -//----------------------------------------------------------------------- - -extern "C" char* funparse_bfnd(...); -extern "C" char* Tool_Unparse2_LLnode(...); -extern "C" void Init_Unparser(...); - -//----------------------------------------------------------------------- -//extern SgLabel * LabelMapping(PTR_LABEL label); diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/inliner.cpp b/projects/dvm_svn/fdvm/trunk/InlineExpansion/inliner.cpp deleted file mode 100644 index d19ef88..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/inliner.cpp +++ /dev/null @@ -1,2993 +0,0 @@ -/*********************************************************************/ -/* Inline Expansion 2006 */ -/*********************************************************************/ - - -/*********************************************************************/ -/* Inliner */ -/*********************************************************************/ - -#include -#include -#include "inline.h" - -#ifdef __SPF -extern "C" void printLowLevelWarnings(const char *fileName, const int line, const wchar_t *messageR, const char *messageE, const int group) { } -extern "C" void addToCollection(const int line, const char *file, void *pointer, int type) { } -extern "C" void removeFromCollection(void *pointer) { } - -#include -#include - -std::map> sgStats; -std::map> sgExprs; -void addToGlobalBufferAndPrint(const std::string &toPrint) { } -#endif - -void Inliner(graph_node *gtop) -{ - SgStatement *header, *stmt, *last, *newst; - int i; - - header = gtop->st_header; - top_header = header; - if (with_cmnt) - top_header->addComment("!*****AFTER INLINE EXPANSION******\n"); - top_node = gtop; - vcounter = 0; - max_lab = getLastLabelId(); - num_lab = 0; - for (i = 0; i < 10; i++) - do_var[i] = NULL; - top_temp_vars = NULL; - - if (deb_reg) - printf("\nINLINER %s [%d]\n", gtop->symb->identifier(), gtop->symb->id()); - - //Find all entry points - EntryPointList(gtop->file); - - //Substitute all integer symbolic constants in "top level" routine - IntegerConstantSubstitution(header); - - //Clean "top level" routine (precalculation of function call and actual parameter expressions) - RoutineCleaning(header); - SetScopeToLabels(header); - - // for debugging - if (deb_reg > 1) - PrintSymbolTable(gtop->file); - - // Perform the inline expansion - // for each call site to be expanded (as encountered at "top level") - last = header->lastNodeOfStmt(); - top_last = last; - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) { - top_first_executable = stmt; break; - } - top_last_declaration = top_first_executable->lexPrev(); - - newst = new SgStatement(CONT_STAT); -#if __SPF - insertBfndListIn(newst->thebif, top_last_declaration->thebif, NULL); -#else - top_last_declaration->insertStmtAfter(*newst); -#endif - top_first_executable = newst; - - MakeDeclarationForTempVarsInTop(); //finish cleaning - - for (stmt = top_first_executable; stmt && (stmt != last); ) - { - switch (stmt->variant()) - { - case ASSIGN_STAT: - if (stmt->expr(1)->variant() == FUNC_CALL) - stmt = InlineExpansion(gtop, stmt, stmt->expr(1)->symbol(), stmt->expr(1)->lhs()); //stmt = first inserted statement or next statement - else - stmt = stmt->lexNext(); - continue; - case PROC_STAT: - stmt = InlineExpansion(gtop, stmt, stmt->symbol(), stmt->expr(0)); //stmt = first inserted statement or next statement - continue; - default: - stmt = stmt->lexNext(); - continue; - } - } - // Make delarations for temporary variables created by translation algorithm (TranslateSubprogramReferences()) - MakeDeclarationForTempVarsInTop(); - - // Transform declaration part of top level routine - // DATA and statement functions -> after all specification statements (standard F77) - TransformForFortran77(); - - newst->extractStmt(); - - // Extract routines for all the graph nodes except top node - if (deb_reg && gtop && gtop->to_called) - printf("\n T a b l e o f I n l i n e E x p a n s i o n s i n %s\n\n", gtop->symb->identifier()); - - ExtractSubprogramsOfCallGraph(gtop); - - // - if (deb_reg > 2) - PrintSymbolTable(gtop->file); - return; -} - -void EntryPointList(SgFile *file) -//find entry point in the inline flow DAG -{ - SgStatement *first_st, *stmt; - first_st = file->firstStatement(); - for (stmt = first_st; stmt; stmt = stmt->lexNext()) - if (stmt->variant() == ENTRY_STAT) - entryst_list = addToStmtList(entryst_list, stmt); -} - -void IntegerConstantSubstitution(SgStatement *header) -//Substitute all integer symbolic constants in routine -{ - SgStatement *last, *stmt; - SgExpression *e; - SgExprListExp *el; - SgConstantSymb *sc; - // PTR_LLND ranges; - int i; - last = header->lastNodeOfStmt(); - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - { // PARAMETER statement - if (stmt->variant() == PARAM_DECL) - - { - for (el = isSgExprListExp(stmt->expr(0)); el; el = el->next()) - { - e = el->lhs(); sc = isSgConstantSymb(e->symbol()); - SYMB_VAL(sc->thesymb) = ReplaceIntegerParameter(&(sc->constantValue()->copy()))->thellnd; - } - //printf("PARAM_DECL\n"); - continue; - } - if (stmt->variant() == VAR_DECL) - ReplaceIntegerParameter_InType(stmt->expr(1)->type()); - - // any other statement - for (i = 0; i < 3; i++) - if (stmt->expr(i)) - stmt->setExpression(i, *ReplaceIntegerParameter(stmt->expr(i))); - - } - ReplaceIntegerParameterInTypeOfVars(header, last); -} - -void ReplaceIntegerParameterInTypeOfVars(SgStatement *header, SgStatement *last) -{ - SgSymbol *s, *sl; - // PTR_LLND ranges; - sl = last->lexNext() ? last->lexNext()->symbol() : NULL; - - //if(sl) printf("%s %s\n",header->symbol()->identifier(),sl->identifier()); - for (s = header->symbol(); s != sl && s != NULL; s = s->next()) - if (s->scope() == header) //local variable - ReplaceIntegerParameter_InType(s->type()); - return; -} -void ReplaceIntegerParameter_InType(SgType *t) -{ - PTR_LLND ranges; - SgExpression *ne; - if (!t) return; - if ((ranges = TYPE_RANGES(t->thetype)) != 0) - { - ne = ReplaceIntegerParameter(LlndMapping(ranges)); - // if(isSgArrayType(t)) //ranges->variant() == EXPR_LIST - // Calculate_List(ne); - } - if ((ranges = TYPE_KIND_LEN(t->thetype)) != 0) - ne = ReplaceIntegerParameter(LlndMapping(ranges)); - -} - - -void MakeDeclarationForTempVarsInTop() -{ - symb_list *sl; - for (sl = top_temp_vars; sl; sl = sl->next) - MakeDeclarationStmtInTop(sl->symb); - top_temp_vars = NULL; -} - -void TransformForFortran77() -{ - SgStatement *stmt, *st1; - for (stmt = top_header; stmt != top_last_declaration; ) - { - if (stmt->variant() == DATA_DECL || stmt->variant() == STMTFN_STAT) - { - st1 = stmt; - stmt = stmt->lexNext(); - st1->extractStmt(); - top_first_executable->insertStmtBefore(*st1, *top_header); - } - else - stmt = stmt->lexNext(); - } -} - -void ExtractSubprogramsOfCallGraph(graph_node *gtop) -{ - edge *el; - // graph_node *nd; - - for (el = gtop->to_called; el; el = el->next) - { - if (el->to->st_header) - { - el->to->st_header->extractStmt(); - el->to->st_header = NULL; - if (deb_reg) - printf(" %s: %d\n", el->to->symb->identifier(), el->to->count); - ExtractSubprogramsOfCallGraph(el->to); - } - } -} - -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// R O U T I N E C L E A N I N G -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -void RoutineCleaning(SgStatement *header) -{ - SgStatement *last, *stmt; - //SgExpression *e; - //SgExprListExp *el; - //SgConstantSymb *sc; - SgSymbol *s; - //int i; - cur_func = header; - last = header->lastNodeOfStmt(); - //scanning local symbols, - // if symbol used as a variable and is an intrinsic function name, - // rename the symbol to not conflict with any intrinsic function names - for (s = header->symbol(); s; s = s->next()) - if (s->scope() == header && isSgVariableSymb(s) && isIntrinsicFunctionName(s->identifier())) - SYMB_IDENT(s->thesymb) = ChangeIntrinsicFunctionName(s->identifier()); - // cleaning each executable statement - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - { - if (isSgExecutableStatement(stmt)) //is not Fortran specification statement - StatementCleaning(stmt); - } -} - - -void StatementCleaning(SgStatement *stmt) -{ - SgAssignStmt *asst; - SgSymbol *sf; - if ((asst = isSgAssignStmt(stmt)) != 0) - //if(stmt->variant() == ASSIGN_STAT) - { - if ((asst->rhs()->variant() == FUNC_CALL) && - (isSgVarRefExp(asst->lhs()) - || - (isSgArrayRefExp(asst->lhs()) && !isSgArrayType(asst->lhs()->type())))) - { - ReplaceContext(stmt); - SearchFunction(asst->lhs(), stmt); - SearchFunction(asst->rhs()->lhs(), stmt); // actual parameter expression list - PrecalculateActualParameters(asst->rhs()->symbol(), asst->rhs()->lhs(), stmt); - return; - } - - } - if ((sf = SearchFunction(stmt->expr(0), stmt)) != 0) stmt->setExpression(0, *new SgVarRefExp(sf)); - if ((sf = SearchFunction(stmt->expr(1), stmt)) != 0) stmt->setExpression(1, *new SgVarRefExp(sf)); - if ((sf = SearchFunction(stmt->expr(2), stmt)) != 0) stmt->setExpression(2, *new SgVarRefExp(sf)); - - if (stmt->variant() == PROC_STAT) - { - ReplaceContext(stmt); - PrecalculateActualParameters(stmt->symbol(), stmt->expr(0), stmt); - } -} - -SgSymbol *SearchFunction(SgExpression *e, SgStatement *stmt) -{ - SgSymbol *sf; - if (!e) - return(NULL); - if (e->variant() == FUNC_CALL) - { - return(PrecalculateFtoVar(e, stmt)); - } - - if ((sf = SearchFunction(e->lhs(), stmt)) != 0) e->setLhs(new SgVarRefExp(sf)); - if ((sf = SearchFunction(e->rhs(), stmt)) != 0) e->setRhs(new SgVarRefExp(sf)); - return (NULL); -} - -SgSymbol *PrecalculateFtoVar(SgExpression *e, SgStatement *stmt) -{ - SgStatement *newst; - SgSymbol *sf; - SgType *t; - t = TypeOfResult(e); - if (!t) - err("Wrong type", 2, stmt); - sf = GetTempVarForF(e->symbol(), t); - newst = new SgAssignStmt(*new SgVarRefExp(sf), *e); - InsertNewStatementBefore(newst, stmt); - StatementCleaning(newst); - return(sf); -} - -void PrecalculateActualParameters(SgSymbol *s, SgExpression *e, SgStatement *stmt) -{// Precalculate actual parameter expressions - //e - actual parameter list - int i; - SgExpression *el; - SgSymbol *sp; - if (!e) return; - if (is_NoExpansionFunction(s)) return; // expansion may not be made - i = 1; - for (el = e; el; el = el->rhs(), i++) - switch (ParameterType(el->lhs(), stmt)) - { - case 1: break; //actual parameter can be accessed by reference - //case 2: PrecalculateSubscripts(el->lhs(),stmt); break; - default: sp = GetTempVarForArg(i, s, el->lhs()->type()); - PrecalculateExpression(sp, el->lhs(), stmt); //to support access by reference - el->setLhs(new SgVarRefExp(sp)); //replace actual parameter expression by 'sp' reference - break; - } -} - -void PrecalculateExpression(SgSymbol *sp, SgExpression *e, SgStatement *stmt) -{ - SgStatement *newst; - newst = new SgAssignStmt(*new SgVarRefExp(sp), *e); - InsertNewStatementBefore(newst, stmt); -} - - -int ParameterType(SgExpression *e, SgStatement *stmt) -{ - if (isSgVarRefExp(e) || // scalar variable - (isSgArrayRefExp(e) && !e->lhs()) || // array variable whithout subscript or string variable - e->variant() == CONST_REF || // symbol (named) constant - (isSgValueExp(e) && e->type()->variant() != T_STRING) || // literal constant - (isSgArrayRefExp(e) && TestSubscripts(e->lhs(), stmt)) || // array reference whose subscripts are constant or scalar - (e->variant() == ARRAY_OP && isSgVarRefExp(e->lhs()) && - TestRange(e->rhs(), stmt)) ||// substring reference whose subscripts are constant or scalar - (e->variant() == ARRAY_OP && isSgArrayRefExp(e->lhs()) - && TestSubscripts(e->lhs()->lhs(), stmt) - && TestRange(e->rhs(), stmt))) // substring reference whose subscripts are constant or scalar - return(1); // actual parameter can be accessed by reference - - // else if(isSgArrayRefExp(e)) - // return(2); - // else if(e->variant()==ARRAY_OP) - // return(3); - - else - return(0); // precalculation expression is needed to support access by reference -} - -int TestSubscripts(SgExpression *e, SgStatement *stmt) -{ - SgExpression *el, *ei; - //SgSymbol *sp; - for (el = e; el; el = el->rhs()) { - ei = el->lhs(); // a subscript - if (isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) // constant or scalar - continue; - else - //return(0); - {//sp=GetTempVarForSubscr(ei->type()); - //PrecalculateExpression(sp,ei,stmt); //to support access by reference - //el->setLhs(new SgVarRefExp(sp)); //replace subscript expression by 'sp' reference - continue; - } - } - return(1); -} - -int TestRange(SgExpression *e, SgStatement *stmt) -{ - SgExpression *ei; - SgSymbol *sp; - - int ret; - ret = 0; - //e->unparsestdout(); (e->lhs())->unparsestdout(); //(e->rhs())->unparsestdout(); - //printf(" testrange %d %d\n", e->variant(), (e->lhs())->variant()); - - ei = e->lhs(); - - if (!ei || isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) - ret = 1; - else - { - sp = GetTempVarForSubscr(ei->type()); - PrecalculateExpression(sp, ei, stmt); //to support access by reference - e->setLhs(new SgVarRefExp(sp)); //replace subrange expression by 'sp' reference - } - - ei = e->rhs(); - if (!ei || isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) - return(1); - else - //return(0); - { - sp = GetTempVarForSubscr(ei->type()); - PrecalculateExpression(sp, ei, stmt); //to support access by reference - e->setRhs(new SgVarRefExp(sp)); //replace subscript expression by 'sp' reference - return(1); - } - - return 1; -} - -void LabelList(SgStatement *header) -{ - SgStatement *last, *stmt; - - last = header->lastNodeOfStmt(); - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - { - if (stmt->hasLabel()) - proc_labels = addToLabelList(proc_labels, stmt->label()); - } -} - -void SetScopeToLabels(SgStatement *header) -{ - SgStatement *last, *stmt; - - last = header->lastNodeOfStmt(); - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - { - if (stmt->hasLabel()) - LABEL_SCOPE(stmt->label()->thelabel) = header->thebif; - } -} - - -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// I N L I N E E X P A N S I O N -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -SgStatement *InlineExpansion(graph_node *gtop, SgStatement *stmt, SgSymbol *sf, SgExpression *args) -// return next processed statement in top level routine: -// first of inline expansion statements (inserted in top level routine) -// or -// next statement following stmt in top level routine ( stmt->lexNext()), if it is not inlined call -{ - graph_node *gnode; - SgStatement *header_tmplt, *global_st, *header_work, *calling_stmt, *expanded_stmt; - SgSymbol *scopy; - SgLabel *lab; - /* - if(!(pnode = ATTR_NODE(sf))) - { printf("Error: NO ATTRIBUTE \n"); - return (stmt->lexNext()); - } else - gnode = *pnode; - if(!isInlinedCall(gtop,gnode)) - return(stmt->lexNext()); - */ - //gnode = getAttrNodeForSymbol(sf); - if (deb_reg > 1) - printf("INLINE EXPANSION %s \n", sf->identifier()); - if (!ATTR_NODE(sf)) // call without inline expansion (dummy argument, statement function) 15.03.07 - return(stmt->lexNext()); - gnode = getNodeForSymbol(gtop, sf->identifier()); - if (!gnode) - return(stmt->lexNext()); - if (deb_reg > 1) - printf("node %d for symbol %s\n", gnode->id, sf->identifier()); - //if(!isInlinedCallSite(stmt)) // if there is assertion (special comment) in program for call site - // return(stmt->lexNext()); - - (gnode->count)++; - // 1. if gnode is not template object - // create a template inline object by performing site-independent transformations - if (!gnode->tmplt) - header_tmplt = CreateTemplate(gnode); - - // 2. clone the "template" inline object to create work inline object: - // copying subprogram, inserting after global statement of file (in beginning of file) - global_st = gtop->file->firstStatement(); - top_global = global_st; - scopy = &((gnode->symb)->copySubprogram(*(global_st))); - header_work = scopy->body(); //global_st->lexNext(); - - -// 3. perform site_specific transformations - if (stmt->variant() == ASSIGN_STAT) - RemapFunctionResultVar(stmt->expr(0), scopy); - ConformActualAndFormalParameters(scopy, args, stmt); - - // 4. transform all references to subprogram variables to "top level" form - expanded_stmt = TranslateSubprogramReferences(header_work); - - // debugging - if (deb_reg > 1) - (gtop->file)->unparsestdout(); - if (deb_reg > 2) - { - printf("---------------------\n"); - expanded_stmt->unparsestdout(); - printf("---------------------\n"); - printf("\n"); - } - // 5. replace the calling statement in the "top level" routine by transformed statements - calling_stmt = stmt; - /* if(sf->variant() == FUNCTION_NAME) //calling_stmt->variant()==ASSIGN_STAT - { - newst = new SgAssignStmt(*stmt->expr(0),*new SgVarRefExp(sf) ); - InsertNewStatementAfter(newst,stmt,stmt->controlParent()); - } - */ - if (with_cmnt) - { - char *buf; - buf = stmt->lexNext()->comments(); - BIF_CMNT(stmt->lexNext()->thebif) = NULL; - Add_Comment(gnode, stmt->lexNext(), 1); - stmt->lexNext()->addComment(buf); - } - InsertBlockAfter(stmt, expanded_stmt, header_work); - - if (with_cmnt) - { - expanded_stmt->addComment(stmt->comments()); - Add_Comment(gnode, expanded_stmt, 0); - } - lab = (stmt->hasLabel()) ? stmt->label() : NULL; - if (lab) - { - if (expanded_stmt->hasLabel()) - InsertNewStatementBefore(new SgStatement(CONT_STAT), stmt); - else - BIF_LABEL(expanded_stmt->thebif) = lab->thelabel; - } - calling_stmt->extractStmt(); - - // temporary !!!! - // return(stmt->lexNext()); - - return(expanded_stmt); -} - -void Add_Comment(graph_node *g, SgStatement *stmt, int flag) -{ - char *buf; - buf = new char[80]; - if (!flag) - sprintf(buf, "!*********INLINE EXPANSION %s[%d]*********\n", g->symb->identifier(), g->count); - else - sprintf(buf, "!*********END OF EXPANSION %s[%d]*********\n", g->symb->identifier(), g->count); - stmt->addComment(buf); -} - - -graph_node *getNodeForSymbol(graph_node *gtop, char *name) -{ - edge *el; - graph_node *nd; - for (el = gtop->to_called; el; el = el->next) - { - if (!strcmp(el->to->symb->identifier(), name)) - return(el->to); - else if ((nd = getNodeForSymbol(el->to, name)) != 0) - return(nd); - } - return NULL; -} - -graph_node *getAttrNodeForSymbol(SgSymbol *sf) -{ - graph_node *gnode, **pnode; - if (!(pnode = ATTR_NODE(sf))) - { - printf("Warning: NO ATTRIBUTE FOR %s\n", sf->identifier()); - gnode = NULL; - } - else - gnode = *pnode; - return(gnode); -} - -int isInlinedCall(graph_node *gtop, graph_node *gnode) -{ - edge *edgl; - - // testing incoming edge list of called routine graph-node: gnode - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - if (edgl->from == gtop) //there is incoming edge: : gtop->[gnode] - return(1); - return(0); -} - -SgStatement * CreateTemplate(graph_node *gnode) -{ // Create a template inline object by performing site-independent transformations - gnode->tmplt = 1; - // routine cleaning - RoutineCleaning(gnode->st_header); - SetScopeToLabels(gnode->st_header); - // site-independent transformation - SiteIndependentTransformation(gnode); - if (deb_reg > 1) - printf("template for %s\n", gnode->st_header->symbol()->identifier()); - return(gnode->st_header); -} - -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// S I T E I N D E P E N D E N T T R A N S F O R M A T I O N S -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -void SiteIndependentTransformation(graph_node *gnode) //(SgStatement *header) - -{// Perform site-independent transformation - - SgStatement *last, *first_executable, *last_declaration, *stmt, *return_st, *prev; - SgStatement *header; - SgLabel *lab_return; - int has_return; - stmt_list *DATA_list = NULL; - header = gnode->st_header; - last = header->lastNodeOfStmt(); - first_executable = NULL; - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) { - first_executable = stmt; break; - } - //last_declaration = first_executable->lexPrev(); - - //---------------------------- - //Move all entry points to the top of the subprogram - for (stmt = first_executable; stmt && (stmt != last); stmt = stmt->lexNext()) - if (stmt->variant() == ENTRY_STAT) - MoveToTopOfRoutine(stmt, first_executable); - - //stmt_list *entryl; - //for(entryl=entryst_list; entryl; entryl=entryl->next) - // if(entryl->st->controlParent() == header) - // MoveToTop(entryl->st, first_executable); - // else - // continue; - -//---------------------------- -//Move all return points to the bottom of the subprogram - prev = last->lexPrev(); - return_st = NULL; - lab_return = NULL; - has_return = 0; - if (prev->variant() == RETURN_STAT && prev->controlParent()->variant() != LOGIF_NODE) - { - return_st = prev; - if (return_st->hasLabel()) - lab_return = return_st->label(); - } - if (!lab_return) - { - lab_return = NewLabel(); - SetScopeOfLabel(lab_return, header); - } - - for (stmt = first_executable; stmt && (stmt != return_st) && (stmt != last); stmt = stmt->lexNext()) - if (stmt->variant() == RETURN_STAT) - { - stmt = ReplaceByGoToBottomOfRoutine(stmt, lab_return); - has_return = 1; - } - if (has_return) - { - if (!return_st) - { - stmt = new SgStatement(CONT_STAT); - InsertNewStatementBefore(stmt, last); - stmt->setLabel(*lab_return); - } - else - { - return_st->setLabel(*lab_return); - ReplaceReturnByContinue(return_st); - } - } - else if (return_st) - ReplaceReturnByContinue(return_st); - - //---------------------------- - //Substitute all integer symbolic constants in subprogram - IntegerConstantSubstitution(header); - - //---------------------------- - //Move all FORMAT statements into the top level routine - format_labels = NULL; - for (stmt = header; stmt && (stmt != last); ) - if (stmt->variant() == FORMAT_STAT) - //MoveFormatToTopOfRoutine(stmt, last_declaration); - stmt = MoveFormatIntoTopLevel(stmt, gnode->clone); - else if (stmt->variant() == DATA_DECL) - { - DATA_list = addToStmtList(DATA_list, stmt); - stmt = stmt->lexNext(); - //!!!! - Error("DATA statement in procedure %s. Sorry, not implemented yet", header->symbol()->identifier(), 1, stmt); - } - else - stmt = stmt->lexNext(); - ReplaceFormatLabelsInStmts(header); - //---------------------------- - //Precalculate all of the subprogram's adjustable array bounds - last_declaration = first_executable->lexPrev(); - - AdjustableArrayBounds(header, last_declaration); - first_executable = last_declaration->lexNext(); - //---------------------------- - //Replace each reference to whole formal array in I/O statements - //by implied DO-loop - ReplaceWholeArrayRefInIOStmts(header); - //---------------------------- - //Remap all local subprogram variables by creating new unconflicting top level variables - top_symb_list = CreateListOfLocalVariables(top_header); - sub_symb_list = CreateListOfLocalVariables(header); - //PrintTopSymbList(); - - //PrintSymbList(sub_symb_list, header); - - - RemapConstants(header, first_executable); - RemapLocalVariables(header); - - //---------------------------- - //Remap COMMON bloks - CreateTopCommonBlockList(); - RemapCommonBlocks(header); - //---------------------------- - //Remap EQUIVALENCE blocks - //---------------------------- - //Move all DATA statements into top level routine - //DATA_list has been created: list of DATA statements - // internal form of DATA statement must be changed in parser and unparser - //if(DATA_list) // temporary !!! - //printf("There are DATA statements in procedure. Sorry, not implemented yet \n" ); - -} - -void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable) -{//Move entry point to the top of the subprogram - // generate GO TO statement (will be removed after expansion) - SgStatement *go_to; - SgLabel *entry_lab; - - if (!entrystmt->lexNext()->hasLabel()) - { - entry_lab = NewLabel(); - SetScopeOfLabel(entry_lab, entrystmt->controlParent()); - entrystmt->lexNext()->setLabel(*entry_lab); - } - else - entry_lab = entrystmt->lexNext()->label(); - go_to = new SgGotoStmt(*entry_lab); - entrystmt->extractStmt(); - InsertNewStatementBefore(entrystmt, first_executable); - InsertNewStatementAfter(go_to, entrystmt, entrystmt->controlParent()); -} - -//------------------------------------------------------------------------------------------- -SgStatement *ReplaceByGoToBottomOfRoutine(SgStatement *retstmt, SgLabel *lab_return) -{//Replace return point by goto to the bottom of the subprogram - // generate GO TO statement - SgStatement *go_to; - go_to = new SgGotoStmt(*lab_return); - InsertNewStatementBefore(go_to, retstmt); - retstmt->extractStmt(); - return(go_to); -} - -void ReplaceReturnByContinue(SgStatement *return_st) -{ - InsertNewStatementBefore(new SgStatement(CONT_STAT), return_st); - return_st->extractStmt(); -} - -//------------------------------------------------------------------------------------------- -void MoveFormatToTopOfRoutine(SgStatement *format_stmt, SgStatement *last_declaration) -{//Move FORMAT statements to the top of the subprogram - SgLabel *format_lab; - // SgLabel *label_insection[200]; - - if (format_stmt->hasLabel()) - { - format_lab = format_stmt->label(); - if (!TestFormatLabel(format_stmt->label())) - { - format_lab = NewLabel(); - format_stmt->setLabel(*format_lab); - } - format_stmt->extractStmt(); - InsertNewStatementAfter(format_stmt, last_declaration, last_declaration->controlParent()); - last_declaration = format_stmt; - } -} - -SgStatement *MoveFormatIntoTopLevel(SgStatement *format_stmt, int clone) -{ - SgStatement *next; - SgLabel *format_lab; - next = format_stmt->lexNext(); - format_lab = format_stmt->label(); - if (!clone && isLabelOfTop(format_stmt->label())) - { - if (deb_reg > 2) - printf("new label: %d -> ", (int)LABEL_STMTNO(format_lab->thelabel)); - format_labels = addToLabelList(format_labels, format_lab); - format_lab = NewLabel(); - format_stmt->setLabel(*format_lab); - format_labels->newlab = format_lab; - if (deb_reg > 2) - printf(" %d\n", (int)LABEL_STMTNO(format_lab->thelabel)); - } - - format_stmt->extractStmt(); - InsertNewStatementAfter(format_stmt, top_last_declaration, top_header); - SetScopeOfLabel(format_lab, top_header); - //top_last_declaration = format_stmt; - - return(next); -} - -label_list *addToLabelList(label_list *lablist, SgLabel *lab) -{ - // adding the label to the beginning of label list - - label_list * nl; - if (!lablist) { - lablist = new label_list; - lablist->lab = lab; - lablist->next = NULL; - } - else { - nl = new label_list; - nl->lab = lab; - nl->next = lablist; - lablist = nl; - } - return (lablist); -} - -int isInLabelList(SgLabel *lab, label_list *lablist) -{ - label_list *ll; - for (ll = lablist; ll; ll = ll->next) - if (LABEL_STMTNO(ll->lab->thelabel) == LABEL_STMTNO(lab->thelabel)) - return(1); - return(0); -} - -int isLabelOfTop(SgLabel *lab) -{ - return(isLabelWithScope(LABEL_STMTNO(lab->thelabel), top_header) != NULL); -} - -void ReplaceFormatLabelsInStmts(SgStatement *header) -{ - SgStatement *stmt, *last; - if (!format_labels) - return; - if (deb_reg > 2) - printf("replace format labels in %s\n", header->symbol()->identifier()); - last = header->lastNodeOfStmt(); - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - { - switch (stmt->variant()) - { - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - { SgKeywordValExp *kwe; - SgExpression *e, *ee, *el, *fmt; - fmt = NULL; - e = stmt->expr(1); // IO control list - if (e->variant() == SPEC_PAIR) - { - if (stmt->variant() == PRINT_STAT) - fmt = e; - else - { - kwe = isSgKeywordValExp(e->lhs()); - if (!kwe) - break; - if (!strcmp(kwe->value(), "fmt")) - fmt = e; - else - break;; - } - } - else if (e->variant() == EXPR_LIST) - { - for (el = e; el; el = el->rhs()) - { - ee = el->lhs(); - if (ee->variant() != SPEC_PAIR) - break; // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if (!kwe) - break; - if (!strcmp(kwe->value(), "fmt")) - { - fmt = ee; - break; - } - } - } - else - break; - - // analis fmt - { SgLabel *lab, *newlab; - lab = NULL; - if (deb_reg > 2) - printf("fmt variant %d\n", fmt->rhs()->variant()); - if (fmt && fmt->rhs()->variant() == LABEL_REF) - { - lab = ((SgLabelRefExp *)(fmt->rhs()))->label(); - if (deb_reg > 2) - printf("label [%d] \n", lab->id()); - } - else if (fmt && fmt->rhs()->variant() == INT_VAL) //!!!parser error - { - if (deb_reg > 2) - printf("variant fmt = %d %d\n", fmt->rhs()->variant(), ((SgValueExp *)(fmt->rhs()))->intValue()); - lab = isLabelWithScope(((SgValueExp *)(fmt->rhs()))->intValue(), header); - if (lab) - fmt->setRhs(new SgLabelRefExp(*lab)); - } - if (!lab) break; - //printf("label [%d] %d\ n",lab->id(),LABEL_STMTNO(lab->thelabel)); - // replace label in fmt->lhs() - if ((newlab = isInFormatMap(lab)) != NULL) - NODE_LABEL(fmt->rhs()->thellnd) = newlab->thelabel; - } - } - break; - default: - break; - } - } - return; -} - -SgLabel *isInFormatMap(SgLabel *lab) -{ - label_list *ll; - for (ll = format_labels; ll; ll = ll->next) - { - if (ll->lab == lab) - return(ll->newlab); - } - return(NULL); -} - -//------------------------------------------------------------------------------------------- -void AdjustableArrayBounds(SgStatement *header, SgStatement *after) -{ - int npar, i, j, rank; - SgExpression *bound; - SgSymbol *param; - - cur_func = header; - npar = ((SgProgHedrStmt *)header)->numberOfParameters(); - for (i = 0; i < npar; i++) - { - param = ((SgProgHedrStmt *)header)->parameter(i); - if (isSgArrayType(param->type())) // is array - { - rank = Rank(param); - for (j = 0; j < rank; j++) - { - if (isAdustableBound(bound = LowerBound(param, j))) - PrecalculateArrayBound(param, bound, after, header); - - if (isAdustableBound(bound = UpperBound(param, j))) - PrecalculateArrayBound(param, bound, after, header); - } //end for j - } - } // end for i -} - -int isAdustableBound(SgExpression *bound) -{ - if (!bound) - return 0; - if (bound->variant() == INT_VAL) - return 0; - return(SearchVarRef(bound)); -} - -int SearchVarRef(SgExpression *e) -{ - if (!e) - return 0; - if (isSgVarRefExp(e) && e->symbol()->variant() == VARIABLE_NAME) - return 1; - if (SearchVarRef(e->lhs()) || SearchVarRef(e->rhs())) - return 1; - else - return 0; -} -void PrecalculateArrayBound(SgSymbol *ar, SgExpression *bound, SgStatement *after, SgStatement *header) - -{ - SgStatement *newst; - SgSymbol *sb; - SgExpression **pbe = new (SgExpression *); - - sb = GetTempVarForBound(ar); - newst = new SgAssignStmt(*new SgVarRefExp(sb), bound->copy()); - InsertNewStatementAfter(newst, after, header); - *pbe = new SgVarRefExp(sb); - bound->addAttribute(PRE_BOUND, (void *)pbe, sizeof(SgExpression *)); - - return; -} - -//------------------------------------------------------------------------------------------- -void ReplaceWholeArrayRefInIOStmts(SgStatement *header) -{ - SgStatement *stmt, *last; - SgExpression *iol, *e; - - cur_func = header; - - last = header->lastNodeOfStmt(); - - for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) - { - switch (stmt->variant()) - { - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - iol = stmt->expr(0); //input-output list - for (; iol; iol = iol->rhs()) - { - e = iol->lhs(); // list item - if (isSgArrayRefExp(e) && isSgArrayType(e->symbol()->type()) && !e->lhs() && isDummyArgument(e->symbol())) //whole formal array ref - iol->setLhs(ImplicitLoop(e->symbol())); - } - break; - default: - break; - } - } //end for -} - - -SgExpression *ImplicitLoop(SgSymbol *ar) -{ - SgExpression *ei[10]; - SgArrayRefExp *eref; - int rank, i; - - rank = Rank(ar); - for (i = 0; i < rank; i++) - if (!do_var[i]) - { - do_var[i] = GetImplicitDoVar(i); - MakeDeclarationStmtInTop(do_var[i]); - } - //ei[0] = new SgIOAccessExp(*do_var[0], *LowerLoopBound(ar,0), *UpperLoopBound(ar,0)); - ei[0] = new SgExpression(IOACCESS); - ei[0]->setSymbol(do_var[0]); - ei[0]->setRhs(new SgExpression(SEQ, new SgExpression(DDOT, LowerLoopBound(ar, 0), UpperLoopBound(ar, 0), NULL), NULL, NULL)); - eref = new SgArrayRefExp(*ar); - for (i = 0; i < rank; i++) - eref->addSubscript(*new SgVarRefExp(do_var[i])); - ei[0]->setLhs(new SgExprListExp(*eref)); - - for (i = 1; i < rank; i++) - { //ei[i] = new SgIOAccessExp(*si[i], LowerBound(ar,i)->copy(), UpperBound(ar,i)->copy()); - ei[i] = new SgExpression(IOACCESS); - ei[i]->setSymbol(do_var[i]); - ei[i]->setRhs(new SgExpression(SEQ, new SgExpression(DDOT, LowerLoopBound(ar, i), UpperLoopBound(ar, i), NULL), NULL, NULL)); - ei[i]->setLhs(new SgExprListExp(*ei[i - 1])); - } - return(ei[rank - 1]); -} - -SgExpression * LowerLoopBound(SgSymbol *ar, int i) -{ - SgExpression *e; - e = LowerBound(ar, i); - if (PREBOUND(e)) - e = *PREBOUND(e); - return(&(e->copy())); -} - -SgExpression * UpperLoopBound(SgSymbol *ar, int i) -{ - SgExpression *e; - e = UpperBound(ar, i); - if (PREBOUND(e)) - e = *PREBOUND(e); - return(&(e->copy())); -} - - -//------------------------------------------------------------------------------------------- -void RemapConstants(SgStatement *header, SgStatement *first_exec) -{ - SgStatement *stmt; - common_list = common_list_l = NULL; - equiv_list = equiv_list_l = NULL; - for (stmt = header; stmt && (stmt != first_exec); stmt = stmt->lexNext()) - { - switch (stmt->variant()) - { - case PARAM_DECL: - {SgExpression *el; - for (el = stmt->expr(0); el; el = el->rhs()) - { - RemapLocalObject(el->lhs()->symbol()); - } - continue; - } - case COMM_STAT: - CommonBlockList(stmt); - continue; - case EQUI_STAT: - EquivBlockList(stmt); - continue; - - default: - continue; - } - } -} - -void RemapLocalVariables(SgStatement *header) -{ - SgSymbol *s; - for (s = sub_symb_list; s; s = NextSymbol(s)) - { //printf("*****%s\n",s->identifier()); - if (s->variant() == CONST_NAME) - continue; - if (IN_COMMON(s)) - continue; - - RemapLocalObject(s); - } -} - -/* -void RemapLocalVariables(SgStatement *header) -{ SgSymbol *symb_list, *s, *ts, *snew; - int is_in_top; - top_symb_list = CreateListOfLocalVariables(top_header); - symb_list = CreateListOfLocalVariables(header); - for(s=symb_list; s; s=NextSymbol(s) ) - { //printf("*****%s\n",s->identifier()); - RemapLocalObject(s); - if(isDummyArgument(s)) - continue; - if(s->variant() == CONST_NAME && s->type()->variant() == T_INT) - continue; - is_in_top = 0; - for(ts=top_symb_list; ts; ts=NextSymbol(ts) ) - { - if(!strcmp(s->identifier(),ts->identifier())) - {is_in_top = 1; break;} - } - if(is_in_top) - { - if((s->variant()==CONST_NAME) && (ts->variant()==CONST_NAME) && CompareConstants(s,ts)) // is the same constant - { s->thesymb->entry.Template.declared_name = ts->thesymb; // symbol map - continue; - } - else - { snew = GetNewTopSymbol(s); //create new symbol of top_header scope - s->thesymb->entry.Template.declared_name = snew->thesymb; // symbol map - } - } - else - { snew = s; - SYMB_SCOPE(snew->thesymb) = top_header->thebif; //move symbol into top level routine - } - if(snew->variant() == CONST_NAME) - MakeDeclarationStmtsForConstant(snew); - else - MakeDeclarationStmtInTop(snew); - - } - -} -*/ - -void RemapLocalObject(SgSymbol *s) -{ - int is_in_top, md; - SgSymbol *ts, *snew; - - if (isDummyArgument(s)) - return; - if (s->variant() == CONST_NAME && s->type()->variant() == T_INT) - return; - if (s->variant() == CONST_NAME) - TranslateExpression(((SgConstantSymb *)s)->constantValue(), &md); - - is_in_top = 0; - for (ts = top_symb_list; ts; ts = NextSymbol(ts)) - { - if (!strcmp(s->identifier(), ts->identifier())) - { - is_in_top = 1; break; - } - } - if (is_in_top) - { - if ((s->variant() == CONST_NAME) && (ts->variant() == CONST_NAME) && CompareConstants(s, ts)) // is the same constant - { - s->thesymb->entry.Template.declared_name = ts->thesymb; // symbol map - return; - } - else - { - snew = GetNewTopSymbol(s); //create new symbol of top_header scope - s->thesymb->entry.Template.declared_name = snew->thesymb; // symbol map - } - } - else - { - snew = s; - SYMB_SCOPE(snew->thesymb) = top_header->thebif; //move symbol into top level routine - } - if (snew->variant() == CONST_NAME) - MakeDeclarationStmtsForConstant(snew); - else - MakeDeclarationStmtInTop(snew); - -} - -void RemapCommonObject(SgSymbol *s, SgSymbol *tops) -{ - s->thesymb->entry.Template.declared_name = tops->thesymb; // symbol map -} - -SgSymbol *CreateListOfLocalVariables(SgStatement *header) -{ - SgSymbol *s, *first, *symb_list; - //first = header->symbol(); - first = (header == top_header) ? top_node->file->firstSymbol() : header->symbol(); - symb_list = NULL; - for (s = first; s; s = s->next()) - if (SYMB_SCOPE(s->thesymb) == header->thebif) //if( s->scope() == header ) - { - SYMB_LIST(s->thesymb) = symb_list ? symb_list->thesymb : NULL; //s->thesymb->id_list - symb_list = s; - } - - return symb_list; -} - -SgSymbol *NextSymbol(SgSymbol *s) -{ - return(SymbMapping(SYMB_LIST(s->thesymb))); -} - -void MakeDeclarationStmtInTop(SgSymbol *s) -{ - SgStatement *st; - st = s->makeVarDeclStmt(); -#if __SPF - insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL); -#else - top_last_declaration->insertStmtAfter(*st); -#endif - top_last_declaration = st; - if (IS_ALLOCATABLE(s)) { - SgDeclarationStatement *allocatableStmt = new SgDeclarationStatement(ALLOCATABLE_STMT); - SgVarRefExp *expr = new SgVarRefExp(s); - SgExprListExp *list = new SgExprListExp(*expr); - allocatableStmt->setExpression(0, *list); -#if __SPF - BIF_CP(allocatableStmt->thebif) = top_last_declaration->controlParent()->thebif; -#else - allocatableStmt->setControlParent(top_last_declaration->controlParent()); -#endif - -#if __SPF - insertBfndListIn(allocatableStmt->thebif, top_last_declaration->thebif, NULL); -#else - top_last_declaration->insertStmtAfter(*allocatableStmt); -#endif - top_last_declaration = allocatableStmt; - } -} -void MakeDeclarationStmtsForConstant(SgSymbol *s) -{ - SgStatement *st; - SgExpression *eel; - st = new SgStatement(PARAM_DECL); - eel = new SgExprListExp(*new SgRefExp(CONST_REF, *((SgConstantSymb *)s))); - eel->setRhs(NULL); - st->setExpression(0, *eel); -#if __SPF - insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL); -#else - top_last_declaration->insertStmtAfter(*st); -#endif - //top_header -> insertStmtAfter(*st); - st = s->makeVarDeclStmt(); - //top_header -> insertStmtAfter(*st); -#if __SPF - insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL); -#else - top_last_declaration->insertStmtAfter(*st); -#endif - top_last_declaration = st->lexNext(); -} -// SgConstantSymb * sc = isSgConstantSymb(e->symbol()); -// return(ReplaceIntegerParameter(&(sc->constantValue()->copy()))); - -int CompareConstants(SgSymbol *rs, SgSymbol *ts) -{ - PTR_LLND cers, cets; - int ic; - cers = SYMB_VAL(rs->thesymb); - cets = SYMB_VAL(ts->thesymb); - if (cers->variant != cets->variant) - return(0); - - /* - if(cers->variant==FLOAT_VAL || cers->variant==DOUBLE_VAL || cers->variant==STRING_VAL) - { if(!strcmp(NODE_STR(cers),NODE_STR(cets)) ) - return(1); - else - return(0); - } - if(cers->variant==COMPLEX_VAL) { - int icm; - icm = CompareConstants(NODE_TEMPLATE_LL1(cers)) && CompareConstants(cers->rhs()); - return(icm); - } - if(cers->variant==BOOL_VAL) - if(NODE_BV(cers) == NODE_BV(cets)) - return(1); - else - return(0); - return(0); - */ - - ic = 0; - switch (cers->variant) - { - case (FLOAT_VAL): - case (DOUBLE_VAL): - case (STRING_VAL): - if (!strcmp(NODE_STR(cers), NODE_STR(cets))) - ic = 1; - break; - case (BOOL_VAL): - if (NODE_BV(cers) == NODE_BV(cets)) - ic = 1;; - break; - case (COMPLEX_VAL): - ic = CompareValues(NODE_TEMPLATE_LL1(cers), NODE_TEMPLATE_LL1(cets)) && CompareValues(NODE_TEMPLATE_LL2(cers), NODE_TEMPLATE_LL2(cets)); - break; - default: - break; - } - return (ic); -} - -int CompareValues(PTR_LLND pe1, PTR_LLND pe2) -{ - if (pe1->variant != pe2->variant) - return(0); - if ((pe1->variant != FLOAT_VAL) && (pe1->variant != DOUBLE_VAL)) - return(0); - if (!strcmp(NODE_STR(pe1), NODE_STR(pe2))) - return(1); - return(0); -} - -void CommonBlockList(SgStatement *stmt) -{ - SgExpression *ec, *el; - SgSymbol *sc; - for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through COMM_LIST - { //if(isInCommonList(common_list->block->symbol(),common_list) - common_list_l = AddToBlockList(common_list_l, ec); - if (!common_list) common_list = common_list_l; - for (el = ec->lhs(); el; el = el->rhs()) - { - sc = el->lhs()->symbol(); - //if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) ) - // el->lhs()->setLhs(NULL); - if (sc) - SYMB_ATTR(sc->thesymb) = SYMB_ATTR(sc->thesymb) | COMMON_BIT; - } - } -} - -void TopCommonBlockList(SgStatement *stmt) -{ - SgExpression *ec, *el; - SgSymbol *sc; - for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through COMM_LIST - { - top_common_list_l = AddToBlockList(top_common_list_l, ec); - if (!top_common_list) top_common_list = top_common_list_l; - for (el = ec->lhs(); el; el = el->rhs()) - { - sc = el->lhs()->symbol(); - //if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) ) - // el->lhs()->setLhs(NULL); - if (sc) - SYMB_ATTR(sc->thesymb) = SYMB_ATTR(sc->thesymb) | COMMON_BIT; - } - } -} - -void CreateTopCommonBlockList() -{ - SgStatement *stmt; - top_common_list = top_common_list_l = NULL; - top_equiv_list = top_equiv_list_l = NULL; - for (stmt = top_header; stmt && (stmt != top_first_executable); stmt = stmt->lexNext()) - { - switch (stmt->variant()) - { - case COMM_STAT: - TopCommonBlockList(stmt); - continue; - case EQUI_STAT: - //TopEquivBlockList(stmt); - continue; - - default: - continue; - } - } -} - - -block_list *AddToBlockList(block_list *blist_last, SgExpression *eb) -{ - block_list * bl; - bl = new block_list; - bl->block = eb; - bl->next = NULL; - if (!blist_last) { - blist_last = bl; - } - else { - blist_last->next = bl; - blist_last = bl; - } - return(blist_last); -} - -void EquivBlockList(SgStatement *stmt) -{ - SgExpression *ec; - // SgSymbol *sc; - for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through LIST - { - equiv_list_l = AddToBlockList(equiv_list_l, ec); - if (!equiv_list) equiv_list = equiv_list_l; - } -} - -void RemapCommonBlocks(SgStatement *header) -{ - block_list *bl, *topbl; - SgStatement *com; - SgExpression *tl, *rl; - SgSymbol *tops = NULL; - //int md[1]; - // for each subprogram COMMON block - for (bl = common_list; bl; bl = bl->next) - if (!(topbl = isConflictingCommon(bl->block->symbol()))) //unconflicting common - { //bl->block->lhs()->unparsestdout(); - RemapCommonList(bl->block->lhs()); - EditExpressionList(bl->block->lhs()); - TranslateExpressionList(bl->block->lhs()); - //bl->block->lhs()->unparsestdout(); - com = DeclaringCommonBlock(bl->block); //creating new COMMON statement and inserting one in top routine -#if __SPF - insertBfndListIn(com->thebif, top_last_declaration->thebif, NULL); -#else - top_last_declaration->insertStmtAfter(*com); -#endif - top_last_declaration = com; - } - else - { - tl = topbl->block->lhs(); - rl = bl->block->lhs(); - while (tl && rl) - { - if (!areOfSameType(tl->lhs()->symbol(), rl->lhs()->symbol())) - { - Error("COMMON block in procedure %s with unconformable reference. Sorry, not implemented yet", header->symbol()->identifier(), 1, header); //tops = generate an equivalenced top level variable - printf("%s %s\n", tl->lhs()->symbol()->identifier(), rl->lhs()->symbol()->identifier()); - } - else - tops = tl->lhs()->symbol(); - RemapCommonObject(rl->lhs()->symbol(), tops); //!!! remake after realizing CalculateTopLevelRef() - CalculateTopLevelRef(tops, tl->lhs(), rl->lhs()); - MakeRefsConformable(tl->lhs(), rl->lhs()); - tl = tl->rhs(); - rl = rl->rhs(); - } - } -} -void RemapCommonList(SgExpression *el) -{ - SgExpression *coml; - coml = el; - while (coml) - { - RemapLocalObject(coml->lhs()->symbol()); - coml = coml->rhs(); - } -} - -int areOfSameType(SgSymbol *st, SgSymbol *sr) -{ - int res; - SgType *tt, *rt; - tt = BaseType(st->type()); - rt = BaseType(sr->type()); - res = tt->variant() == rt->variant() && TypeSize(tt) && TypeSize(tt) == TypeSize(rt); - return(res); -} - -int IntrinsicTypeSize(SgType *t) -{ - switch (t->variant()) { - case T_INT: - case T_BOOL: return (4); - case T_FLOAT: return (4); - case T_COMPLEX: return (8); - case T_DOUBLE: return (8); - - case T_DCOMPLEX: return(16); - - case T_STRING: - case T_CHAR: - return(1); - default: - return(0); - } -} - -int TypeSize(SgType *t) -{ - //SgExpression *le; - int len; - if (!TYPE_RANGES(t->thetype) && !TYPE_KIND_LEN(t->thetype)) return (IntrinsicTypeSize(t)); - - if ((len = TypeLength(t))) return(len); - - //le = TypeLengthExpr(t); - //if(le->isInteger()){ - // len = le->valueInteger(); - // len = len < 0 ? 0 : len; //according to standard F90 - //} else - // len = -1; //may be error situation - - return(0); -} - -int TypeLength(SgType *t) -{ - SgExpression *le; - SgValueExp *ve; - //if(t->variant() == T_STRING) return (0); - if (TYPE_RANGES(t->thetype)) { - le = t->length(); - if ((ve = isSgValueExp(le))) - return (ve->intValue()); - else - return (0); - } - if (TYPE_KIND_LEN(t->thetype)) { /*22.04.14*/ - le = t->selector()->lhs(); - if ((ve = isSgValueExp(le))) - if (t->variant() == T_COMPLEX || t->variant() == T_DCOMPLEX) - return (2 * ve->intValue()); - else - return (ve->intValue()); - else - return (0); - } - - return(0); -} - -SgType *BaseType(SgType *type) -{ - return (isSgArrayType(type) ? type->baseType() : type); -} - -int isUnconflictingCommon(SgSymbol *s) -{ - block_list *bl; - for (bl = top_common_list; bl; bl = bl->next) - if (bl->block->symbol() == s) - return(0); - return(1); -} - -block_list *isConflictingCommon(SgSymbol *s) -{ - block_list *bl; - //printSymb(s); - //printf(" variant %d\n",s->variant()); - for (bl = top_common_list; bl; bl = bl->next) { - //if(bl && bl->block ) printSymb(bl->block->symbol()); - if (bl->block->symbol() == s) - return(bl); - } - //printf("NO\n"); - return(NULL); -} - -block_list *isInCommonList(SgSymbol *s, block_list *blc) -{ - block_list *bl; - for (bl = blc; bl; bl = bl->next) - if (bl->block->symbol() == s) - return(bl); - return(NULL); -} - - -SgStatement *DeclaringCommonBlock(SgExpression *bl) -{ - SgStatement *com; - //SgExpression *eeq; - // eeq = new SgExpression (COMM_LIST); - // eeq -> setSymbol(*bl->symbol()); - // eeq -> setLhs(*bl->lhs()); - // com = new SgStatement(COMM_STAT); - // com->setExpression(0,*eeq); - com = new SgStatement(COMM_STAT); - com->setExpression(0, *bl); - - return(com); -} -//------------------------------------------------------------------------------------------- - - - -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// S I T E - S P E C I F I C T R A N S F O R M A T I O N S -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -void RemapFunctionResultVar(SgExpression *topref, SgSymbol *sf) -{ - SgSymbol *topvar; - topvar = topref->symbol(); - sf->thesymb->entry.Template.declared_name = topvar->thesymb; // symbol map - if (isSgArrayRefExp(topref) && topref->lhs()) - sf->addAttribute(ARRAY_MAP_1, (void *)topref, 0); -} - -void ConformActualAndFormalParameters(SgSymbol *scopy, SgExpression *args, SgStatement *parentSt) -{ - PTR_SYMB dummy; - SgSymbol *darg; - SgExpression *fact, *farglist; - //int cnf_type; - int adj; - adj = 0; - farglist = args; - dummy = scopy->thesymb->entry.proc_decl.in_list; - /* - if(!dummy) return; - printf("dummy of %s: %s\n",scopy->identifier(),dummy->ident); - next = dummy->entry.var_decl.next_in ; - while(next) - { //if(!next) return; - printf("dummy of %s: %s\n",scopy->identifier(),next->ident); - next = next->entry.var_decl.next_in ; - } - */ - - - // alternative return, dummy is *, represented by symbol with kind DEFAULT and name "*" !!!!???? - - while (dummy && farglist) - { // printf("dummy of %s: %s\n",scopy->identifier(),dummy->ident); - fact = farglist->lhs(); - darg = SymbMapping(dummy); - if (isAdjustableArray(darg)) - { - adj = 1; - darg->addAttribute(ADJUSTABLE_, (void *)fact, 0); - } - else - ConformReferences(darg, fact, parentSt); - dummy = dummy->entry.var_decl.next_in; - farglist = farglist->rhs(); - } - dummy = scopy->thesymb->entry.proc_decl.in_list; - while (adj && dummy) - { - darg = SymbMapping(dummy); - if ((fact = ADJUSTABLE(darg))) - { - TranslateArrayTypeExpressions(darg); - ConformReferences(darg, fact, parentSt); - } - dummy = dummy->entry.var_decl.next_in; - } - -} - -void ConformReferences(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt) -{ - int cnf_type; - - cnf_type = TestConformability(darg, fact, parentSt); - if (!cnf_type) - { - Error("Non conformable %s. Case not implemented yet", darg->identifier(), 1, parentSt); // not realized - //fact->unparsestdout(); printf("\n"); darg->scope()->unparsestdout(); - if (deb_reg) - printf("Non conformable. Case not implemented yet\n"); - } - - switch (cnf_type) - { - case _IDENTICAL_: - darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; - break; - - case SCALAR_ARRAYREF: - darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; - darg->addAttribute(ARRAY_MAP_1, (void *)fact, 0); - break; - - case _SUBARRAY_: - darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; - darg->addAttribute(ARRAY_MAP_1, (void *)(fact->lhs()), 0); - break; - case _CONSTANT_: - darg->addAttribute(CONSTANT_MAP, (void *)fact, 0); - break; - case VECTOR_ARRAYREF: - darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; - //if(fact->lhs()->lhs()) - darg->addAttribute(ARRAY_MAP_2, (void *)(fact->lhs()), 0); - break; - case _ARRAY_: - break; - } -} - -int isAdjustableArray(SgSymbol *param) -{ - int rank, j; - if (!isSgArrayType(param->type())) - return(0); - rank = Rank(param); - for (j = 0; j < rank; j++) - { - if (isAdustableBound(LowerBound(param, j))) - return(1);; - - if (isAdustableBound(UpperBound(param, j))) - return(1);; - } - return(0); -} - -SgSymbol *FirstDummy(SgSymbol *sf) -{ - return(SymbMapping(sf->thesymb->entry.proc_decl.in_list)); -} - - -SgSymbol *NextDummy(SgSymbol *s) -{ - return(SymbMapping(s->thesymb->entry.var_decl.next_in)); -} - -int TestConformability(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt) -{ - SgArrayType *ftp; - - if (isFormalProcedure(darg)) - return(_IDENTICAL_); - - if (!SameType(darg, fact)) - return(NON_CONFORMABLE); - - if (isSgValueExp(fact)) - return(_CONSTANT_); - - if (isScalar(darg)) - { //printf("scalar %s(%d): %s\n", darg->identifier(),darg->variant(),fact->symbol()->identifier()); - if (isSgArrayRefExp(fact) && fact->lhs() && !isSgArrayType(fact->type())) - return(SCALAR_ARRAYREF); - else - return(_IDENTICAL_); - } - - if (isArray(darg)) - { //printf("array %s(%d): %s\n", darg->identifier(),darg->variant(),fact->symbol()->identifier()); - if ((ftp = isSgArrayType(fact->symbol()->type())) && fact->lhs() && TestShapes(ftp, (SgArrayType *)(darg->type())) && TestBounds(fact, ftp, (SgArrayType *)(darg->type()))) - return(_SUBARRAY_); - if ((ftp = isSgArrayType(fact->symbol()->type())) && fact->lhs() && TestVector(fact, ftp, (SgArrayType *)(darg->type()))) - return(VECTOR_ARRAYREF); - - if ((ftp = isSgArrayType(fact->symbol()->type())) && !fact->lhs() && SameShapes(ftp, (SgArrayType *)(darg->type()))) - return(_IDENTICAL_); - - } - Error("TestConformability(%s,...). Case not implemented yet", darg->identifier(), 1, parentSt); - if (deb_reg) - printf("TestConformability(). Case not implemented yet\n"); - return(NON_CONFORMABLE); -} - -int SameType(SgSymbol *darg, SgExpression *fact) -{ - SgType *dtype, *fact_type, *fstype; - SgSymbol *fsymb; - dtype = darg->type(); - if (isSgArrayType(dtype)) - dtype = dtype->baseType(); - fact_type = fact->type(); - fsymb = fact->symbol(); - - // if(isSgVarRefExp(fact) && !isSgArrayType(fact->symbol()->type()) && - // Same(dtype,fact->symbol()->type()) - // return(1); - - //if(isScalar(darg) && !isSgArrayType(fact->type())) - { if (isSgVarRefExp(fact) || fact->variant() == CONST_REF) - return(Same(fsymb->type(), dtype)); - if (isSgArrayRefExp(fact) && isSgArrayType(fsymb->type())) - return(Same(fsymb->type()->baseType(), dtype)); - if (isSgValueExp(fact)) - return(Same(fact->type(), dtype)); - if (isSgArrayRefExp(fact) && fsymb->type()->variant() == T_STRING) - return(Same(fsymb->type(), dtype)); - if (fact->variant() == ARRAY_OP) - { - if (isSgArrayType(fstype = fact->lhs()->symbol()->type())) - fstype = fstype->baseType(); - return(Same(fstype, dtype)); - } - } - ////!!!!!!! - return(0); -} - -int Same(SgType *ft, SgType *dt) -{ - //TYPE_RANGES((T)->thetype) - - if (!ft || !dt) - return(1); - if ((dt->variant() == T_STRING) != 0) - { - if (ft->variant() == dt->variant()) - return(1); - else - return(0); - } - - if (ft->variant() == dt->variant() && TypeSize(ft) && TypeSize(ft) == TypeSize(dt)) - return(1); - - if (ft->variant() == T_DOUBLE && dt->variant() == T_FLOAT && TypeSize(ft) == TypeSize(dt)) - return(1); - if (dt->variant() == T_DOUBLE && ft->variant() == T_FLOAT && TypeSize(ft) == TypeSize(dt)) - return(1); - - if (ft->variant() == T_DCOMPLEX && dt->variant() == T_COMPLEX && TypeSize(ft) == TypeSize(dt)) - return(1); - if (dt->variant() == T_DCOMPLEX && ft->variant() == T_COMPLEX && TypeSize(ft) == TypeSize(dt)) - return(1); - return(0); - - //return(1); // temporary!!!! -} - -int isScalar(SgSymbol *symb) -{ - if ((symb->variant() == VARIABLE_NAME) && !isSgArrayType(symb->type())) - return(1); - else - return(0); -} - -int isArray(SgSymbol *symb) -{ - if ((symb->variant() == VARIABLE_NAME) && isSgArrayType(symb->type())) - return(1); - else - return(0); -} - -int isFormalProcedure(SgSymbol *symb) -{ - switch (symb->variant()) - { - case PROCEDURE_NAME: - case FUNCTION_NAME: - case ROUTINE_NAME: - return(1); - default: - return(0); - } -} - -/* -int TestShapes(SgArrayType *ftp, SgArrayType *dtp) -{SgExpression *fe, *de; - - if(dtp && dtp->dimension() == 1 && ftp->dimension() > 1 && IdenticalValues((fe=ftp->sizeInDim(0)),(de=dtp->sizeInDim(0))) && IdenticalValues(LowerBoundOfDim(fe),LowerBoundOfDim(de)) ) - return(1); - else - return(0); -} -*/ - -int TestShapes(SgArrayType *ftp, SgArrayType *dtp) -{ - SgExpression *fe, *de; - int rank, i; - if (!dtp || !ftp) return(0); - rank = dtp->dimension(); - if (rank > ftp->dimension()) - return(0); - - for (i = 0; i < rank; i++) - { - fe = ftp->sizeInDim(i); - de = dtp->sizeInDim(i); - if (!SameDims(fe, de)) - return(0); - } - return(1); -} - -int TestBounds(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp) -{ - SgExpression *fe, *fl; - int rank, i; - if (!dtp || !ftp) return(0); - rank = dtp->dimension(); - fl = fact->lhs(); - for (i = 0; i < rank; i++, fl = fl->rhs()) - { - fe = ftp->sizeInDim(i); - if (!isSgSubscriptExp(fe) && fl->lhs()->isInteger() && fl->lhs()->valueInteger() == 1) - continue; - if (IdenticalValues(fl->lhs(), LowerBoundOfDim(fe))) - continue; - else - return(0); - } - return(1); -} - -int TestVector(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp) -{//SgExpression *fe, *de, *e1; - int rank; - if (!dtp || !ftp) return(0); - rank = dtp->dimension(); - if (rank > 1) return(0); - //fl = fact->lhs(); - //de=dtp->sizeInDim(0); - //fe=ftp->sizeInDim(0); - /* e1=&(*(fl->lhs()) - (LowerBoundOfDim(de)->copy())); - fl->setLhs(e1); - if(e1->isInteger() && e1->valueInteger()==0) - fl->setLhs(NULL); - */ - return(1); -} - - -int SameDims(SgExpression *fe, SgExpression *de) -{ - if (isSgSubscriptExp(fe) || isSgSubscriptExp(de)) - { - if (!IdenticalValues(LowerBoundOfDim(fe), LowerBoundOfDim(de))) - return(0); - } - if (!IdenticalValues(UpperBoundOfDim(fe), UpperBoundOfDim(de))) - return(0); - - return(1); -} - - -int SameShapes(SgArrayType *ftp, SgArrayType *dtp) -{ - SgExpression *fe, *de; - int rank, i; - if (!dtp || !ftp) return(0); - rank = dtp->dimension(); - if (rank != ftp->dimension()) - return(0); - - for (i = 0; i < rank; i++) - { - fe = ftp->sizeInDim(i); - de = dtp->sizeInDim(i); - if (isSgSubscriptExp(fe) || isSgSubscriptExp(de)) - { - if (!IdenticalValues(LowerBoundOfDim(fe), LowerBoundOfDim(de))) - return(0); - } - if (i < rank - 1 && !IdenticalValues(UpperBoundOfDim(fe), UpperBoundOfDim(de))) - return(0); - } - return(1); -} - -SgExpression *LowerBoundOfDim(SgExpression *e) -// lower bound of dimension e -{ - SgSubscriptExp *sbe; - - if (!e) - return(NULL); - - if ((sbe = isSgSubscriptExp(e)) != NULL) { - if (sbe->lbound()) - return(sbe->lbound()); - else - return(new SgValueExp(1)); - } - else - return(new SgValueExp(1)); // by default lower bound = 1 -} - -SgExpression *UpperBoundOfDim(SgExpression *e) -// upper bound of dimension e -{ - SgSubscriptExp *sbe; - - if (!e) - return(NULL); - if ((sbe = isSgSubscriptExp(e)) != NULL) { - if (sbe->ubound()) - return(sbe->ubound()); - } - return(e); - -} - - -SgExpression *FirstIndexChange(SgExpression *e, SgExpression *index) -{ //SgExpression *e0; - //e0 = e->lhs(); - if (!index) - return(e); - e->setLhs(index->copy()); - return(e); -} - -SgExpression *IndexChange(SgExpression *e, SgExpression *index, SgExpression *lbe) -{ - SgExpression *e0; - int iv; - if (!index) - return(e); - //e->setLhs(index->copy()+*(e->lhs())-lbe->copy()); - - e0 = &(*(e->lhs()) - lbe->copy()); - - if (e0->isInteger()) - { - if ((iv = e0->valueInteger()) == 0) - e->setLhs(index->copy()); - else - e->setLhs(index->copy() + *new SgValueExp(iv)); - } - else - e->setLhs(index->copy() + *e0); - return(e); -} - -SgExpression *FirstIndexesChange(SgExpression *mape, SgExpression *re) -{ - SgExpression *el, *mel; - for (el = re, mel = mape; el; el = el->rhs(), mel = mel->rhs()) - mel->setLhs(el->lhs()); - return(mape); -} - - - -int IdenticalValues(SgExpression *e1, SgExpression *e2) -{ - //return(ExpCompare(Calculate(e1), Calculate(e2))); - if (!e1 || !e2) - return(0); - if (e1->isInteger() && e2->isInteger()) - { - if (e1->valueInteger() == e2->valueInteger()) - return(1); - else - return(0); - } - else - return(0); -} - -void TranslateArrayTypeExpressions(SgSymbol *darg) -{ - SgArrayType *arrtype; - SgExpression *el; - int rank, md; - arrtype = isSgArrayType(darg->type()); - rank = arrtype->dimension(); - el = arrtype->getDimList(); - TranslateExpression(el, &md); - -} - -SgStatement *TranslateSubprogramReferences(SgStatement *header) -{ - SgStatement *stmt, *last, *first_executable = NULL, *last_decl; - SgSymbol *s_top; - int mdfd[3]; - last = header->lastNodeOfStmt(); - cur_func = top_header; - for (stmt = header->lexNext(); stmt && (stmt != last); stmt = stmt->lexNext()) - if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) { - first_executable = stmt; break; - } - last_decl = stmt->lexPrev(); - for (stmt = first_executable; stmt && (stmt != last); stmt = stmt->lexNext()) - { - mdfd[0] = mdfd[1] = mdfd[2] = 0; //modified=0; - switch (stmt->variant()) - { - /* case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - break; - */ - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - //mdfd[0]=mdfd[1]=0; //modified=0; - if (stmt->expr(1)) - stmt->setExpression(1, *TranslateExpression(stmt->expr(1), &mdfd[1])); - if (stmt->expr(0)) - stmt->setExpression(0, *TranslateExpression(stmt->expr(0), &mdfd[0])); - if (mdfd[0] || mdfd[1]) - StatementCleaning(stmt); - continue; - - case FOR_NODE: - case PROC_STAT: - if ((s_top = SymbolMap(stmt->symbol())) != 0) - { - stmt->setSymbol(*s_top); - if (stmt->variant() == PROC_STAT) - mdfd[0] = 1; - } - - default: - //mdfd[0]=mdfd[1]=mdfd[2]=0; //modified=0; - if (stmt->expr(0)) - stmt->setExpression(0, *TranslateExpression(stmt->expr(0), &mdfd[0])); - if (stmt->expr(1)) - stmt->setExpression(1, *TranslateExpression(stmt->expr(1), &mdfd[1])); - if (stmt->expr(2)) - stmt->setExpression(2, *TranslateExpression(stmt->expr(2), &mdfd[2])); - if (mdfd[0] || mdfd[1] || mdfd[2]) - StatementCleaning(stmt); - continue; - } - - } - return(last_decl->lexNext()); -} - -SgExpression *TranslateExpression(SgExpression *e, int *md) -{ - SgExpression *el, *aref, *cref; - SgSymbol *s_top, *s; - if (!e) - return(e); - - if (isSgArrayRefExp(e)) - { - for (el = e->lhs(); el; el = el->rhs()) - el->setLhs(TranslateExpression(el->lhs(), md)); - s = e->symbol(); - /* if((s_top=SymbolMap(s))) - if(!(aref=ArrayMap(s))) - e->setSymbol(s_top); - else if(aref->variant() == EXPR_LIST) - { e->setSymbol(s_top); - e->setLhs(FirstIndexesChange(&(aref->copy()),e->lhs())); - *md = 1; - } - */ - if ((s_top = SymbolMap(s))) - e->setSymbol(s_top); - if ((aref = ArrayMap(s)) && (aref->variant() == EXPR_LIST)) - { - e->setLhs(FirstIndexesChange(&(aref->copy()), e->lhs())); - *md = 1; - } - if ((aref = ARRAYMAP2(s))) - { - e->setLhs(IndexChange(&(aref->copy()), e->lhs(), LowerBound(s, 0))); - *md = 1; - } - return(e); - } - //if(e->variant()==ARRAY_OP) - // ; - if (isSgVarRefExp(e)) - { - s = e->symbol(); - //if((s_top=SymbolMap(s)) && !ArrayMap(s)) - // e->setSymbol(s_top); - if ((s_top = SymbolMap(s)) != 0) - { - if (!(aref = ArrayMap(s))) - e->setSymbol(s_top); - else //if(aref->variant() == ARRAY_REF) - { - NODE_CODE(e->thellnd) = ARRAY_REF; //e->setVariant(ARRAY_REF); - e->setSymbol(s_top); - e->setLhs(aref->lhs()->copy()); - } - } - - if ((cref = CONSTANTMAP(s))) - { - return(&(cref->copy())); - } - - return(e); - } - - if (e->variant() == CONST_REF) - { - s = e->symbol(); - if ((s_top = SymbolMap(s))) - e->setSymbol(s_top); - return(e); - } - - - if (isSgFunctionCallExp(e)) - { - s = e->symbol(); - if ((s_top = SymbolMap(s))) - { - e->setSymbol(s_top); - *md = 1; - } - } - - e->setLhs(TranslateExpression(e->lhs(), md)); - e->setRhs(TranslateExpression(e->rhs(), md)); - return(e); -} - - -/* -void TranslateExpression(SgExpression *e, int *md) -{ SgExpression *el, *aref; - SgSymbol *s_top, *s; - if(!e) - return; - if(isSgArrayRefExp(e)) - { - for(el=e->lhs();el;el=el->rhs()) - TranslateExpression(el->lhs(),md); - s= e->symbol(); - if((s_top=SymbolMap(s))) - if(!(aref=ArrayMap(s))) - e->setSymbol(s_top); - else if(aref->variant() == EXPR_LIST) - { e->setSymbol(s_top); - e->setLhs(FirstIndexChange(&(aref->copy()),e->lhs()->lhs())); - *md = 1; - } - return; - } - //if(e->variant()==ARRAY_OP) - // ; - if(isSgVarRefExp(e)) - { s= e->symbol(); - //if((s_top=SymbolMap(s)) && !ArrayMap(s)) - // e->setSymbol(s_top); - if((s_top=SymbolMap(s)) ) - if(!(aref=ArrayMap(s))) - e->setSymbol(s_top); - else //if(aref->variant() == ARRAY_REF) - { NODE_CODE(e->thellnd) = ARRAY_REF; //e->setVariant(ARRAY_REF); - e->setSymbol(s_top); - e->setLhs(aref->lhs()->copy()); - } - return; - } - TranslateExpression(e->lhs(),md); - TranslateExpression(e->rhs(),md); -} -*/ - -void TranslateExpression_1(SgExpression *e) -{ - SgExpression *el; - SgSymbol *s_top, *s; - if (!e) - return; - if (isSgArrayRefExp(e)) - { - for (el = e->lhs(); el; el = el->rhs()) - TranslateExpression_1(el->lhs()); - s = e->symbol(); - if ((s_top = SymbolMap(s)) && !ArrayMap(s)) - e->setSymbol(s_top); - return; - } - //if(e->variant()==ARRAY_OP) - // ; - if (isSgVarRefExp(e)) - { - s = e->symbol(); - if ((s_top = SymbolMap(s)) && !ArrayMap(s)) - e->setSymbol(s_top); - return; - } - TranslateExpression_1(e->lhs()); - TranslateExpression_1(e->rhs()); -} - -void EditExpressionList(SgExpression *e) -{ - SgExpression *el; - for (el = e; el; el = el->rhs()) - el->lhs()->setLhs(NULL); -} - - -void TranslateExpressionList(SgExpression *e) -{ - SgExpression *el; - for (el = e; el; el = el->rhs()) - TranslateExpression_1(el->lhs()); -} - -SgSymbol *SymbolMap(SgSymbol *s) -{ - return(SymbMapping(s->thesymb->entry.Template.declared_name)); -} - -SgExpression *ArrayMap(SgSymbol *s) -{ - SgExpression *aref; - if ((aref = ARRAYMAP(s))) - return(aref); - else - return(NULL); -} - -SgExpression *ArrayMap2(SgSymbol *s) -{ - SgExpression *aref; - if ((aref = ARRAYMAP2(s))) - return(aref); - else - return(NULL); -} - -void InsertBlockAfter(SgStatement *after, SgStatement *first, SgStatement *header) -{ - SgStatement *prevst, *last; - last = header->lastNodeOfStmt(); - if ((prevst = last->lexPrev()) && prevst->variant() == CONT_STAT && !(prevst->hasLabel())) - prevst->extractStmt(); - header->extractStmt(); -#if __SPF - insertBfndListIn(first->thebif, after->thebif, NULL); -#else - after->insertStmtAfter(*first); -#endif - last->extractStmt(); //extract END - -} -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// S T A T E M E N T S (inserting, creating and so all) -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -void InsertNewStatementBefore(SgStatement *stat, SgStatement *current) { - //SgExpression *le; - //SgValueExp * index; - SgStatement *st; - - st = current->controlParent(); - if (st->variant() == LOGIF_NODE) { // Logical IF - // change by construction IF () THEN ENDIF and - // then insert statement before current statement - st->setVariant(IF_NODE); -#if __SPF - insertBfndListIn((new SgStatement(CONTROL_END))->thebif, current->thebif, NULL); -#else - current->insertStmtAfter(*new SgStatement(CONTROL_END)); -#endif - -#if __SPF - insertBfndListIn(stat->thebif, st->thebif, NULL); -#else - st->insertStmtAfter(*stat); -#endif - return; - } - - if (current->hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label - //insert statement before current and set on it the label of current - SgLabel *lab; - lab = current->label(); - BIF_LABEL(current->thebif) = NULL; - current->insertStmtBefore(*stat, *current->controlParent());//inserting before current statement - stat->setLabel(*lab); - return; - } - current->insertStmtBefore(*stat, *current->controlParent());//inserting before current statement -} - -void InsertNewStatementAfter(SgStatement *stat, SgStatement *current, SgStatement *cp) -{ - SgStatement *st; - st = current; - if (current->variant() == LOGIF_NODE) // Logical IF - st = current->lexNext(); - if (cp->variant() == LOGIF_NODE) - LogIf_to_IfThen(cp); - st->insertStmtAfter(*stat, *cp); - // cur_st = stat; -} - -void LogIf_to_IfThen(SgStatement *stmt) -{ - //replace Logical IF statement: IF ( ) - // by construction: IF ( ) THEN - // - // ENDIF - stmt->setVariant(IF_NODE); - (stmt->lexNext())->insertStmtAfter(*new SgControlEndStmt(), *stmt); -} - -void ReplaceContext(SgStatement *stmt) -{ - if (isDoEndStmt(stmt)) - ReplaceDoNestLabel(stmt, NewLabel()); - else if (isSgLogIfStmt(stmt->controlParent())) { - if (isDoEndStmt(stmt->controlParent())) - ReplaceDoNestLabel(stmt->controlParent(), NewLabel()); - LogIf_to_IfThen(stmt->controlParent()); - } -} - -int isDoEndStmt(SgStatement *stmt) -{ - SgLabel *lab, *do_lab; - SgForStmt *parent; - if (!(lab = stmt->label()) && stmt->variant() != CONTROL_END) //the statement has no label and - return(0); //is not ENDDO - parent = isSgForStmt(stmt->controlParent()); - if (!parent) //parent isn't DO statement - return(0); - do_lab = parent->endOfLoop(); // label of loop end or NULL - if (do_lab) // DO statement with label - if (lab && LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_lab->thelabel)) - // the statement label is the label of loop end - return(1); - else - return(0); - else // DO statement without label - if (stmt->variant() == CONTROL_END) - return(1); - else - return(0); -} -void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab) -//replaces the label of DO statement nest, which is ended by last_st, -// by new_lab -// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 -// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 -// . . . . . . -// DO 1 IK = 1,NK DO 99999 IK = 1,NK -// . . . . . . -// 1 statement 1 statement -// 99999 CONTINUE -{ - SgStatement *parent, *st; - SgLabel *lab; - SgForStmt *do_st; - parent = last_st->controlParent(); - lab = last_st->label(); - while ((do_st = isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { - if (LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)) { - if (!new_lab) - new_lab = NewLabel(); - BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel; - parent = parent->controlParent(); - } - else - break; - } - //inserts CONTINUE statement with new_lab as label - st = new SgStatement(CONT_STAT); - st->setLabel(*new_lab); - SetScopeOfLabel(new_lab, cur_func); - // for debug regim - LABEL_BODY(new_lab->thelabel) = st->thebif; - //BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if (last_st->variant() != LOGIF_NODE) - last_st->insertStmtAfter(*st, *last_st->controlParent()); - else - (last_st->lexNext())->insertStmtAfter(*st, *last_st->controlParent()); -} - -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// T E M P O R A R Y V A R I B L E S -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -SgSymbol *GetTempVarForF(SgSymbol *sf, SgType *t) -{ - char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name, "%s_%d_%d", sf->identifier(), sf->id(), vcounter++); - sn = new SgVariableSymb(name, *t, *cur_func); - if (isInSymbolTable(sn)) - sn = GetTempVarForF(sf, t); - if (cur_func == top_header) - top_temp_vars = AddToSymbList(top_temp_vars, sn); - return(sn); -} - -SgType * TypeOfResult(SgExpression *e) -{ - int indf; - SgSymbol *sf; - sf = e->symbol(); - indf = is_IntrinsicFunction(sf); - if (deb_reg > 2) - printf("indf: %d\n", indf); - if (indf > 0) - return(TypeF(indf, e)); - else - return(sf->type()); -} - -SgType *TypeF(int indf, SgExpression *e) -{ - graph_node *gnode; - //SgFile *f; - gnode = getAttrNodeForSymbol(e->symbol()); - current_file = gnode->file; - - switch (intrinsic_type[indf]) - { - case 1: return(SgTypeInt()); - case 2: return(SgTypeBool()); - case 3: return(SgTypeFloat()); - case 4: return(SgTypeDouble()); - case 5: return(SgTypeComplex(current_file)); - case 6: return(SgTypeDoubleComplex(current_file)); - case 7: return(SgTypeChar()); - case (-1): //return(e->lhs()->lhs()->type()); //type of first argument - return(TypeOfArgument(e->lhs()->lhs())); - default: - return(NULL); - } -} - -SgType *TypeOfArgument(SgExpression *e) -//set_expr_type() in types.c -{ - SgType *t; - //int indf; - //SgSymbol *sf; - t = e ? e->type() : NULL; - switch (e->variant()) { - case (FUNC_CALL): - { - /* sf = e->symbol(); - indf=is_IntrinsicFunction(sf); - if(indf>0 ) - { t=TypeF(indf,e); - if(!t) - t=sf->type(); - } - else - t=sf->type(); - */ - t = TypeOfResult(e); - break; - } - /* case (VAR_REF): - if(e->symbol()) - t=e->symbol()->type(); - else - t=NULL; - case (ARRAY_REF): - - case (AND_OP): - case (OR_OP): - case (EQ_OP): - case (LT_OP): - case (GT_OP): - case (NOTEQL_OP): - case (LTEQL_OP): - case (EQV_OP): - case (NEQV_OP): - case (GTEQL_OP): - */ - case (DIV_OP): - case (ADD_OP): - case (SUBT_OP): - case (MULT_OP): - case (EXP_OP): - {PTR_LLND expr, len; - PTR_TYPE l_operand, r_operand; - int l_type, r_type, ilen = 0; - expr = e->thellnd; - l_operand = expr->entry.binary_op.l_operand->type; - r_operand = expr->entry.binary_op.r_operand->type; - if (!l_operand || !r_operand) - break; - else { - if (l_operand->variant == T_ARRAY) - l_type = l_operand->entry.ar_decl.base_type->variant; - else - l_type = l_operand->variant; - if (r_operand->variant == T_ARRAY) - r_type = r_operand->entry.ar_decl.base_type->variant; - else - r_type = r_operand->variant; - if (l_operand->entry.Template.ranges) - { - len = (l_operand->entry.Template.ranges)->entry.Template.ll_ptr1; - if (len && len->variant == INT_VAL) - ilen = len->entry.ival; - if (l_type == T_FLOAT && ilen == 8) - l_type = T_DOUBLE; - if (l_type == T_COMPLEX && ilen == 16) - l_type = T_DCOMPLEX; - } - if (r_operand->entry.Template.ranges) - { - len = (r_operand->entry.Template.ranges)->entry.Template.ll_ptr1; - if (len && len->variant == INT_VAL) - ilen = len->entry.ival; - if (r_type == T_FLOAT && ilen == 8) - r_type = T_DOUBLE; - if (r_type == T_COMPLEX && ilen == 16) - r_type = T_DCOMPLEX; - } - - if (l_type == T_DCOMPLEX || r_type == T_DCOMPLEX) - t = SgTypeDoubleComplex(current_file); - else if (l_type == T_COMPLEX || r_type == T_COMPLEX) - t = SgTypeComplex(current_file); - else if (l_type == T_DOUBLE || r_type == T_DOUBLE) - t = SgTypeDouble(); - else if (l_type == T_FLOAT || r_type == T_FLOAT) - t = SgTypeFloat(); - else if (l_type == T_INT && r_type == T_INT) - t = SgTypeInt(); - - else t = NULL; - /* - if (l_operand->variant == T_ARRAY) - { - expr->type = copy_type_node(expr->entry.binary_op.l_operand->type); - expr->type->entry.ar_decl.base_type = temp; - } - else if (r_operand->variant == T_ARRAY) - { - expr->type = copy_type_node(expr->entry.binary_op.r_operand->type); - expr->type->entry.ar_decl.base_type = temp; - } - else expr->type = temp; - */ - } - break; - } - case (NOT_OP): - case (UNARY_ADD_OP): - case (MINUS_OP): - case (CONCAT_OP): - //expr->type = expr->entry.unary_op.operand->type; - t = e->lhs()->type(); - break; - default: - //err("Expression variant not known",322); - break; - } - e->setType(t); - return(t); - -} - - - - -SgType * SgTypeComplex(SgFile *f) -{ - SgType *t; - for (t = f->firstType(); t; t = t->next()) - if (t->variant() == T_COMPLEX) - return(t); - - return(new SgType(T_COMPLEX)); -} - -SgType * SgTypeDoubleComplex(SgFile *f) -{ - SgType *t; - for (t = f->firstType(); t; t = t->next()) - if (t->variant() == T_DCOMPLEX) - return(t); - - return(new SgType(T_DCOMPLEX)); -} - -int is_IntrinsicFunction(SgSymbol *sf) -{ - graph_node *gnode; - //printf("is intrinsic ?\n"); - gnode = getAttrNodeForSymbol(sf); - //printf("gnode:%d\n",gnode); - if (!gnode) return (-1); - if (isNoBodyNode(gnode)) - return(IntrinsicInd(sf)); - else - return(-1); -} - -int is_NoExpansionFunction(SgSymbol *sf) -{ - graph_node *gnode; - //printf("is no body ?\n"); - gnode = getAttrNodeForSymbol(sf); - //printf("gnode:%d\n",gnode); - if (isDummyArgument(sf)) return(0); - if (!gnode) return (1); - return(isNoBodyNode(gnode)); -} - -int IntrinsicInd(SgSymbol *sf) -{ - int i; - if (deb_reg > 2) - printf("is intrinsic %s\n", sf->identifier()); - for (i = 0; i < MAX_INTRINSIC_NUM; i++) - { - if (!intrinsic_name[i]) - break; - //printf("%d %s = %s\n", i, intrinsic_name[i], sf->identifier()); - if (!strcmp(sf->identifier(), intrinsic_name[i])) - return(i); - } - return(-1); -} - - -SgSymbol *GetTempVarForArg(int i, SgSymbol *sf, SgType *t) -{ - char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name, "%s_%d_arg%d_%d", sf->identifier(), sf->id(), i, vcounter++); - sn = new SgVariableSymb(name, *t, *cur_func); - if (isInSymbolTable(sn)) - sn = GetTempVarForArg(i, sf, t); - if (cur_func == top_header) - top_temp_vars = AddToSymbList(top_temp_vars, sn); - - return(sn); -} - -SgSymbol *GetTempVarForSubscr(SgType *t) -{ - char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name, "sbscr_arg_%d", vcounter++); - sn = new SgVariableSymb(name, *t, *cur_func); - if (isInSymbolTable(sn)) - sn = GetTempVarForSubscr(t); - if (cur_func == top_header) - top_temp_vars = AddToSymbList(top_temp_vars, sn); - - return(sn); -} - - -SgSymbol *GetTempVarForBound(SgSymbol *sa) -{ - char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name, "%s_%d_%d", sa->identifier(), sa->id(), vcounter++); - sn = new SgVariableSymb(name, *SgTypeInt(), *(sa->scope())); - if (isInSymbolTable(sn)) - sn = GetTempVarForBound(sa); - return(sn); -} - -SgSymbol *GetImplicitDoVar(int j) -{ - char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name, "i0%d", j + 1); - name = NewName(name); - - //if(sn = isTopName(name) - // if(sn->type == SgTypeInt()) - // return(sn); - // else - // return(GetImplicitDoVar - //else - - sn = new SgVariableSymb(name, *SgTypeInt(), *top_header); - return(sn); -} - -int isInSymbolTable(SgSymbol *sym) -{ - SgSymbol *s; - for (s = cur_func->symbol(); s; s = s->next()) - if (sym != s && !strcmp(sym->identifier(), s->identifier())) - return(1); - return(0); -} - -char *NewName(char *name) -{ - if (isTopName(name)) - { - sprintf(name, "%s_", name); - name = NewName(name); - } - return(name); -} - -SgSymbol *isTopName(char *name) -{ - SgSymbol *s; - for (s = top_header->symbol(); s; s = s->next()) - if (s->scope() == top_header && !strcmp(name, s->identifier())) - return(s); - return(NULL); -} - -SgSymbol *isTopNameOfType(char *name, SgType *type) -{ - SgSymbol - *s; - for (s = top_header->symbol(); s; s = s->next()) - if (s->scope() == top_header && !strcmp(name, s->identifier()) && type == s->type()) - return(s); - return(NULL); -} - -SgSymbol *GetNewTopSymbol(SgSymbol *s) -{ - char *name; - SgSymbol *sn; - name = new char[80]; - - sprintf(name, "%s__%d", s->identifier(), vcounter++); - sn = new SgSymbol(s->variant(), name, *s->type(), *top_header); - if (sn->variant() == CONST_NAME) - SYMB_VAL(sn->thesymb) = SYMB_VAL(s->thesymb); - - if (isInTopSymbList(sn)) - sn = GetNewTopSymbol(s); - - return(sn); - -} - -int isInTopSymbList(SgSymbol *sym) -{ - SgSymbol *s; - for (s = top_symb_list; s; s = NextSymbol(s)) - if (sym != s && !strcmp(sym->identifier(), s->identifier())) - return(1); - return(0); -} - -void PrintTopSymbList() -{ - SgSymbol *s; - printf("\nSymbol List of Top:\n"); - for (s = top_symb_list; s; s = NextSymbol(s)) - printf(" %s", s->identifier()); - return; -} - -void PrintSymbList(SgSymbol *slist, SgStatement *header) -{ - SgSymbol *s; - printf("\nSymbol List of %s:\n", header->symbol()->identifier()); - for (s = slist; s; s = NextSymbol(s)) - printf(" %s", s->identifier()); - return; -} - - -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- -// N O T R E A L I S E D ! ! ! -//------------------------------------------------------------------------------------------- -//------------------------------------------------------------------------------------------- - -int isIntrinsicFunctionName(char *name) -{ - return(0); -} - -char *ChangeIntrinsicFunctionName(char *name) -{ - return(name); -} - -int isInlinedCallSite(SgStatement *stmt) -{ // !!!!! temporary - return(1); -} -int TestFormatLabel(SgLabel *lab) -{ - return 0; -} - -void MakeRefsConformable(SgExpression *tref, SgExpression *ref) -{ - return; -} - -void CalculateTopLevelRef(SgSymbol *tops, SgExpression *tref, SgExpression *ref) -{ - return; -} \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/intrinsic.h b/projects/dvm_svn/fdvm/trunk/InlineExpansion/intrinsic.h deleted file mode 100644 index 5323aec..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/intrinsic.h +++ /dev/null @@ -1,196 +0,0 @@ -intrinsic_type[ICHAR] = 1; -intrinsic_type[CHAR] = 7; -intrinsic_type[INT] = 1; // -intrinsic_type[IFIX] = 1; -intrinsic_type[IDINT] = 1; -intrinsic_type[FLOAT] = 3; -intrinsic_type[REAL] = 3; // -intrinsic_type[SNGL] = 3; -intrinsic_type[DBLE] = 4; // -intrinsic_type[CMPLX] = 5; // -intrinsic_type[DCMPLX]= 6; -intrinsic_type[AINT] = 3; // -intrinsic_type[DINT] = 4; -intrinsic_type[ANINT] = 3; // -intrinsic_type[DNINT] = 4; -intrinsic_type[NINT] = 1; // -intrinsic_type[IDNINT]= 1; -intrinsic_type[ABS] =-1; //3 -intrinsic_type[IABS] = 1; -intrinsic_type[DABS] = 4; -intrinsic_type[CABS] = 5; -intrinsic_type[MOD] =-1; //1 -intrinsic_type[AMOD] = 3; -intrinsic_type[DMOD] = 4; -intrinsic_type[SIGN] =-1; //3 -intrinsic_type[ISIGN] = 1; -intrinsic_type[DSIGN] = 4; -intrinsic_type[DIM] =-1; //3 -intrinsic_type[IDIM] = 1; -intrinsic_type[DDIM] = 4; -intrinsic_type[MAX] =-1; -intrinsic_type[MAX0] = 1; -intrinsic_type[AMAX1] = 3; -intrinsic_type[DMAX1] = 4; -intrinsic_type[AMAX0] = 3; -intrinsic_type[MAX1] = 1; -intrinsic_type[MIN] =-1; // -intrinsic_type[MIN0] = 1; -intrinsic_type[AMIN1] = 3; -intrinsic_type[DMIN1] = 4; -intrinsic_type[AMIN0] = 3; -intrinsic_type[MIN1] = 1; -intrinsic_type[LEN] = 1; -intrinsic_type[INDEX] = 1; -intrinsic_type[AIMAG] =-1; //3 -intrinsic_type[DIMAG] = 4; -intrinsic_type[CONJG] =-1; //5 -intrinsic_type[DCONJG]= 6; -intrinsic_type[SQRT] =-1; //3 -intrinsic_type[DSQRT] = 4; -intrinsic_type[CSQRT] = 5; -intrinsic_type[EXP] =-1; //3 -intrinsic_type[DEXP] = 4; -intrinsic_type[CEXP] = 5; -intrinsic_type[LOG] =-1; // -intrinsic_type[ALOG] = 3; -intrinsic_type[DLOG] = 4; -intrinsic_type[CLOG] = 5; -intrinsic_type[LOG10] =-1; // -intrinsic_type[ALOG10]= 3; -intrinsic_type[DLOG10]= 4; -intrinsic_type[SIN] =-1; //3 -intrinsic_type[DSIN] = 4; -intrinsic_type[CSIN] = 5; -intrinsic_type[COS] =-1; //3 -intrinsic_type[DCOS] = 4; -intrinsic_type[CCOS] = 5; -intrinsic_type[TAN] =-1; //3 -intrinsic_type[DTAN] = 4; -intrinsic_type[ASIN] =-1; //3 -intrinsic_type[DASIN] = 4; -intrinsic_type[ACOS] =-1; //3 -intrinsic_type[DACOS] = 4; -intrinsic_type[ATAN] =-1; //3 -intrinsic_type[DATAN] = 4; -intrinsic_type[ATAN2] =-1; //3 -intrinsic_type[DATAN2]= 4; -intrinsic_type[SINH] =-1; //3 -intrinsic_type[DSINH] = 4; -intrinsic_type[COSH] =-1; //3 -intrinsic_type[DCOSH] = 4; -intrinsic_type[TANH] =-1; //3 -intrinsic_type[DTANH] = 4; -intrinsic_type[LGE] = 2; -intrinsic_type[LGT] = 2; -intrinsic_type[LLE] = 2; -intrinsic_type[LLT] = 2; -//intrinsic_type[] = ; -//intrinsic_type[] = ; - - -//{ICHAR, CHAR,INT,IFIX,IDINT,FLOAT,REAL,SNGL,DBLE,CMPLX,DCMPLX,AINT,DINT,ANINT,DNINT,NINT,IDNINT,ABS,IABS,DABS,CABS, -// MOD,AMOD,DMOD, SIGN,ISIGN, DSIGN, DIM,IDIM,DDIM, MAX,MAX0, AMAX1,DMAX1, AMAX0,MAX1, MIN,MIN0, -// AMIN1,DMIN1,AMIN0,MIN1,LEN,INDEX,AIMAG,DIMAG,CONJG,DCONJG,SQRT,DSQRT,CSQRT,EXP,DEXP.CEXP,LOG,ALOG,DLOG,CLOG, -// LOG10,ALOG10,DLOG10,SIN,DSIN,CSIN,COS,DCOS,CCOS,TAN,DTAN,ASIN,DASIN,ACOS,DACOS,ATAN,DATAN, -// ATAN2,DATAN2,SINH,DSINH,COSH,DCOSH,TANH,DTANH, LGE,LGT,LLE,LLT}; -//universal: ANINT,NINT,ABS, MOD,SIGN,DIM,MAX,MIN,SQRT,EXP,LOG,LOG10,SIN,COS,TAN,ASIN,ACOS,ATAN,ATAN2,SINH,COSH,TANH - -//universal name - -1 -//integer - 1 -//logical - 2 -//real - 3 -//double precision - 4 -//complex - 5 -//complex*16 - 6 -//character - 7 - -intrinsic_name[ICHAR] = "ichar"; -intrinsic_name[CHAR] = "char"; -intrinsic_name[INT] = "int"; // -intrinsic_name[IFIX] = "ifix"; -intrinsic_name[IDINT] = "idint"; -intrinsic_name[FLOAT] = "float"; -intrinsic_name[REAL] = "real"; // -intrinsic_name[SNGL] = "sngl"; -intrinsic_name[DBLE] = "dble"; // -intrinsic_name[CMPLX] = "cmplx"; // -intrinsic_name[DCMPLX]= "dcmplx"; -intrinsic_name[AINT] = "aint"; // -intrinsic_name[DINT] = "dint"; -intrinsic_name[ANINT] = "anint"; // -intrinsic_name[DNINT] = "dnint"; -intrinsic_name[NINT] = "nint"; // -intrinsic_name[IDNINT]= "idnint"; -intrinsic_name[ABS] = "abs"; // -intrinsic_name[IABS] = "iabs"; -intrinsic_name[DABS] = "dabs"; -intrinsic_name[CABS] = "cabs"; -intrinsic_name[MOD] = "mod"; // -intrinsic_name[AMOD] = "amod"; -intrinsic_name[DMOD] = "dmod"; -intrinsic_name[SIGN] = "sign"; // -intrinsic_name[ISIGN] = "isign"; -intrinsic_name[DSIGN] = "dsign"; -intrinsic_name[DIM] = "dim"; // -intrinsic_name[IDIM] = "idim"; -intrinsic_name[DDIM] = "ddim"; -intrinsic_name[MAX] = "max"; -intrinsic_name[MAX0] = "max0"; -intrinsic_name[AMAX1] = "amax1"; -intrinsic_name[DMAX1] = "dmax1"; -intrinsic_name[AMAX0] = "amax0"; -intrinsic_name[MAX1] = "max1"; -intrinsic_name[MIN] = "min"; // -intrinsic_name[MIN0] = "min0"; -intrinsic_name[AMIN1] = "amin1"; -intrinsic_name[DMIN1] = "dmin1"; -intrinsic_name[AMIN0] = "amin0"; -intrinsic_name[MIN1] = "min1"; -intrinsic_name[LEN] = "len"; -intrinsic_name[INDEX] = "index"; -intrinsic_name[AIMAG] = "AIMAG"; // -intrinsic_name[DIMAG] = "DIMAG"; -intrinsic_name[CONJG] = "conjg"; // -intrinsic_name[DCONJG]= "dconjg"; -intrinsic_name[SQRT] = "sqrt"; // -intrinsic_name[DSQRT] = "dsqrt"; -intrinsic_name[CSQRT] = "csqrt"; -intrinsic_name[EXP] = "exp"; // -intrinsic_name[DEXP] = "dexp"; -intrinsic_name[CEXP] = "cexp"; -intrinsic_name[LOG] = "log"; // -intrinsic_name[ALOG] = "alog"; -intrinsic_name[DLOG] = "dlog"; -intrinsic_name[CLOG] = "clog"; -intrinsic_name[LOG10] = "log10"; // -intrinsic_name[ALOG10]= "alog10"; -intrinsic_name[DLOG10]= "dlog10"; -intrinsic_name[SIN] = "sin"; // -intrinsic_name[DSIN] = "dsin"; -intrinsic_name[CSIN] = "csin"; -intrinsic_name[COS] = "cos"; // -intrinsic_name[DCOS] = "dcos"; -intrinsic_name[CCOS] = "ccos"; -intrinsic_name[TAN] = "tan"; // -intrinsic_name[DTAN] = "dtan"; -intrinsic_name[ASIN] = "asin"; // -intrinsic_name[DASIN] = "dasin"; -intrinsic_name[ACOS] = "acos"; // -intrinsic_name[DACOS] = "dacos"; -intrinsic_name[ATAN] = "atan"; // -intrinsic_name[DATAN] = "datan"; -intrinsic_name[ATAN2] = "atan2"; // -intrinsic_name[DATAN2]= "datan2"; -intrinsic_name[SINH] = "sinh"; // -intrinsic_name[DSINH] = "dsinh"; -intrinsic_name[COSH] = "cosh"; // -intrinsic_name[DCOSH] = "dcosh"; -intrinsic_name[TANH] = "tanh"; // -intrinsic_name[DTANH] = "dtanh"; -intrinsic_name[LGE] = "lge"; -intrinsic_name[LGT] = "lgt"; -intrinsic_name[LLE] = "lle"; -intrinsic_name[LLT] = "llt"; - - diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.uni b/projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.uni deleted file mode 100644 index f961955..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.uni +++ /dev/null @@ -1,46 +0,0 @@ -#echo####################################################################### -# Makefile for Fortran DVM transformator -# -#echo####################################################################### - -# dvm/fdvm/fdvm_transform/makefile.uni - -SAGEROOT = ../Sage -LIBDIR = ../lib -BINDIR = ../../bin -LIBINCLUDE = $(SAGEROOT)/lib/include -HINCLUDE = $(SAGEROOT)/h -DVMINCLUDE = ../include -EXECUTABLES = inl_exp - -LOADER = $(LINKER) - -INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(DVMINCLUDE) - -CFLAGS = -c $(INCL) -Wall -LDFLAGS = - -LIBS = $(LIBDIR)/libSage++.a $(LIBDIR)/libsage.a $(LIBDIR)/libdb.a -OBJS = inl_exp.o inliner.o hlp.o - - -$(BINDIR)/$(EXECUTABLES): $(OBJS) - $(LOADER) $(LDFLAGS) -o $(BINDIR)/$(EXECUTABLES) $(OBJS) $(LIBS) - -all: $(BINDIR)/$(EXECUTABLES) - @echo "****** COMPILING $(EXECUTABLES) DONE ******" - -clean: - rm -f $(OBJS) -cleanall: - rm -f $(OBJS) - -############################# dependencies ############################ - - -inl_exp.o: inl_exp.cpp inline.h - $(CXX) $(CFLAGS) inl_exp.cpp -inliner.o: inliner.cpp inline.h - $(CXX) $(CFLAGS) inliner.cpp -hlp.o: hlp.cpp inline.h - $(CXX) $(CFLAGS) hlp.cpp diff --git a/projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.win b/projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.win deleted file mode 100644 index 110ce87..0000000 --- a/projects/dvm_svn/fdvm/trunk/InlineExpansion/makefile.win +++ /dev/null @@ -1,61 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# dvm/fdvm/fdvm_transform/makefile.win - -OUTDIR = ..\obj -BINDIR = ..\..\bin -LIBDIR = ..\lib -SAGEROOT =..\Sage - -LIBINCLUDE = $(SAGEROOT)\lib\include -HINCLUDE = $(SAGEROOT)\h -FDVMINCL = ..\include -EXECUTABLES = inl_exp - -INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(FDVMINCL) - - -# -w don't issue warning now. -#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ -# /Fp"$(OUTDIR)/fdvm_transform.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c -CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ - /Fp"$(OUTDIR)/fdvm_transform.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c - -.cpp{$(OUTDIR)/}.obj: - $(CXX) $(CFLAGS) $< - -LINK=$(LINKER) - -LINK_FLAGS=/nologo /subsystem:console /incremental:no\ - /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" - -LINK_FLAGS=/nologo /subsystem:console /incremental:no\ - /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" - -OBJS = $(OUTDIR)/inl_exp.obj $(OUTDIR)/inliner.obj $(OUTDIR)/hlp.obj - -LIBS = $(LIBDIR)/libSage++.lib $(LIBDIR)\libsage.lib $(LIBDIR)\libdb.lib - - -$(BINDIR)/$(EXECUTABLES).exe: $(OBJS) - $(LINK) @<< - $(LINK_FLAGS) $(OBJS) $(LIBS) -<< - -all: $(BINDIR)/$(EXECUTABLES).exe - @echo "*** COMPILING EXECUTABLE $(EXECUTABLES) DONE" - - -clean: - -cleanall: - - -# *********************************************************** - -inl_exp.obj: inl_exp.cpp inline.h -inliner.obj: inliner.cpp inline.h -hlp.obj: hlp.cpp inline.h diff --git a/projects/dvm_svn/fdvm/trunk/Makefile b/projects/dvm_svn/fdvm/trunk/Makefile deleted file mode 100644 index 783b4ed..0000000 --- a/projects/dvm_svn/fdvm/trunk/Makefile +++ /dev/null @@ -1,17 +0,0 @@ - -SHELL = /bin/sh -INSTALL = /bin/cp - -SUBDIR = Sage parser fdvm - -install: - @for i in ${SUBDIR}; do (cd $$i; \ - echo " *** $$i DIRECTORY ***";\ - $(MAKE) "MAKE=$(MAKE)" install); done - -clean: - @for i in ${SUBDIR}; do (cd $$i; \ - echo " *** $$i DIRECTORY ***";\ - $(MAKE) "MAKE=$(MAKE)" clean); done - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/Sage/CMakeLists.txt deleted file mode 100644 index 76992fb..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/CMakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ -set(DVM_SAGE_INCLUDE_DIRS ${CMAKE_CURRENT_SOURCE_DIR}/h) - -add_subdirectory(lib) -add_subdirectory(Sage++) \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/Sage/LICENSE b/projects/dvm_svn/fdvm/trunk/Sage/LICENSE deleted file mode 100644 index 64be3a7..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/LICENSE +++ /dev/null @@ -1,67 +0,0 @@ -************************************************************************ -./LICENSE pC++/Sage++ License Information (PHB 9/2/93) -************************************************************************ - - This file is a REQUIRED part of the pC++/Sage++ Environment - -The pC++/Sage++ software is *not* in the public domain. However, it -is freely available without fee for education, research, and -non-profit purposes. By obtaining copies of this and other files that -comprise the pC++/Sage++ environment, you, the Licensee, agree to -abide by the following conditions and understandings with respect to -the copyrighted software: - -1. The software is copyrighted by Indiana University (IU), University -of Oregon (UO), and the University of Rennes (UR), and they retain -ownership of the software. - -2. Permission to use and modify this software and its documentation -for education, research, and non-profit purposes is hereby granted to -Licensee, provided that the copyright notice, the original author's -names and unit identification, and this permission notice appear on -all such works, and that no charge be made for such copies. - -3. We request that the Licensee not distribute the pC++/Sage++ -software. In order to maintain the software, we will distribute the -most up-to-date version of the software via FTP. Please "finger -sage@cica.indiana.edu" for more information. Furthermore, our funding -agencies would like to know what you think about pC++/Sage++. If you -are using the software, PLEASE join our mailing list by sending mail -to sage-request.cica.indiana.edu with the Subject: "subscribe". We -will notify you of important bug fixes and updates as they become -available. - -Any entity desiring permission to incorporate this software into -commercial products should contact: - - Dennis Gannon gannon@cs.indiana.edu - 215 Lindley Hall - Department of Computer Science - Indiana Univerity - Bloomington, IN 47401 - USA - -4. Licensee may not use the name, logo, or any other symbol of -IU/UO/UR nor the names of any of its employees nor any adaptation -thereof in advertizing or publicity pertaining to the software without -specific prior written approval of the IU/UO/UR. - -5. IU/UO/UR MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THE -SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR -IMPLIED WARRANTY. - -6. IU/UO/UR shall not be liable for any damages suffered by Licensee -from the use of this software. - -7. The software was developed under agreements between the IU/UO/UR -and the Federal Government which entitle the Government to certain -rights. - -************************************************************************ - -Copyright (c) 1993 Indiana University, University of Oregon, -University of Rennes. All Rights Reserved. - -Funded by: ARPA under Rome Labs contract AF 30602-92-C-0135 and the -National Science Foundation Office of Advanced Scientific Computing -under grant ASC-9111616 and Esprit BRA APPARC diff --git a/projects/dvm_svn/fdvm/trunk/Sage/Makefile b/projects/dvm_svn/fdvm/trunk/Sage/Makefile deleted file mode 100644 index ab8f42a..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/Makefile +++ /dev/null @@ -1,106 +0,0 @@ -####################################################################### -## pC++/Sage++ Copyright (C) 1993 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - - -# sage/Makefile (phb) - -# Pete Beckman (5/27/93) - -# -# This makefile recursively calls MAKE in each subdirectory -# -# There are two configurations for this Makefile at the present time -# 1) Users/Developers of the Sage++ Compiler tools -# 2) Users/Developers of pC++, a Parallel C++ for Supercomputers -# - -SHELL = /bin/sh - -CONFIG_ARCH=iris4d - -CC = gcc -#CC=cc#ENDIF##USE_CC# -#PTX#CC=cc#ENDIF# - -CXX = g++ -#USE_CFRONT#CXX= CC#ENDIF# -#USE_DECCXX#CXX=cxx#ENDIF# -#USE_IBMXLC#CXX=xlC#ENDIF# -CXX=DCC#ENDIF##USE_SGIDCC# -CXX = g++ -LINKER = $(CC) - -#PTX#EXTRASRC=target/symmetry/src#ENDIF# -#SYMMETRY#EXTRASRC=target/symmetry/src#ENDIF# -#CM5#EXTRASRC=target/cm5/src#ENDIF# -#PARAGON#EXTRASRC=target/paragon/src#ENDIF# -#PARAGON_XDEV#EXTRASRC=target/paragon/src#ENDIF# -#KSR#EXTRASRC=target/ksr1/src#ENDIF# -#SP1#EXTRASRC=target/sp1/src#ENDIF# -#CS2#EXTRASRC=target/cs2/src#ENDIF# -EXTRASRC=target/sgimp/src#ENDIF##SGIMP# - -# instr temporarily removed until libSage++ stable - -# Several types of configurations.... - -# tools EVERYONE needs -BASIC = lib Sage++ - -# Other Compiler Tools -SAGEXX = f2dep#ENDIF##SAGEXX# - -# pC++ system -#PVM_INSTALLED#PVMTEMP=target/pvm/src#ENDIF# -TEMP = breezy instr dep2C++ target/uniproc/src $(PVMTEMP) -#PCXX#PCXX = $(TEMP) $(EXTRASRC) TestSuite#ENDIF# - -# What to compile -SUBDIR1 = $(BASIC) - -# Subdirectories to make resursively -SUBDIR = ${SUBDIR1} - -all: - @echo "*********** RECURSIVELY MAKING SUBDIRECTORIES ***********" - @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ - $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" ); done - @echo "***************** DONE ************************ -# @echo "To run the TestSuite code (in uniprocessor mode) type:" -# @echo "cd TestSuite; make test" - -clean: - for i in ${SUBDIR1} Sage++; do (cd $$i; $(MAKE) "MAKE=$(MAKE)" clean); done - -cleandist: clean cleangood -cleaninstall: clean cleangood -cleangood: - @echo "Deleting *~ #* core *.a *.sl *.o *.dep" - @find . \( -name \*~ -o -name \#\* -o -name core \) \ - -exec /bin/rm {} \; -print - @find . \( -name \*.a -o -name \*.sl -o -name \*.o -o -name \*.dep \) \ - -exec /bin/rm {} \; -print - @if [ ! -d bin/$(CONFIG_ARCH) ] ; then true; \ - else /bin/rm -r bin/$(CONFIG_ARCH) ; fi - @if [ ! -d lib/$(CONFIG_ARCH) ] ; then true; \ - else /bin/rm -r lib/$(CONFIG_ARCH) ; fi - @if [ ! -d target/pvm/lib ] ; then true; \ - else /bin/rm -r target/pvm/lib ; fi - -install: - @echo "*********** RECURSIVELY MAKING SUBDIRECTORIES ***********" - @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ - $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" install); done - @echo "***************** DONE ************************" -# @echo "To run the TestSuite code (in uniprocessor mode) type:" -# @echo "cd TestSuite; make test" - -.RECURSIVE: ${SUBDIR1} - -${SUBDIR}: FRC - cd $@; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -FRC: - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/Sage/Sage++/CMakeLists.txt deleted file mode 100644 index 793dc59..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/CMakeLists.txt +++ /dev/null @@ -1,14 +0,0 @@ -set(SAGEP_SOURCES libSage++.cpp) - -if(MSVC_IDE) - foreach(DIR ${DVM_SAGE_INCLUDE_DIRS}) - file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} - "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag") - set(SAGEP_HEADERS ${SAGEP_HEADERS} ${FILES}) - endforeach() - source_group("Header Files" FILES ${SAGEP_HEADERS}) -endif() -add_library(sage++ ${SAGEP_SOURCES} ${SAGEP_HEADERS}) - -target_include_directories(sage++ PUBLIC "${DVM_SAGE_INCLUDE_DIRS}") -set_target_properties(sage++ PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}") diff --git a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/Makefile b/projects/dvm_svn/fdvm/trunk/Sage/Sage++/Makefile deleted file mode 100644 index 0e5298b..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/Makefile +++ /dev/null @@ -1,97 +0,0 @@ -####################################################################### -## pC++/Sage++ Copyright (C) 1993 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - -# sage/Sage++/Makefile (PHB) - -SHELL = /bin/sh -CONFIG_ARCH=iris4d - -RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ] -#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF# - -# Shared library hack for HP-UX -LSX = .a -#HP_CFLAGS#CEXTRA = -Aa +z#ENDIF# -#HP_CFLAGS#LSX = .sl#ENDIF# - -PCXX = ../bin/$(CONFIG_ARCH)/pc++ - -CC = gcc -#CC=cc - -CXX = #CC -#USE_CFRONT#CXX= CC#ENDIF# -#USE_DECCXX#CXX=cxx#ENDIF# -#USE_IBMXLC#CXX=xlC#ENDIF# -CXX=DCC#ENDIF##USE_SGIDCC# -CXX=g++ -LOADER = $(CXX) -#INSTALLDEST = ../lib/$(CONFIG_ARCH) -INSTALLDEST = ../../libsage -INSTALL = /bin/cp -HDRS = ../h -LIBINCLUDE = ../lib/include -SAGEINCLUDE = -I$(HDRS) -I$(LIBINCLUDE) - -# Directory in which include files can be found -INCLUDEDIR = ./h -INCLUDE = -I$(INCLUDEDIR) $(SAGEINCLUDE) - -# -w don't issue warning now. -CFLAGS = $(INCLUDE) -g -Wall -c $(CEXTRA) -LDFLAGS = -#BISON= /usr/freeware/bin/bison -BISON= bison -TOOLSage++_SRC = libSage++.cpp - -TOOLSage++_HDR = $(LIBINCLUDE)/macro.h $(LIBINCLUDE)/bif_node.def $(LIBINCLUDE)/type.def $(LIBINCLUDE)/symb.def $(LIBINCLUDE)/libSage++.h - -TOOLSage++_OBJ = libSage++.o - -SUBDIR1 = extentions -SUBDIR = ${SUBDIR1} - -#all: $(TOOLSage++_OBJ) $(TOOLSage++_HDR) -# @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ -# $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" $@); done - -libSage++.a: libSage++.o $(TOOLSage++_HDR) - /bin/rm -f libSage++.a - ar qc libSage++.a libSage++.o - @if $(RANLIB_TEST) ; then ranlib libSage++.a ; \ - else echo "\tNOTE: ranlib not required" ; fi -libSage++.o: libSage++.cpp $(TOOLSage++_HDR) - $(CXX) $(CFLAGS) libSage++.cpp - -libSage++.dep: libSage++.cpp $(TOOLSage++_HDR) - $(PCXX) -deponly $(INCLUDE) libSage++.cpp -o libSage++.o - -libSage++ : libSage++$(LSX) - -clean: - /bin/rm -f libSage++$(LSX) libSage++.dep libSage++.proj - /bin/rm -f $(TOOLSage++_OBJ) - /bin/rm -f extentions/sgCallGraph.o - /bin/rm -f extentions/sgClassHierarchy.o - -cleaninstall: clean - -install:$(INSTALLDEST)/libSage++.a - -# @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ -# $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" $@); done - -$(INSTALLDEST)/libSage++.a: libSage++.a - if [ -d $(INSTALLDEST) ] ; then true; \ - else mkdir $(INSTALLDEST) ;fi - $(INSTALL) libSage++.a $(INSTALLDEST) - @if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libSage++.a ; \ - else echo "\tNOTE: ranlib not required" ; fi - -${SUBDIR}: FRC - cd $@; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -FRC: - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/libSage++.cpp b/projects/dvm_svn/fdvm/trunk/Sage/Sage++/libSage++.cpp deleted file mode 100644 index dc7874e..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/libSage++.cpp +++ /dev/null @@ -1,9158 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ -#include "leak_detector.h" -#include -#include - -#include -#include - -#ifndef __GNUC__ - -#else -extern "C" void abort(void); -extern "C" void exit(int status); -/*# pragma implementation*/ -#endif - -#define CPLUS_ -#include "macro.h" -#undef CPLUS_ -#include "vpc.h" -#include "f90.h" - -#include "extcxx_low.h" -extern "C" int number_of_ll_node; -extern "C" PTR_SYMB last_file_symbol; - -#undef USER - -#if __SPF -extern "C" void addToCollection(const int line, const char *file, void *pointer, int type); -extern "C" void removeFromCollection(void *pointer); -extern std::map > sgStats; -extern std::map > sgExprs; -extern void addToGlobalBufferAndPrint(const std::string &toPrint); -#endif - -// -// define for having the debugging -// -//define DEBUGLIB 1 -#define MAX_FILES 1000 -// -// -// Array to keep track of table for a file -// -// - -void **tablebfnd[MAX_FILES]; -void **tablellnd[MAX_FILES]; -void **tabletype[MAX_FILES]; -void **tablesymbol[MAX_FILES]; -void **tablelabel[MAX_FILES]; - -int numtablebfnd[MAX_FILES]; -int numtablellnd[MAX_FILES]; -int numtabletype[MAX_FILES]; -int numtablesymbol[MAX_FILES]; -int numtablelabel[MAX_FILES]; - - -//////////////////////////// ATTRIBUTES ///////////////////////////////// -// Array to keep track of the attributes for statement, symbol, ... -/////////////////////////////////////////////////////////////////////////// - -class SgAttribute; - -SgAttribute **tablebfndAttribute[MAX_FILES]; -SgAttribute **tablellndAttribute[MAX_FILES]; -SgAttribute **tabletypeAttribute[MAX_FILES]; -SgAttribute **tablesymbolAttribute[MAX_FILES]; -SgAttribute **tablelabelAttribute[MAX_FILES]; - -int numtablebfndAttribute[MAX_FILES]; -int numtablellndAttribute[MAX_FILES]; -int numtabletypeAttribute[MAX_FILES]; -int numtablesymbolAttribute[MAX_FILES]; -int numtablelabelAttribute[MAX_FILES]; - - - -// -// Table definition for attributes -// -// - - -SgAttribute **fileTableAttribute; -int allocatedForfileTableAttribute; -SgAttribute **bfndTableAttribute; -int allocatedForbfndTableAttribute; -SgAttribute **llndTableAttribute; -int allocatedForllndTableAttribute; -SgAttribute **typeTableAttribute; -int allocatedFortypeTableAttribute; -SgAttribute **symbolTableAttribute; -int allocatedForsymbolTableAttribute; -SgAttribute **labelTableAttribute; -int allocatedForlabelTableAttribute; - -///////////////////////////////// END ATTRIBUTES /////////////////////////// - - -static int CurrentFileNumber = 0; - -// -// Table for making link between the nodes and the classes -// Take the id and return a pointer -// - -void **fileTableClass; -int allocatedForfileTableClass; -void **bfndTableClass; -int allocatedForbfndTableClass; -void **llndTableClass; -int allocatedForllndTableClass; -void **typeTableClass; -int allocatedFortypeTableClass; -void **symbolTableClass; -int allocatedForsymbolTableClass; -void **labelTableClass; -int allocatedForlabelTableClass; - - -// -// Some definition for this module -// -#define ALLOCATECHUNK 10000 - -#define SORRY Message("Sorry, not implemented yet",0) - -class SgProject; -class SgFile; -class SgStatement; -class SgExpression; -class SgLabel; -class SgSymbol; -class SgType; -class SgUnaryExp; -class SgClassSymb; -class SgVarDeclStmt; - - -// -// Set of function to care about the table management -// - -void InitializeTable() -{ - int i; - for (i = 0; i < MAX_FILES; i++) - { - tablebfnd[i] = NULL; - tablellnd[i] = NULL; - tabletype[i] = NULL; - tablesymbol[i] = NULL; - tablelabel[i] = NULL; - - numtablebfnd[i] = 0; - numtablellnd[i] = 0; - numtabletype[i] = 0; - numtablesymbol[i] = 0; - numtablelabel[i] = 0; - - // FOR ATTRIBUTES; - tablebfndAttribute[i] = NULL; - tablellndAttribute[i] = NULL; - tabletypeAttribute[i] = NULL; - tablesymbolAttribute[i] = NULL; - tablelabelAttribute[i] = NULL; - - numtablebfndAttribute[i] = 0; - numtablellndAttribute[i] = 0; - numtabletypeAttribute[i] = 0; - numtablesymbolAttribute[i] = 0; - numtablelabelAttribute[i] = 0; - } - - - fileTableClass = NULL; - bfndTableClass = NULL; - llndTableClass = NULL; - typeTableClass = NULL; - symbolTableClass = NULL; - labelTableClass = NULL; - allocatedForfileTableClass = 0; - allocatedForbfndTableClass = 0; - allocatedForllndTableClass = 0; - allocatedFortypeTableClass = 0; - allocatedForsymbolTableClass = 0; - allocatedForlabelTableClass = 0; - - // FOR ATTRIBUTES; - fileTableAttribute = NULL; - bfndTableAttribute = NULL; - llndTableAttribute = NULL; - typeTableAttribute = NULL; - symbolTableAttribute = NULL; - labelTableAttribute = NULL; - allocatedForfileTableAttribute = 0; - allocatedForbfndTableAttribute = 0; - allocatedForllndTableAttribute = 0; - allocatedFortypeTableAttribute = 0; - allocatedForsymbolTableAttribute = 0; - allocatedForlabelTableAttribute = 0; -} - - -void SwitchToFile(int i) -{ - if (i >= MAX_FILES) - { - Message("Too many files", 0); - exit(1); - } - - tablebfnd[CurrentFileNumber] = bfndTableClass; - tablellnd[CurrentFileNumber] = llndTableClass; - tabletype[CurrentFileNumber] = typeTableClass; - tablesymbol[CurrentFileNumber] = symbolTableClass; - tablelabel[CurrentFileNumber] = labelTableClass; - - numtablebfnd[CurrentFileNumber] = allocatedForbfndTableClass; - numtablellnd[CurrentFileNumber] = allocatedForllndTableClass; - numtabletype[CurrentFileNumber] = allocatedFortypeTableClass; - numtablesymbol[CurrentFileNumber] = allocatedForsymbolTableClass; - numtablelabel[CurrentFileNumber] = allocatedForlabelTableClass; - - bfndTableClass = tablebfnd[i]; - llndTableClass = tablellnd[i]; - typeTableClass = tabletype[i]; - symbolTableClass = tablesymbol[i]; - labelTableClass = tablelabel[i]; - - allocatedForbfndTableClass = numtablebfnd[i]; - allocatedForllndTableClass = numtablellnd[i]; - allocatedFortypeTableClass = numtabletype[i]; - allocatedForsymbolTableClass = numtablesymbol[i]; - allocatedForlabelTableClass = numtablelabel[i]; - - // FOR ATTRIBUTES - tablebfndAttribute[CurrentFileNumber] = bfndTableAttribute; - tablellndAttribute[CurrentFileNumber] = llndTableAttribute; - tabletypeAttribute[CurrentFileNumber] = typeTableAttribute; - tablesymbolAttribute[CurrentFileNumber] = symbolTableAttribute; - tablelabelAttribute[CurrentFileNumber] = labelTableAttribute; - - numtablebfndAttribute[CurrentFileNumber] = allocatedForbfndTableAttribute; - numtablellndAttribute[CurrentFileNumber] = allocatedForllndTableAttribute; - numtabletypeAttribute[CurrentFileNumber] = allocatedFortypeTableAttribute; - numtablesymbolAttribute[CurrentFileNumber] = allocatedForsymbolTableAttribute; - numtablelabelAttribute[CurrentFileNumber] = allocatedForlabelTableAttribute; - - bfndTableAttribute = tablebfndAttribute[i]; - llndTableAttribute = tablellndAttribute[i]; - typeTableAttribute = tabletypeAttribute[i]; - symbolTableAttribute = tablesymbolAttribute[i]; - labelTableAttribute = tablelabelAttribute[i]; - - allocatedForbfndTableAttribute = numtablebfndAttribute[i]; - allocatedForllndTableAttribute = numtablellndAttribute[i]; - allocatedFortypeTableAttribute = numtabletypeAttribute[i]; - allocatedForsymbolTableAttribute = numtablesymbolAttribute[i]; - allocatedForlabelTableAttribute = numtablelabelAttribute[i]; - CurrentFileNumber = i; -} - -/////////////////////////////////////////// FOR ATTRIBUTES ////////////////////////////////// - - -// add a chunk to the size -void ReallocatefileTableAttribute() -{ - int i; - SgAttribute **pt; - - pt = new SgAttribute *[allocatedForfileTableAttribute + ALLOCATECHUNK]; -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 2); -#endif - for (i=0; i >::iterator it = sgStats.find(bif); - if (it != sgStats.end()) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp, this place was occupied\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw(-1); - } -#endif - bfndTableClass[BIF_ID(bif)] = pt; -} - - -void SetMappingInTableForType(PTR_TYPE type, void *pt) -{ - if (!type) - return; - while (allocatedFortypeTableClass <= TYPE_ID(type)) - { - ReallocatetypeTableClass(); - } - typeTableClass[TYPE_ID(type)] = pt; -} - - -void SetMappingInTableForSymb(PTR_SYMB symb, void *pt) -{ - if (!symb) - return; - while (allocatedForsymbolTableClass <= SYMB_ID(symb)) - { - ReallocatesymbolTableClass(); - } - symbolTableClass[SYMB_ID(symb)] = pt; -} - -void SetMappingInTableForLabel(PTR_LABEL lab, void *pt) -{ - if (!lab) - return; - while (allocatedForlabelTableClass <= LABEL_ID(lab)) - { - ReallocatelabelTableClass(); - } - labelTableClass[SYMB_ID(lab)] = pt; -} - -void SetMappingInTableForLlnd(PTR_LLND ll, void *pt) -{ - if (!ll) - return; - while (allocatedForllndTableClass <= NODE_ID(ll)) - { - ReallocatellndTableClass(); - } -#if __SPF - std::map >::iterator it = sgExprs.find(ll); - if (it != sgExprs.end()) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp, this place was occupied\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw(-1); - } -#endif - llndTableClass[NODE_ID(ll)] = pt; -} - - -void SetMappingInTableForFile(PTR_FILE file, void *pt) -{ - int id; - if (!file) - return; - id = GetFileNum(FILE_FILENAME(file)); - while (allocatedForfileTableClass <= id) - { - ReallocatefileTableClass(); - } - fileTableClass[id] = pt; -} - - -SgSymbol *GetMappingInTableForSymbol(PTR_SYMB symb) -{ - int id; - if (!symb) - return NULL; - id = SYMB_ID(symb); - if (allocatedForsymbolTableClass <= id) - { - return NULL; - } - return (SgSymbol *) symbolTableClass[id]; -} - - - -SgLabel * -GetMappingInTableForLabel(PTR_LABEL lab) -{ - int id; - if (!lab) - return NULL; - id = LABEL_ID(lab); - if (allocatedForlabelTableClass <= id) - { - return NULL; - } - return (SgLabel *) labelTableClass[id]; -} - - -SgStatement * -GetMappingInTableForBfnd(PTR_BFND bf) -{ - int id; - if (!bf) - return NULL; - id = BIF_ID(bf); - if (allocatedForbfndTableClass <= id) - { - return NULL; - } - return (SgStatement *) bfndTableClass[id]; -} - - -SgType * -GetMappingInTableForType(PTR_TYPE t) -{ - int id; - if (!t) - return NULL; - id = TYPE_ID(t); - if (allocatedFortypeTableClass <= id) - { - return NULL; - } - return (SgType *) typeTableClass[id]; -} - - -SgExpression * -GetMappingInTableForLlnd(PTR_LLND ll) -{ - int id; - if (!ll) - return NULL; - id = NODE_ID(ll); - if (allocatedForllndTableClass <= id) - { - return NULL; - } - return (SgExpression *)llndTableClass[id]; -} - - -SgFile * -GetMappingInTableForFile(PTR_FILE file) -{ - int id; - if (!file) - return NULL; - id = GetFileNum(FILE_FILENAME(file)); - if (allocatedForfileTableClass <= id) - { - return NULL; - } - return (SgFile *) fileTableClass[id]; -} - - -//Fortran and C++ Structures -// -// There several families of classes here. -// Projects- which correspond to a collection of parsed -// source files. -// Files - which corresponds to an individual source file -// Statements- Fortran or C statements -// Expressions- Fortran or C expression trees. -// Symbols- Symbol Table entries. -// Types- Each symbol has a type which lives in a type table. -// Labels- Statement labels in fortran or C -// Dependences- Data Dependence Class -// -// naming convention: Classnames begin with Sg (for Sage) -// class functions begin with a lower case and have first letters -// of words in Caps likeThisWord. -// -// In general functions return references when ever possible. -// -// -// ************* Project and File Types ****************** -// the sage fortran 90 and c++ parsers generate files with -// a .dep extension. A project is a file with a .proj extension -// that consists of a list of .dep files that make the basis -// of the project. The following describes the -// basic mechanisms to access and modify the structures -// The class hierarch is as follows: -// -//SgProject = the class representing multi source file projects -// -//SgFile = the basic source file object. -// - SgFortranFile = the subclass for Fortran sources -// - SgCFile = the subclass for C files. -// -// ****************************************************************** - -// forward ref -SgStatement * BfndMapping(PTR_BFND bif); -SgExpression * LlndMapping(PTR_LLND llin); -SgSymbol * SymbMapping(PTR_SYMB symb); -SgType * TypeMapping(PTR_TYPE ty); -SgLabel * LabelMapping(PTR_LABEL label); - -// As you can see, some statements are specifically Fortran and -// some apply only to C and C++. -// - -// the generic statement class has functions to access or modify any -// property of a given statement. - -SgProject *CurrentProject; - -#include "libSage++.h" - - -// -// checking if correct; (better for garbage collecting that way).... -// -void RemoveFromTableLlnd(void * pt) -{ - SgExpression *pte; - - if (!pt) return; - - pte = (SgExpression *) pt; - if (pte->thellnd) - llndTableClass[NODE_ID(pte->thellnd)] = NULL; -} - - -// -// Some Mapping stuff -// -SgStatement * BfndMapping(PTR_BFND bif) -{ - SgStatement *pt = NULL; - if (!bif) - { - return pt; - } - pt = GetMappingInTableForBfnd(bif); - if (pt) - return pt; - else - { - pt = new SgStatement(bif); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - - -// -// Some mapping stuff -// - -SgExpression * LlndMapping(PTR_LLND llin) -{ - SgExpression *pt; - if (!llin) - return NULL; - pt = GetMappingInTableForLlnd(llin); - if (pt) - return pt; - else - { - pt = new SgExpression(llin); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - - -SgSymbol * SymbMapping(PTR_SYMB symb) -{ - SgSymbol *pt = NULL; - if (!symb) - { - return pt; - } - pt = GetMappingInTableForSymbol(symb); - if (pt) - return pt; - else - { - pt = new SgSymbol(symb); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - -SgType * TypeMapping(PTR_TYPE ty) -{ - SgType *pt = NULL; - - if (!ty) - return NULL; - pt = GetMappingInTableForType(ty); - if (pt) - return pt; - else - { - pt = new SgType(ty); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - - - -SgLabel * LabelMapping(PTR_LABEL label) -{ - SgLabel *pt = NULL; - if (!label) - { - return pt; - } - pt = GetMappingInTableForLabel(label); - if (pt) - return pt; - else - { - pt = new SgLabel(label); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - - - -SgValueExp * isSgValueExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case INT_VAL: - case BOOL_VAL: /*podd 3.12.11*/ - case CHAR_VAL: - case FLOAT_VAL: - case DOUBLE_VAL: - case STRING_VAL: - case COMPLEX_VAL: - case KEYWORD_VAL: - return (SgValueExp *) pt; - default: - return NULL; - } -} - - - -SgKeywordValExp * isSgKeywordValExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case KEYWORD_VAL: - return (SgKeywordValExp *) pt; - default: - return NULL; - } -} - - -SgUnaryExp & makeAnUnaryExpression(int code,PTR_LLND ll1); - -// I didn't understand what this function does. -// Should be modified to use LlndMapping. - -SgExpression & SgUnaryExp::operand() -{ - PTR_LLND ll; - SgExpression *pt = NULL; - - ll = NODE_OPERAND0(thellnd); - if (!ll) - ll = NODE_OPERAND1(thellnd); - pt = GetMappingInTableForLlnd(ll); - if (pt) - return *pt; - else - { - pt = new SgExpression(ll); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return *pt; -} - -// Other handy constructors -SgUnaryExp &SgDerefOp(SgExpression &e) - {return makeAnUnaryExpression(DEREF_OP,e.thellnd);} - -SgUnaryExp &SgAddrOp(SgExpression &e) - {return makeAnUnaryExpression(ADDRESS_OP,e.thellnd);} - -SgUnaryExp &SgUMinusOp(SgExpression &e) - {return makeAnUnaryExpression(MINUS_OP,e.thellnd);} - -SgUnaryExp &SgUPlusOp(SgExpression &e) - {return makeAnUnaryExpression(UNARY_ADD_OP,e.thellnd);} - -SgUnaryExp &SgPrePlusPlusOp(SgExpression &e) - {return makeAnUnaryExpression(PLUSPLUS_OP,e.thellnd);} - -SgUnaryExp &SgPreMinusMinusOp(SgExpression &e) - {return makeAnUnaryExpression(MINUSMINUS_OP,e.thellnd);} - -SgUnaryExp &SgPostPlusPlusOp(SgExpression &e) - { SgUnaryExp *pt; - pt = &makeAnUnaryExpression(PLUSPLUS_OP,e.thellnd); - - NODE_OPERAND1(pt->thellnd) = NODE_OPERAND0(pt->thellnd); - NODE_OPERAND0(pt->thellnd) = 0; - return *pt; - } -SgUnaryExp &SgPostMinusMinusOp(SgExpression &e) - { - SgUnaryExp *pt; - pt = &makeAnUnaryExpression(MINUSMINUS_OP,e.thellnd); - - NODE_OPERAND1(pt->thellnd) = NODE_OPERAND0(pt->thellnd); - NODE_OPERAND0(pt->thellnd) = 0; - return *pt; - } -SgUnaryExp &SgBitCompfOp(SgExpression &e) - {return makeAnUnaryExpression(BIT_COMPLEMENT_OP,e.thellnd);} -SgUnaryExp &SgNotOp(SgExpression &e) - {return makeAnUnaryExpression(NOT_OP,e.thellnd);} -SgUnaryExp &SgSizeOfOp(SgExpression &e) - {return makeAnUnaryExpression(SIZE_OP,e.thellnd);} - - -// Add type-checking here. -SgUnaryExp & -makeAnUnaryExpression(int code,PTR_LLND ll1) -{ - PTR_LLND ll; - SgUnaryExp *pt = NULL; - - ll = newExpr(code,NODE_TYPE(ll1),ll1); - pt = new SgUnaryExp(ll); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - return *pt; -} - -SgUnaryExp * isSgUnaryExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DEREF_OP: - case ADDRESS_OP: - case SIZE_OP: - case MINUS_OP: - case UNARY_ADD_OP: - case PLUSPLUS_OP: - case MINUSMINUS_OP: - case BIT_COMPLEMENT_OP: - case NOT_OP: - return (SgUnaryExp *) pt; - default: - return NULL; - } -} - -SgCastExp * isSgCastExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case CAST_OP: - return (SgCastExp *) pt; - default: - return NULL; - } -} - -SgDeleteExp * isSgDeleteExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DELETE_OP: - return (SgDeleteExp *) pt; - default: - return NULL; - } -} - -SgNewExp * isSgNewExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case NEW_OP: - return (SgNewExp *) pt; - default: - return NULL; - } -} - -SgExpression & SgExprIfExp::conditional() -{// expr 1 - PTR_LLND ll; - SgExpression *pt = NULL; - - ll = NODE_OPERAND0(thellnd); - pt = GetMappingInTableForLlnd(ll); - if (pt) - return *pt; - else - { - pt = new SgExpression(ll); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return *pt; -} - -SgExpression & SgExprIfExp::trueExp() -{// expr 2 - PTR_LLND ll = NULL,ll2; - SgExpression *pt = NULL; - ll2 = NODE_OPERAND1(thellnd); - if (ll2) - ll = NODE_OPERAND0(ll2); - else - Message("pb in SgExprIfExp",0); - pt = GetMappingInTableForLlnd(ll); - if (pt) - return *pt; - else - { - pt = new SgExpression(ll); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return *pt; -} - -SgExpression & SgExprIfExp::falseExp() -{// expr 3 - PTR_LLND ll = NULL,ll2; - SgExpression *pt = NULL; - ll2 = NODE_OPERAND1(thellnd); - if (ll2) - ll = NODE_OPERAND1(ll2); - else - Message("pb in SgExprIfExp",0); - pt = GetMappingInTableForLlnd(ll); - if (pt) - return *pt; - else - { - pt = new SgExpression(ll); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return *pt; -} - -void SgExprIfExp::setTrueExp(SgExpression &t) -{ - PTR_LLND ll; - ll = NODE_OPERAND1(thellnd); - if (ll) - NODE_OPERAND0(ll) = t.thellnd; - else - { - NODE_OPERAND1(thellnd)= newExpr(EXPR_IF_BODY,NULL,t.thellnd,NULL); - } -} - -void SgExprIfExp::setFalseExp(SgExpression &f) -{ - PTR_LLND ll; - ll = NODE_OPERAND1(thellnd); - if (ll) - NODE_OPERAND1(ll) = f.thellnd; - else - { - NODE_OPERAND1(thellnd)= newExpr(EXPR_IF_BODY,NULL,NULL,f.thellnd); - } -} - -SgExprIfExp * isSgExprIfExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case EXPR_IF: - return (SgExprIfExp *) pt; - default: - return NULL; - } -} - -SgFunctionCallExp * isSgFunctionCallExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case FUNC_CALL: - return (SgFunctionCallExp *) pt; - default: - return NULL; - } -} - -SgFuncPntrExp * isSgFuncPntrExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case FUNCTION_OP: - return (SgFuncPntrExp *) pt; - default: - return NULL; - } -} - - -void SgExprListExp::linkToEnd(SgExpression &arg) -{ - PTR_LLND lptr; - lptr = Follow_Llnd(thellnd,2); - NODE_OPERAND1(lptr) = arg.thellnd; -} - - -SgExprListExp * isSgExprListExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case EXPR_LIST: - return (SgExprListExp *) pt; - default: - return NULL; - } -} - - -SgProject::SgProject(const char *proj_file_name) -{ - // first let init the library we need - if (!proj_file_name) - { - Message("Cannot open project: no file specified", 0); - exit(1); - } - if (open_proj_toolbox(proj_file_name, proj_file_name) < 0) - { - fprintf(stderr, "%s ", proj_file_name); -#if __SPF - throw -98; -#else - Message("Cannot open project", 0); - exit(1); -#endif - } - Init_Tool_Box(); - - // we have to initialize some specific data for this interface - CurrentProject = this; -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgProject::SgProject(const char* proj_file_name, char** files_list, int no) -{ - // first let init the library we need - if (!proj_file_name) - { - Message("Cannot open project: no file specified", 0); - exit(1); - } - - if (open_proj_files_toolbox(proj_file_name, files_list, no) < 0) - { - fprintf(stderr, "%s ", proj_file_name); -#if __SPF - throw -97; -#else - Message("Cannot open project", 0); - exit(1); -#endif - } - Init_Tool_Box(); - - // we have to initialize some specific data for this interface - CurrentProject = this; -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -int current_file_id; //number of current file -SgFile &SgProject::file(int i) -{ - PTR_FILE file; - SgFile *pt = NULL; - file = GetFileWithNum(i); - SetCurrentFileTo(file); - SwitchToFile(GetFileNumWithPt(file)); - if (!file) - { - Message("SgProject::file; File not found", 0); -#ifdef __SPF - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; -#endif - return *pt; - } - pt = GetMappingInTableForFile(file); - if (!pt) - { - pt = new SgFile(FILE_FILENAME(file)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - - } - - current_file_id = i; - current_file = pt; - -#ifdef __SPF - SgStatement::setCurrProcessFile(pt->filename()); - SgStatement::setCurrProcessLine(0); - last_file_symbol = file->cur_symb; -#endif - return *pt; -} - - - - - -// #ifdef NOT_YET_IMPLEMENTED (No #ifdef because it is used later... PHB) -void SgProject::addFile(char *) -{ - SORRY; -} -//#endif - -#ifdef NOT_YET_IMPLEMENTED -void SgProject::deleteFile(SgFile * file) -{ - SORRY; - return; -} -#endif - -const char* SgFile::filename() -{ - return filept->filename; -} - -SgFile::SgFile(char * dep_file_name) -{ - filept = GetPointerOnFile(dep_file_name); - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - if (!filept) - { - Message("File not found in SgFile; added", 0); - if (CurrentProject) - CurrentProject->addFile(dep_file_name); - } - SetMappingInTableForFile(filept, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgFile::~SgFile() -{ -#if __SPF - removeFromCollection(this); -#endif - RemoveFromTableFile((void *)this); -} - -SgFile::SgFile(SgFile &f) -{ - filept = f.filept; -#ifndef __SPF - Message("SgFile: copy constructor not allowed", 0); -#endif - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -extern "C"{ - int new_empty_file(int, const char *); -} - -SgFile::SgFile(int Language, const char * dep_file_name) -{ - - if (new_empty_file(Language, dep_file_name) == 0) - { - Message("create failed", 0); -#ifdef __SPF - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; -#endif - } - - filept = GetPointerOnFile(dep_file_name); - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - if (!filept) - { - Message("File not found in SgFile; failed!", 0); -#ifdef __SPF - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; -#endif - return; - } - SetMappingInTableForFile(filept, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -static inline std::string replaceSlash(const std::string &in) -{ - std::string out = in; - for (int z = 0; z < in.size(); ++z) - if (out[z] == '\\') - out[z] = '/'; - return out; -} - -std::map > SgFile::files; -int SgFile::switchToFile(const std::string &name) -{ - std::map >::iterator it = files.find(replaceSlash(name)); - if (it == files.end()) - return -1; - else - { - if (current_file_id != it->second.second) - { - SgFile *file = &(CurrentProject->file(it->second.second)); - current_file_id = it->second.second; - current_file = file; - - SgStatement::setCurrProcessFile(file->filename()); - SgStatement::setCurrProcessLine(0); - last_file_symbol = current_file->filept->cur_symb; - } - } - - return it->second.second; -} - -void SgFile::addFile(const std::pair &toAdd) -{ - files[replaceSlash(toAdd.first->filename()).c_str()] = toAdd; -} - - -std::map, SgStatement*> > SgStatement::statsByLine; -std::map SgStatement::parentStatsForExpression; - -bool SgStatement::consistentCheckIsActivated = false; -bool SgStatement::deprecatedCheck = false; -std::string SgStatement::currProcessFile = ""; -int SgStatement::currProcessLine = -1; -bool SgStatement::sapfor_regime = false; - -void SgStatement::checkConsistence() -{ -#if __SPF - if (consistentCheckIsActivated && fileID != current_file_id && fileID != -1) - { - const int var = variant(); - if (var < 950) // not SPF DIRS - { - //unparsestdout(); - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp, file id was inconsistent: current id = %d, was id = %d\n", __LINE__, current_file_id, fileID); - addToGlobalBufferAndPrint(buf); - throw(-1); - } - } -#endif -} - -void SgStatement::checkDepracated() -{ -#if __SPF - if (deprecatedCheck) - { - //unparsestdout(); - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp, deprecated operators are used\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw(-1); - } -#endif -} - -void SgStatement::checkCommentPosition(const char* com) -{ -#if __SPF - checkConsistence(); - if (variant() == GLOBAL) - return; - - SgStatement* prev = lexPrev(); - if (prev && (prev->variant() == LOGIF_NODE || prev->variant() == FORALL_STAT)) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp, unsupported comments modification after LOGIF and FORALL statements, user line %d (prev %d), statement variant %d, prev statement variant %d, '%s'\n", - __LINE__, lineNumber(), prev->lineNumber(), variant(), prev->variant(), com); - addToGlobalBufferAndPrint(buf); - throw(-1); - } -#endif -} - -void SgStatement::updateStatsByLine(std::map, SgStatement*> &toUpdate) -{ - PTR_BFND node = current_file->firstStatement()->thebif; - for (; node; node = node->thread) - { - SgStatement *st = BfndMapping(node); - toUpdate[std::make_pair(replaceSlash(st->fileName()), st->lineNumber())] = st; - } -} - -SgStatement* SgStatement::getStatementByFileAndLine(const std::string &fName, const int lineNum) -{ - const int fildID = SgFile::switchToFile(fName); - std::map, SgStatement*> >::iterator itID = statsByLine.find(fildID); - if (itID == statsByLine.end()) - itID = statsByLine.insert(itID, std::make_pair(fildID, std::map, SgStatement*>())); - - if (itID->second.size() == 0) - updateStatsByLine(itID->second); - - std::map, SgStatement*>::iterator itPair = itID->second.find(make_pair(replaceSlash(fName), lineNum)); - if (itPair == itID->second.end()) - return NULL; - else - return itPair->second; -} - -void SgStatement::updateStatsByExpression(SgStatement *where, SgExpression *what) -{ - if (what) - { - parentStatsForExpression[what] = where; - - updateStatsByExpression(where, what->lhs()); - updateStatsByExpression(where, what->rhs()); - } -} - -void SgStatement::updateStatsByExpression() -{ - SgFile* save = current_file; - const int save_id = current_file_id; - - for (int i = 0; i < CurrentProject->numberOfFiles(); ++i) - { - SgFile *file = &(CurrentProject->file(i)); - current_file_id = i; - current_file = file; - - PTR_BFND node = current_file->firstStatement()->thebif; - for (; node; node = node->thread) - { - SgStatement *st = BfndMapping(node); - for (int z = 0; z < 3; ++z) - updateStatsByExpression(st, st->expr(z)); - } - } - - CurrentProject->file(save_id); - current_file_id = save_id; - current_file = save; -} - -SgStatement* SgStatement::getStatmentByExpression(SgExpression* toFind) -{ - if (parentStatsForExpression.size() == 0) - updateStatsByExpression(); - - std::map::iterator itS = parentStatsForExpression.find(toFind); - if (itS == parentStatsForExpression.end()) - return NULL; - else - return itS->second; -} - -SgStatement* SgFile::functions(int i) -{ - PTR_BFND bif; - SgStatement *pt = NULL; - - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - bif = getFunctionNumHeader(i); - if (!bif) - { - Message("SgFile::functions; Function not found",0); -#ifdef __SPF - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; -#endif - return pt; - } - pt = GetMappingInTableForBfnd(bif); - if (pt) - return pt; - else - { - pt = new SgStatement(bif); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - - - -SgStatement *SgFile::getStruct(int i) -{ - PTR_BFND bif; - SgStatement *pt = NULL; - - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - bif = getStructNumHeader(i); - if (!bif) - { - Message("SgFile::getStruct; Struct not found",0); - return pt; - } - pt = GetMappingInTableForBfnd(bif); - if (pt) - return pt; - else - { - pt = new SgStatement(bif); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - - - -SgStatement::SgStatement(int variant) -{ - if (!isABifNode(variant)) - { - Message("Attempt to create a bif node with a variant that is not", 0); -#ifdef __SPF - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; -#endif - // arbitrary choice for the variant - thebif = (PTR_BFND)newNode(BASIC_BLOCK); - } - else - thebif = (PTR_BFND)newNode(variant); - SetMappingInTableForBfnd(thebif, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - unparseIgnore = false; -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgStatement::SgStatement(SgStatement &s) -{ -#ifndef __SPF - Message("SgStatement: copy constructor not allowed", 0); -#endif - thebif = s.thebif; - -#if __SPF - fileID = s.getFileId(); - project = s.getProject(); - unparseIgnore = s.getUnparseIgnore(); - - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - - -SgStatement::~SgStatement() -{ -#if __SPF - removeFromCollection(this); -#endif - RemoveFromTableBfnd((void *)this); -} - -void SgStatement::insertStmtAfter(SgStatement &s,SgStatement &cp) -{ -#ifdef __SPF - checkConsistence(); - //convert to simple IF - if (cp.variant() == LOGIF_NODE) - { - SgControlEndStmt* control = new SgControlEndStmt(); - cp.setVariant(IF_NODE); - this->insertStmtAfter(*control, cp); - } -#endif - - insertBfndListIn(s.thebif,thebif,cp.thebif); -} - - -SgStatement::SgStatement(PTR_BFND bif) -{ - thebif = bif; - SetMappingInTableForBfnd(thebif, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - unparseIgnore = false; -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - - -SgExpression * SgStatement::expr(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - PTR_LLND ll; - switch (i) - { - case 0: - ll = BIF_LL1(thebif); - break; - case 1: - ll = BIF_LL2(thebif); - break; - case 2: - ll = BIF_LL3(thebif); - break; - default: - ll = BIF_LL1(thebif); - Message("A bif node can only have 3 expressions (0,1,2)",BIF_LINE(thebif)); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - return LlndMapping(ll); -} - - - - -SgLabel *SgStatement::label() -{ -#ifdef __SPF - checkConsistence(); -#endif - PTR_LABEL lab; - SgLabel *pt = NULL; - lab = BIF_LABEL(thebif); - if (!lab) - { - // Message("The bif has no label",BIF_LINE(thebif)); - return pt; - } - pt = GetMappingInTableForLabel(lab); - if (pt) - return pt; - else - { - pt = new SgLabel(lab); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, pt, 1); -#endif - } - return pt; -} - -void SgStatement::setExpression(int i, SgExpression &e) -{ -#ifdef __SPF - checkConsistence(); -#endif - switch (i) - { - case 0: - BIF_LL1(thebif) = e.thellnd; - break; - case 1: - BIF_LL2(thebif) = e.thellnd; - break; - case 2: - BIF_LL3(thebif) = e.thellnd; - break; - default: - Message("A bif node can only have 3 expressions (0, 1, 2)", BIF_LINE(thebif)); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } -} - -void SgStatement::setExpression(int i, SgExpression *e) -{ -#ifdef __SPF - checkConsistence(); -#endif - switch (i) - { - case 0: - if (e) - BIF_LL1(thebif) = e->thellnd; - else - BIF_LL1(thebif) = NULL; - break; - case 1: - if (e) - BIF_LL2(thebif) = e->thellnd; - else - BIF_LL2(thebif) = NULL; - break; - case 2: - if (e) - BIF_LL3(thebif) = e->thellnd; - else - BIF_LL3(thebif) = NULL; - break; - default: - Message("A bif node can only have 3 expressions (0, 1, 2)", BIF_LINE(thebif)); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } -} - - -SgStatement* SgStatement::nextInChildList() -{ -#ifdef __SPF - checkConsistence(); -#endif - PTR_BLOB blob; - SgStatement *x; - - if (BIF_CP(thebif)) - { - blob = lookForBifInBlobList(BIF_BLOB1(BIF_CP(thebif)), thebif); - if (!blob) - blob = lookForBifInBlobList(BIF_BLOB2(BIF_CP(thebif)), thebif); - if (blob) - blob = BLOB_NEXT(blob); - if (blob) - x = BfndMapping(BLOB_VALUE(blob)); - else x = NULL; - } - else - x = NULL; - - return x; -} - -std::string SgStatement::sunparse(int lang) -{ -#ifdef __SPF - checkConsistence(); -#endif - return std::string(unparse(lang)); -} - - -#ifdef NOT_YET_IMPLEMENTED -int SgStatement::numberOfComments() -{ - SORRY; - return 0; -} -#endif - -void SgStatement::addComment(const char *com) -{ - checkCommentPosition(com); - LibAddComment(thebif,com); -} - -void SgStatement::addComment(char *com) -{ - checkCommentPosition(com); - LibAddComment(thebif,com); -} - -#ifdef NOT_YET_IMPLEMENTED -int SgStatement::hasAnnotations() -{ - SORRY; - return 0; -} -#endif - -int SgStatement::IsSymbolInScope(SgSymbol &symb) -{ -#ifdef __SPF - checkConsistence(); -#endif - return LibIsSymbolInScope(thebif,symb.thesymb); -} - -int SgStatement::IsSymbolReferenced(SgSymbol &symb) -{ -#ifdef __SPF - checkConsistence(); -#endif - return LibIsSymbolReferenced(thebif,symb.thesymb); -} - -SgExpression::~SgExpression() -{ -#if __SPF - removeFromCollection(this); -#endif - RemoveFromTableLlnd((void *)this); -} - -SgExpression::SgExpression(SgExpression &e) -{ -#ifndef __SPF - Message("SgExpression: copy constructor not allowed", 0); -#endif - thellnd = e.thellnd; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgExpression::SgExpression(int variant) -{ - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - SetMappingInTableForLlnd(thellnd, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - - -SgExpression::SgExpression(PTR_LLND ll) -{ - thellnd = ll; - SetMappingInTableForLlnd(thellnd, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgExpression::SgExpression(int variant, SgExpression &lhs, SgExpression &rhs, - SgSymbol &s, SgType &type) -{ - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - SetMappingInTableForLlnd(thellnd, (void *)this); - NODE_OPERAND0(thellnd) = lhs.thellnd; - NODE_OPERAND1(thellnd) = rhs.thellnd; - NODE_SYMB(thellnd) = s.thesymb; - NODE_TYPE(thellnd) = type.thetype; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -/* Pointer constructor by ajm 26-Jan-94. */ - SgExpression::SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s, SgType *type) - { - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - SetMappingInTableForLlnd(thellnd, (void *)this); - NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); - NODE_OPERAND1(thellnd) = ((rhs != 0) ? rhs->thellnd : 0); - NODE_SYMB(thellnd) = ((s != 0) ? s->thesymb : 0); - - /* If we ever get T_NOTYPE, put that here. */ - NODE_TYPE(thellnd) = ((type != 0) ? type->thetype : 0); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - SgExpression::SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s) - { - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - SetMappingInTableForLlnd(thellnd, (void *)this); - NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); - NODE_OPERAND1(thellnd) = ((rhs != 0) ? rhs->thellnd : 0); - NODE_SYMB(thellnd) = ((s != 0) ? s->thesymb : 0); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - SgExpression::SgExpression(int variant, SgExpression* lhs, SgExpression* rhs) - { - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - SetMappingInTableForLlnd(thellnd, (void*)this); - NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); - NODE_OPERAND1(thellnd) = ((rhs != 0) ? rhs->thellnd : 0); - NODE_SYMB(thellnd) = 0; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - SgExpression::SgExpression(int variant, SgExpression* lhs) - { - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - SetMappingInTableForLlnd(thellnd, (void*)this); - NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); - NODE_OPERAND1(thellnd) = 0; - NODE_SYMB(thellnd) = 0; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - -SgSymbol *SgExpression::symbol() -{ - /* Value expressions do not have valid symbol pointers */ - if ( isSgValueExp (this) ) - return NULL; - else - return SymbMapping(NODE_SYMB(thellnd)); -} - - - - -SgExpression *SgExpression::operand(int i) -{ - PTR_LLND ll; - switch (i) - { - case 1: - ll = NODE_OPERAND0(thellnd); - break; - case 2: - ll = NODE_OPERAND1(thellnd); - break; - default: - ll = NODE_OPERAND0(thellnd); - Message("A ll node can only have 2 child (1,2)",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - return LlndMapping(ll); -} - -std::string SgExpression::sunparse() -{ - return std::string(unparse()); -} - - -#define ERR_TOOMANYSYMS -1 - -int SgExpression::linearRepresentation(int *coeff, SgSymbol **symb, int *cst, int size) -{ - const int maxElem = 300; - PTR_SYMB *ts = new PTR_SYMB[maxElem]; - int i; - if (!symb || !coeff || !cst) - return 0; - if (size > maxElem) - { - Message(" Too many symbols in linearRepresentation ", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - return ERR_TOOMANYSYMS; - } - for (i = 0; i < size; i++) - ts[i] = symb[i]->thesymb; - - int retVal = buildLinearRep(thellnd, coeff, ts, size, cst); - delete ts; - return retVal; -} - - - -#ifdef NOT_YET_IMPLEMENTED -SgExpression *SgExpression::normalForm(int n, SgSymbol *s) -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -SgExpression *SgExpression::coefficient(SgSymbol &s) -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -int SgExpression::isInteger() -{ - int *res; - int resul = 0; - res = evaluateExpression(thellnd); - if (res[0] != -1) - { - resul = 1; - } -#ifdef __SPF - removeFromCollection(res); -#endif - free(res); - return resul; -} - -int SgExpression::valueInteger() -{ - int *res; - int resul = 0; - res = evaluateExpression(thellnd); - if (res[0] != -1) - { - resul = res[1]; - } -#ifdef __SPF - removeFromCollection(res); -#endif - free(res); - return resul; -} - -SgExpression & -makeAnBinaryExpression(int code,SgExpression *ll1,SgExpression *ll2) -{ - //SgExpression *resul = NULL; - if (ll1 && ll2) - return *LlndMapping(newExpr(code,NODE_TYPE(ll1->thellnd),ll1->thellnd,ll2->thellnd)); - else - if (ll1) - return *LlndMapping(newExpr(code,NODE_TYPE(ll1->thellnd),ll1->thellnd,NULL)); - else - if (ll2) - return *LlndMapping(newExpr(code,NODE_TYPE(ll2->thellnd),NULL,ll2->thellnd)); - else - return *LlndMapping(newExpr(code,NULL,NULL,NULL)); - //return *resul; never reached -} - - -SgExpression & -makeAnBinaryExpression(int code,PTR_LLND ll1,PTR_LLND ll2) -{ - - return *LlndMapping(newExpr(code,NODE_TYPE(ll1),ll1,ll2)); -} - -SgExpression &operator + ( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(ADD_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator - ( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(SUBT_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator * ( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(MULT_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator / ( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(DIV_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator % ( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(MOD_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator <<( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(LSHIFT_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator >>( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(RSHIFT_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression &operator < ( SgExpression &lhs, SgExpression &rhs) -{ - return makeAnBinaryExpression(LT_OP,lhs.thellnd,rhs.thellnd); -} - -SgExpression &operator > ( SgExpression &lhs, SgExpression &rhs) -{ - return makeAnBinaryExpression(GT_OP,lhs.thellnd,rhs.thellnd); -} - - -SgExpression &operator <= ( SgExpression &lhs, SgExpression &rhs) -{ - if (CurrentProject->Fortranlanguage()) - return makeAnBinaryExpression(LTEQL_OP,lhs.thellnd,rhs.thellnd); - else - return makeAnBinaryExpression(LE_OP,lhs.thellnd,rhs.thellnd); -} - -SgExpression &operator >= ( SgExpression &lhs, SgExpression &rhs) -{ - if (CurrentProject->Fortranlanguage()) - return makeAnBinaryExpression(GTEQL_OP,lhs.thellnd,rhs.thellnd); - else - return makeAnBinaryExpression(GE_OP,lhs.thellnd,rhs.thellnd); -} - -SgExpression& operator &( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(BITAND_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator |( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(BITOR_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator &&( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(AND_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator ||( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(OR_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator +=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(PLUS_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator &=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(AND_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator *=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(MULT_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator /=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(DIV_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator %=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(MOD_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator ^=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(XOR_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator <<=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(LSHIFT_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator >>=( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(RSHIFT_ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression& operator==(SgExpression &lhs, SgExpression &rhs) -{ return SgEqOp(lhs, rhs); } - -SgExpression& operator!=(SgExpression &lhs, SgExpression &rhs) -{ return SgNeqOp(lhs, rhs); } - -SgExpression &SgAssignOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(ASSGN_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgEqOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(EQ_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgNeqOp( SgExpression &lhs, SgExpression &rhs) -{ - if (CurrentProject->Fortranlanguage()) - return makeAnBinaryExpression(NOTEQL_OP,lhs.thellnd,rhs.thellnd); - else - return makeAnBinaryExpression(NE_OP,lhs.thellnd,rhs.thellnd); -} - -SgExpression &SgExprListOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(EXPR_LIST,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgRecRefOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(RECORD_REF,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgPointStOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(POINTST_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgScopeOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(SCOPE_OP,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgDDotOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(DDOT,lhs.thellnd,rhs.thellnd);} - -SgExpression & SgBitNumbOp( SgExpression &lhs, SgExpression &rhs) -{return makeAnBinaryExpression(BIT_NUMBER,lhs.thellnd,rhs.thellnd);} - - - - - - -// For correctness of symbol creation, it is -// necessary to have a symbol table of some form to -// ensure there are no duplicate symbols being -// created. - -SgSymbol::SgSymbol(int variant, const char *name) -{ - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, name, NULL); - } - else - thesymb = newSymbol(variant, name, NULL); - - SYMB_TYPE(thesymb) = GetAtomicType(T_INT); - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgSymbol::SgSymbol(int variant) -{ - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, NULL, NULL); - } - else - thesymb = newSymbol(variant, NULL, NULL); - SYMB_TYPE(thesymb) = GetAtomicType(T_INT); - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgSymbol::SgSymbol(PTR_SYMB symb) -{ - thesymb = symb; - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -#if __SPF -SgSymbol::SgSymbol(const SgSymbol &s) -{ - thesymb = s.thesymb; - - fileID = s.fileID; - project = s.project; -// Message("SgSymbol: no copy constructor allowed", 0); - addToCollection(__LINE__, __FILE__, this, 1); -} -#endif - -SgSymbol::SgSymbol(int variant, const char *identifier, SgType &t, SgStatement &scope) - { - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); - } - else - thesymb = newSymbol(variant, identifier, NULL); - - SYMB_TYPE(thesymb) = t.thetype; - SYMB_SCOPE(thesymb) = scope.thebif; - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - SgSymbol::SgSymbol(int variant, const char *identifier, SgType *t, SgStatement *scope) - { - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); - } - else - thesymb = newSymbol(variant, identifier, NULL); - - if (t != 0) - { - SYMB_TYPE(thesymb) = t->thetype; - } - else - { - SYMB_TYPE(thesymb) = 0; - } - - if (scope != 0) - { - SYMB_SCOPE(thesymb) = scope->thebif; - } - else - { - SYMB_SCOPE(thesymb) = 0; - } - - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - SgSymbol::SgSymbol(int variant, const char *identifier, SgStatement &scope) - { - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); - } - else - thesymb = newSymbol(variant, identifier, NULL); - - SYMB_TYPE(thesymb) = GetAtomicType(T_INT); - SYMB_SCOPE(thesymb) = scope.thebif; - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - - SgSymbol::SgSymbol(int variant, const char *identifier, SgStatement *scope) - { - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); - } - else - thesymb = newSymbol(variant, identifier, NULL); - - SYMB_TYPE(thesymb) = GetAtomicType(T_INT); - SYMB_SCOPE(thesymb) = (scope == 0) ? 0 : scope->thebif; - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif - } - - SgSymbol::~SgSymbol() - { -#if __SPF - removeFromCollection(this); -#endif - RemoveFromTableSymb((void *)this); - } - -SgStatement *SgSymbol::declaredInStmt() -{ - return BfndMapping(LibWhereIsSymbDeclare(thesymb)); - -} - -int SgSymbol::attributes() -{ - return SYMB_ATTR(thesymb); -} - -void SgSymbol::setAttribute(int attribute) -{ - SYMB_ATTR(thesymb) |= attribute; -} - -void SgSymbol::removeAttribute(int attribute) -{ - SYMB_ATTR(thesymb) ^= attribute; -} - -SgStatement *SgSymbol::body() -{ - PTR_BFND bif = NULL; - PTR_TYPE type; - // there is a function low_level.c that does it. - if ((SYMB_CODE(thesymb) == COLLECTION_NAME) || - (SYMB_CODE(thesymb) == CLASS_NAME)|| - (SYMB_CODE(thesymb) == TECLASS_NAME)) - { - type = SYMB_TYPE(thesymb); - if (type) - { - bif = TYPE_COLL_ORI_CLASS(type); - } else - { - Message("Body of collection or class not found",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - } else - { - if ((SYMB_CODE(thesymb) == FUNCTION_NAME) || - (SYMB_CODE(thesymb) == PROGRAM_NAME) || - (SYMB_CODE(thesymb) == PROCEDURE_NAME) || - (SYMB_CODE(thesymb) == MEMBER_FUNC)) - { - bif = SYMB_FUNC_HEDR(thesymb); // needed, otherwise breaks pC++ - if (!bif) - bif = getFunctionHeader(thesymb); - } else - { - Message("Body not found, may not be implemented yet",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - SORRY; - } - } - - return BfndMapping(bif); -} - - - - -SgType::SgType(int variant) -{ - if (!isATypeNode(variant)) - { - Message("Attempt to create a type node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thetype = (PTR_TYPE)newNode(T_INT); - } - else - thetype = (PTR_TYPE)newNode(variant); - SetMappingInTableForType(thetype, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - - -/* This code by Andrew Mauer (ajm) */ -/* - maskDescriptors: - - This routine strips many descriptive type traits which you are probably - not interested in cloning for variable declarations, etc. - - Returns the getTrueType of the base type being described IF there - are no descriptors which are not masked out. The following masks - can be specified as an optional second argument: - MASK_NO_DESCRIPTORS: Do not mask out anything. - MASK_MOST_DESCRIPTORS: Only leave in: signed, unsigned, short, long, - const, volatile. - MASK_ALL_DESCRIPTORS: Mask out everything. - - If you build your own mask, you should make sure that the traits - you want to set out have their bits UN-set, and the rest should have - their bits set. The complementation (~) operator is a good one to use. - - See libSage++.h, where the MASK_*_DESCRIPTORS variables are defined. -*/ - -/* Thanks a lot for the stupid $@!@$ #ifdef USER in libSage++.h */ -class SgDerivedType; -SgDescriptType *isSgDescriptType(SgType *pt); -SgPointerType *isSgPointerType(SgType *pt); -SgArrayType *isSgArrayType(SgType *pt); -SgDerivedType *isSgDerivedType(SgType *pt); - -SgType *SgType::maskDescriptors (int mask) -{ - if ( ! isSgDescriptType(this)) - return this; - - int current_bits_set = isSgDescriptType(this)->modifierFlag(); - - if ( (current_bits_set & mask ) == 0 ) - { - return this->baseType()->getTrueType(mask,0); - } - else if ( current_bits_set != (current_bits_set & mask) ) - { - /* Mask has changed bits set. Need to build the new type - with the unwanted bits masked off. */ - - SgDescriptType *t_new = isSgDescriptType(&this->copy()); - - t_new->setModifierFlag( current_bits_set & mask ); - - return t_new; - } - else - { - return this; - } -} - -/* This code by Andrew Mauer (ajm) */ -/* - getTrueType: - - Since Sage stores dereferenced pointers as PTR(-1) -> PTR(1) -> BASE_TYPE, - we may need to follow the chain of dereferencing to find the type - which we expect. - - This code currently assumes that: - o If you follow the dereferencing pointer (PTR(-1)), you find another - pointer type or an array type. - - We do NOT assume that the following situation cannot occur: - PTR(-1) -> PTR(-1) -> PTR(1) -> PTR(1) -> PTR(-1) -> PTR(1) - - This means there may be more pointers to follow after we come to - an initial "equilibrium". - - ALGORITHM: - - T_POINTER: - [WARNING: No consideration is given to pointers with attributes - (ls_flags) set. For instance, a const pointer is treated the same - as any other pointer.] - - 1. Return the same type we got if it is not a pointer type or - the pointer is not a dereferencing pointer type. - - 2. Repeat { get next pointer , add its indirection to current total } - until the current total is 0. We have reached an equilibrium, so - the next type will not necessarily be a pointer type. - - 3. Check the next type for further indirection with another call - to getTrueType. - - T_DESCRIPT: - Returns the result of maskDescriptors called with the given type and mask. - - T_ARRAY: - If the array has zero dimensions, we pass over it. This type arose - for me in the following situation: - double x[2]; - x[1] = 0; - - T_DERIVED_TYPE: - If we have been told to follow typedefs, get the type of the - symbol from which this type is derived from, and continue digging. - Otherwise return this type. - - - HITCHES: - Some programs may dereference a T_ARRAY as a pointer, so we need - to be prepared to deal with that. - */ - -SgType *SgType::getTrueType (int mask, int follow_typedefs) -{ - switch (this->variant()) - { - case T_POINTER: - { - SgType *next = NULL; - SgType *current = NULL; - int current_indirection; - - current = this; - - current_indirection = - isSgPointerType(current)->indirection(); - - if (current_indirection > 0) - return this; - - while (current_indirection < 0) - { - // Get next type - next = current->baseType(); - - if ( isSgPointerType (next) ) - { - // add indirection to current - current_indirection += - isSgPointerType(next)->indirection(); - } - else if ( isSgArrayType (next) ) - { - /* One level of indirection for each dimension. */ - current_indirection += - isSgArrayType(next)->dimension(); - } - else - { - /* Don't know what's going on. Fix me. - This includes the case of ptr not having - a base type, so next = NULL. */ - abort(); - } - current = next; - } - - return next->getTrueType(mask, follow_typedefs); - } - //break; - - case T_DESCRIPT: - return this->maskDescriptors (mask); - //break; - case T_DERIVED_TYPE: - { - if ( follow_typedefs ) - { - SgDerivedType *derived_type = isSgDerivedType (this); - - return - (derived_type->typeName()->type()) - ->getTrueType(mask, follow_typedefs); - } - else - { - return this; - } - //break; - } - case T_ARRAY: - { - SgArrayType *the_array = isSgArrayType(this); - if (the_array->dimension() == 0) - { - return the_array->baseType()->getTrueType(mask, - follow_typedefs); - } - else - { - return this; - } - } - default: - return this; - //break; - } -} - - -SgType *SgTypeInt() -{ - return TypeMapping(GetAtomicType(T_INT)); -} - - -SgType *SgTypeChar() -{ - return TypeMapping(GetAtomicType(T_CHAR)); -} - -SgType *SgTypeFloat() -{ - return TypeMapping(GetAtomicType(T_FLOAT)); -} - -SgType *SgTypeDouble() -{ - return TypeMapping(GetAtomicType(T_DOUBLE)); -} - -SgType *SgTypeVoid() -{ - return TypeMapping(GetAtomicType(T_VOID)); -} - -SgType *SgTypeBool() -{ - return TypeMapping(GetAtomicType(T_BOOL)); -} - -SgType *SgTypeDefault() -{ - return TypeMapping(GetAtomicType(DEFAULT)); -} - - - -// -// -// Subclass for reference to symbol -// -// - - -SgRefExp * isSgRefExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case CONST_REF: - case TYPE_REF: - case INTERFACE_REF: - return (SgRefExp *) pt; - default: - return NULL; - } -} - -#ifdef NOT_YET_IMPLEMENTED -SgExpression * SgVarRefExp::progatedValue() - { - SORRY; // if scalar propogation worked - return (SgExpression *) NULL; - } -#endif - - -SgVarRefExp * isSgVarRefExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case VAR_REF: - return (SgVarRefExp *) pt; - default: - return NULL; - } -} - -SgThisExp * isSgThisExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case THIS_NODE: - return (SgThisExp *) pt; - default: - return NULL; - } -} - - -SgArrayRefExp * isSgArrayRefExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case ARRAY_REF: - return (SgArrayRefExp *) pt; - default: - return NULL; - } -} - - - -SgPntrArrRefExp * isSgPntrArrRefExp(SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case ARRAY_OP: - return (SgPntrArrRefExp *) pt; - default: - return NULL; - } -} - -SgPointerDerefExp * isSgPointerDerefExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DEREF_OP: - return (SgPointerDerefExp *) pt; - default: - return NULL; - } -} - - -SgRecordRefExp * isSgRecordRefExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case RECORD_REF: - return (SgRecordRefExp *) pt; - default: - return NULL; - } -} - -SgStructConstExp* isSgStructConstExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case STRUCTURE_CONSTRUCTOR: - return (SgStructConstExp *) pt; - default: - return NULL; - } -} - -SgConstExp* isSgConstExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case CONSTRUCTOR_REF: - return (SgConstExp *) pt; - default: - return NULL; - } -} - - -SgVecConstExp * isSgVecConstExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case VECTOR_CONST: - return (SgVecConstExp *) pt; - default: - return NULL; - } -} - -SgInitListExp * isSgInitListExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case INIT_LIST: - return (SgInitListExp *) pt; - default: - return NULL; - } -} - -SgObjectListExp * isSgObjectListExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case EQUI_LIST: - case NAMELIST_LIST: - case COMM_LIST: - return (SgObjectListExp *) pt; - default: - return NULL; - } -} - - -SgAttributeExp * isSgAttributeExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case PARAMETER_OP: - case PUBLIC_OP: - case PRIVATE_OP: - case ALLOCATABLE_OP: - case DIMENSION_OP: - case EXTERNAL_OP: - case IN_OP: - case OUT_OP: - case INOUT_OP: - case INTRINSIC_OP: - case POINTER_OP: - case OPTIONAL_OP: - case SAVE_OP: - case TARGET_OP: - return (SgAttributeExp *) pt; - default: - return NULL; - } -} - - - -SgKeywordArgExp * isSgKeywordArgExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case KEYWORD_ARG: - return (SgKeywordArgExp *) pt; - default: - return NULL; - } -} - -SgSubscriptExp* isSgSubscriptExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DDOT: - return (SgSubscriptExp *) pt; - default: - return NULL; - } -} - -SgUseOnlyExp * isSgUseOnlyExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case ONLY_NODE: - return (SgUseOnlyExp *) pt; - default: - return NULL; - } -} - -SgUseRenameExp * isSgUseRenameExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case RENAME_NODE: - return (SgUseRenameExp *) pt; - default: - return NULL; - } -} - - -SgSpecPairExp * isSgSpecPairExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case SPEC_PAIR: - return (SgSpecPairExp *) pt; - default: - return NULL; - } -} - -SgIOAccessExp * isSgIOAccessExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case IOACCESS: - return (SgIOAccessExp *) pt; - default: - return NULL; - } -} - - -SgImplicitTypeExp * isSgImplicitTypeExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case IMPL_TYPE: - return (SgImplicitTypeExp *) pt; - default: - return NULL; - } -} - -SgTypeExp * isSgTypeExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case TYPE_OP: - return (SgTypeExp *) pt; - default: - return NULL; - } -} - -SgSeqExp * isSgSeqExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case SEQ: - return (SgSeqExp *) pt; - default: - return NULL; - } -} - -SgStringLengthExp * isSgStringLengthExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case LEN_OP: - return (SgStringLengthExp *) pt; - default: - return NULL; - } -} - -SgDefaultExp * isSgDefaultExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DEFAULT: - return (SgDefaultExp *) pt; - default: - return NULL; - } -} - - -SgLabelRefExp * isSgLabelRefExp (SgExpression *pt) -{ - - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case LABEL_REF: - return (SgLabelRefExp *) pt; - default: - return NULL; - } -} - -/////////////////////////////////////////////////////////////////////////////// -// // -// // -// We add the subclass for statements here. // -// Need more comment and so on ........ // -// Reorganizing that file may be necessary sometimes // -// // -/////////////////////////////////////////////////////////////////////////////// - - - -SgProgHedrStmt * isSgProgHedrStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROC_HEDR: - case FUNC_HEDR: - case PROG_HEDR: - return (SgProgHedrStmt *) pt; - default: - return NULL; - } -} - -SgProcHedrStmt * isSgProcHedrStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case FUNC_HEDR: - case PROC_HEDR: - return (SgProcHedrStmt *) pt; - default: - return NULL; - } -} - -SgFunctionType *isSgFunctionType(SgType *); - -SgExpression *SgMakeDeclExp(SgSymbol *sym, SgType *t) { - SgExpression *s = NULL; - int first = 1, done = 0; - SgType *tsave = t; - if ((sym != NULL) && (t != NULL)) - sym->setType(*t); - while ((!done) && (t != NULL)) { - // printf("loop var = %d\n", t->variant()); - switch (t->variant()) { - case T_POINTER: - if (first) { - s = new SgVarRefExp(sym); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - s->setType(*tsave); - } - s = &SgDerefOp(*s); - s->setType(*t); // this is wrong but it is consistant with parser. - t = t->baseType(); - // s->setType(*t); this should be correct, but because of paser.. - first = 0; - break; - case T_REFERENCE: - if (first) { - s = new SgVarRefExp(sym); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - s->setType(*tsave); - } - s = &SgAddrOp(*s); - s->setType(*t); // this is wrong but it is consistant with parser. - t = t->baseType(); - // s->setType(*t); this should be correct, but because of paser.. - first = 0; - break; - case T_ARRAY: { - SgArrayType *art = isSgArrayType(t); - if (first) { - s = new SgArrayRefExp(*sym, *(art->getDimList())); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - } - else { - s = new SgPntrArrRefExp(*s, *(art->getDimList())); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - } - t = t->baseType(); - s->setType(*tsave); - first = 0; - } - break; - case T_FUNCTION: { - SgFunctionType *f = isSgFunctionType(t); - if (s == NULL) - { - Message("error in AddArg", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - return NULL; - } - s = new SgFuncPntrExp(*s); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - t = f->returnedValue(); - s->setType(*t); - first = 0; - } - break; - case T_DESCRIPT: - t = t->baseType(); - break; - default: - done = 1; - if (first) { - s = new SgVarRefExp(sym); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - s->setType(*tsave); - } - first = 0; - break; - } - } - return s; -} - -SgExpression * SgFuncPntrExp::AddArg(SgSymbol *f, char *name, SgType &t) - // to add a parameter to pointer - // to a function or to a pointer to an array of functions -{ - PTR_SYMB symb; - SgExpression *arg = NULL; - SgSymbol *s; - if (!f) - { - Message("SgFuncPntrExp::AddArg: must have non-null funct. symb", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - s = new SgVariableSymb(name, t, *f->scope()); //create the variable with scope -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - symb = s->thesymb; - appendSymbToArgList(f->thesymb,symb); - - if(LibFortranlanguage()) - { - Message("Fortran function args do not have arg lists", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - else{ - arg = SgMakeDeclExp(s, &t); - NODE_OPERAND1(this->thellnd) = - addToExprList(NODE_OPERAND1(this->thellnd),arg->thellnd); - } - return arg; -} - -SgExpression * SgProcHedrStmt::AddArg(char *name, SgType &t) -{ - PTR_SYMB symb; - PTR_LLND ll; - SgExpression *arg; - SgSymbol *s; - - s = new SgVariableSymb(name, t, *this); //create the variable with scope -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - symb = s->thesymb; - appendSymbToArgList(BIF_SYMB(thebif),symb); - - if(LibFortranlanguage()){ - arg = new SgVarRefExp(*s); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, arg, 1); -#endif - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg->thellnd); - declareAVar(symb,thebif); - } - else{ - arg = SgMakeDeclExp(s, &t); - ll = BIF_LL1(thebif); - ll = NODE_OPERAND0(ll); - NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg->thellnd); - } - return arg; -} - -SgExpression * SgProcHedrStmt::AddArg(char *name, SgType &t, SgExpression &init) -{ - PTR_SYMB symb; - PTR_LLND ll; - SgExpression *arg, *ref; - SgSymbol *s; - - if(LibFortranlanguage()){ - Message("no initializer allowed for fortran parameters",0); - } - - s = new SgVariableSymb(name, t, *this); //create the variable with scope -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - symb = s->thesymb; - appendSymbToArgList(BIF_SYMB(thebif),symb); - ref = SgMakeDeclExp(s, &t); - arg = &SgAssignOp(*ref, init); - ll = BIF_LL1(thebif); - ll = NODE_OPERAND0(ll); - NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg->thellnd); - return arg; -} - -SgFuncHedrStmt * isSgFuncHedrStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case FUNC_HEDR: - return (SgFuncHedrStmt *) pt; - default: - return NULL; - } -} - -#ifdef NOT_YET_IMPLEMENTED -class SgModuleStmt: public SgStatement{ - // Fortran 90 Module statement - // variant == MODULE_STMT - public: - SgModuleStmt(SgSymbol &moduleName, SgStatement &body):SgStatement(MODULE_STMT) - { - SORRY; - }; - SgModuleStmt(SgSymbol &moduleName):SgStatement(PROG_HEDR) - { - SORRY; - }; - ~SgModuleStmt(){RemoveFromTableBfnd((void *) this);}; - - SgSymbol *moduleName() - { - SORRY; - }; // module name - void setName(SgSymbol &symbol) - { - SORRY; - }; // set module name - - int numberOfSpecificationStmts() - { - SORRY; - }; - int numberOfRoutinesDefined() - { - SORRY; - }; - int numberOfFunctionsDefined() - { - SORRY; - }; - int numberOfSubroutinesDefined() - { - SORRY; - }; - - SgStatement *specificationStmt(int i) - { - SORRY; - }; - SgStatement *routine(int i) - { - SORRY; - }; - SgStatement *function(int i) - { - SORRY; - }; - SgStatement *subroutine(int i) - { - SORRY; - }; - - int isSymbolInScope(SgSymbol &symbol) - { - SORRY; - }; - int isSymbolDeclaredHere(SgSymbol &symbol) - { - SORRY; - }; - - SgSymbol &addVariable(SgType &T, char *name) - { - SORRY; - }; - //add a declaration for new variable - - SgStatement *addCommonBlock(char *blockname, int noOfVars, - SgSymbol *Vars) - { - SORRY; - }; // add a new common block -}; - - -SgModuleStmt * isSgModuleStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case MODULE_STMT: - return (SgModuleStmt *) pt; - default: - return NULL; - } -} - - -class SgInterfaceStmt: public SgStatement{ - // Fortran 90 Operator Interface Statement - // variant == INTERFACE_STMT - public: - SgInterfaceStmt(SgSymbol &name, SgStatement &body, SgStatement &scope):SgStatement(INTERFACE_STMT) - { - SORRY; - }; - ~SgInterfaceStmt(){RemoveFromTableBfnd((void *) this);}; - - SgSymbol *interfaceName() - { - SORRY; - }; // interface name if given - int setName(SgSymbol &symbol) - { - SORRY; - }; // set interface name - - int numberOfSpecificationStmts() - { - SORRY; - }; - - SgStatement *specificationStmt(int i) - { - SORRY; - }; - - int isSymbolInScope(SgSymbol &symbol) - { - SORRY; - }; - int isSymbolDeclaredHere(SgSymbol &symbol) - { - SORRY; - }; -}; - - -SgInterfaceStmt * isSgInterfaceStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case INTERFACE_STMT: - return (SgInterfaceStmt *) pt; - default: - return NULL; - } -} - - -class SgBlockDataStmt: public SgStatement{ - // Fortran Block Data statement - // variant == BLOCK_DATA - public: - SgBlockDataStmt(SgSymbol &name, SgStatement &body):SgStatement(BLOCK_DATA) - { - BIF_SYMB(thebif) = name.thesymb; - insertBfndListIn(body.thebif,thebif,thebif); - }; - ~SgBlockDataStmt(){RemoveFromTableBfnd((void *) this);}; - - SgSymbol *name() // block data name if given - { return SymbMapping(BIF_SYMB(thebif)); }; - int setName(SgSymbol &symbol) - { - BIF_SYMB(thebif) = symbol.thesymb; - return 1; - }; // set block data name - - int isSymbolInScope(SgSymbol &symbol) - { - SORRY; - }; - int isSymbolDeclaredHere(SgSymbol &symbol) - { - SORRY; - }; -}; - - - -SgBlockDataStmt * isSgBlockDataStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case BLOCK_DATA: - return (SgBlockDataStmt *) pt; - default: - return NULL; - } -} -#endif - -SgClassStmt * isSgClassStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case CLASS_DECL: - case TECLASS_DECL: - case STRUCT_DECL: - case UNION_DECL: - case ENUM_DECL: - case COLLECTION_DECL: - return (SgClassStmt *) pt; - default: - return NULL; - } -} - - -SgStructStmt * isSgStructStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case STRUCT_DECL: - return (SgStructStmt *) pt; - default: - return NULL; - } -} - - -SgUnionStmt * isSgUnionStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case UNION_DECL: - return (SgUnionStmt *) pt; - default: - return NULL; - } -} - -SgEnumStmt * isSgEnumStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ENUM_DECL: - return (SgEnumStmt *) pt; - default: - return NULL; - } -} - -SgCollectionStmt * isSgCollectionStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case COLLECTION_DECL: - return (SgCollectionStmt *) pt; - default: - return NULL; - } -} - - -SgBasicBlockStmt * isSgBasicBlockStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case BASIC_BLOCK: - return (SgBasicBlockStmt *) pt; - default: - return NULL; - } -} - - - -SgForStmt * isSgForStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case FOR_NODE : - return (SgForStmt *) pt; - default: - return NULL; - } -} - -SgProcessDoStmt * isSgProcessDoStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROCESS_DO_STAT : - return (SgProcessDoStmt *) pt; - default: - return NULL; - } -} - -SgWhileStmt * isSgWhileStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case WHILE_NODE: - return (SgWhileStmt *) pt; - default: - return NULL; - } -} - -SgDoWhileStmt * isSgDoWhileStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case DO_WHILE_NODE: - return (SgDoWhileStmt *) pt; - default: - return NULL; - } -} - -SgLogIfStmt * isSgLogIfStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case LOGIF_NODE: - return (SgLogIfStmt *) pt; - default: - return NULL; - } -} - - -SgIfStmt * isSgIfStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case IF_NODE: - return (SgIfStmt *) pt; - default: - return NULL; - } -} - -#ifdef NOT_YET_IMPLEMENTED -class SgIfElseIfStmt: public SgIfStmt { - // For Fortran if then elseif .. elseif ... case - // variant == ELSEIF_NODE - public: - SgIfElseIfStmt(SgExpression &condList, SgStatement &blockList, - SgSymbol &constructName):SgIfStmt(ELSEIF_NODE) - { - SORRY; - }; - int numberOfConditionals() - { - SORRY; - }; // the number of conditionals - SgStatement *body(int b) - { - SORRY; - }; // block b - void setBody(int b) - { - SORRY; - }; // sets block - SgExpression *conditional(int i) - { - SORRY; - }; // the i-th conditional - void setConditional(int i) - { - SORRY; - }; // sets the i-th conditional - void addClause(SgExpression &cond, SgStatement &block) - { - SORRY; - }; - void removeClause(int b) - { - SORRY; - }; // removes block b and it's conditional - -}; - - -SgIfElseIfStmt * isSgIfElseIfStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ELSEIF_NODE: - return (SgIfElseIfStmt *) pt; - default: - return NULL; - } -} -#endif - -SgArithIfStmt * isSgArithIfStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ARITHIF_NODE: - return (SgArithIfStmt *) pt; - default: - return NULL; - } -} - -SgWhereStmt * isSgWhereStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case WHERE_NODE: - return (SgWhereStmt *) pt; - default: - return NULL; - } -} - - -SgWhereBlockStmt * isSgWhereBlockStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case WHERE_BLOCK_STMT: - return (SgWhereBlockStmt *) pt; - default: - return NULL; - } -} - - -SgSwitchStmt * isSgSwitchStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case SWITCH_NODE: - return (SgSwitchStmt *) pt; - default: - return NULL; - } -} - - - -SgCaseOptionStmt * isSgCaseOptionStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case CASE_NODE: - return (SgCaseOptionStmt *) pt; - default: - return NULL; - } -} - -// ******************** Leaf Executable Nodes *********************** - - -SgExecutableStatement* isSgExecutableStatement(SgStatement *pt) -{ - if (!pt) - return NULL; - if (!isADeclBif(BIF_CODE(pt->thebif))) - { - if (SgStatement::isSapforRegime()) - { - const int var = pt->variant(); - if (var == CONTROL_END) - { - SgStatement* cp = pt->controlParent(); - if (cp->variant() == PROG_HEDR || cp->variant() == PROC_HEDR || cp->variant() == FUNC_HEDR) - { - SgStatement* cpcp = cp->controlParent(); - if (cpcp && cpcp->variant() == INTERFACE_STMT) - return NULL; - else - return (SgExecutableStatement*)pt; - } - else - return isSgExecutableStatement(cp); - } - else if (var == DVM_INHERIT_DIR || var == DVM_ALIGN_DIR || var == DVM_DYNAMIC_DIR || - var == DVM_DISTRIBUTE_DIR || var == DVM_VAR_DECL || var == DVM_SHADOW_DIR || - var == DVM_HEAP_DIR || var == DVM_CONSISTENT_DIR || var == DVM_POINTER_DIR || - var == HPF_TEMPLATE_STAT || var == HPF_PROCESSORS_STAT || var == DVM_TASK_DIR || - var == DVM_INDIRECT_GROUP_DIR || var == DVM_REMOTE_GROUP_DIR || var == DVM_REDUCTION_GROUP_DIR || - var == DVM_CONSISTENT_GROUP_DIR || var == DVM_ASYNCID_DIR || var == ACC_ROUTINE_DIR) - return NULL; - else if (var == SPF_ANALYSIS_DIR || var == FORMAT_STAT) - return isSgExecutableStatement(pt->lexNext()); - else - return (SgExecutableStatement*)pt; - } - else - return (SgExecutableStatement*)pt; - } - else - { - if (SgStatement::isSapforRegime()) - { - const int var = pt->variant(); - if (var == SPF_PARALLEL_DIR) - return (SgExecutableStatement*)pt; - if (var == SPF_ANALYSIS_DIR || var == SPF_PARALLEL_REG_DIR) - return isSgExecutableStatement(pt->lexNext()); - if (var == SPF_END_PARALLEL_REG_DIR) - return isSgExecutableStatement(pt->lexPrev()); - if (var == SPF_TRANSFORM_DIR) - { - SgExpression* ex = pt->expr(0); - while (ex) - { - if (ex->lhs()->variant() == SPF_NOINLINE_OP) - return NULL; - else if (ex->lhs()->variant() == SPF_FISSION_OP || ex->lhs()->variant() == SPF_EXPAND_OP) - return (SgExecutableStatement*)pt; - - ex = ex->rhs(); - } - } - - if (var == DVM_PARALLEL_ON_DIR || var == ACC_REGION_DIR || var == ACC_END_REGION_DIR || var == DVM_EXIT_INTERVAL_DIR) - return (SgExecutableStatement*)pt; - if (var == DVM_INTERVAL_DIR) - return isSgExecutableStatement(pt->lexNext()); - if (var == DVM_ENDINTERVAL_DIR) - return isSgExecutableStatement(pt->lexPrev()); - if (var == DVM_BARRIER_DIR) - return (SgExecutableStatement*)pt; - if (var == DVM_INHERIT_DIR) - return NULL; - if (var == DVM_INHERIT_DIR || var == DVM_ALIGN_DIR || var == DVM_DYNAMIC_DIR || - var == DVM_DISTRIBUTE_DIR || var == DVM_VAR_DECL || var == DVM_SHADOW_DIR || - var == DVM_HEAP_DIR || var == DVM_CONSISTENT_DIR || var == DVM_POINTER_DIR) - return NULL; - } - return NULL; - } -} - -SgAssignStmt * isSgAssignStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ASSIGN_STAT: - return (SgAssignStmt *) pt; - default: - return NULL; - } -} - - -SgCExpStmt * isSgCExpStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case EXPR_STMT_NODE: - return (SgCExpStmt *) pt; - default: - return NULL; - } -} - - -SgPointerAssignStmt * isSgPointerAssignStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case POINTER_ASSIGN_STAT: - return (SgPointerAssignStmt *) pt; - default: - return NULL; - } -} - -SgHeapStmt * isSgHeapStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ALLOCATE_STMT: - case DEALLOCATE_STMT: - return (SgHeapStmt *) pt; - default: - return NULL; - } -} - -SgNullifyStmt * isSgNullifyStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case NULLIFY_STMT: - return (SgNullifyStmt *) pt; - default: - return NULL; - } -} - -SgContinueStmt * isSgContinueStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case CONT_STAT: - return (SgContinueStmt *) pt; - default: - return NULL; - } -} - - -SgControlEndStmt * isSgControlEndStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case CONTROL_END : - return (SgControlEndStmt *) pt; - default: - return NULL; - } -} - - -SgBreakStmt * isSgBreakStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case BREAK_NODE: - return (SgBreakStmt *) pt; - default: - return NULL; - } -} - - -SgCycleStmt * isSgCycleStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case CYCLE_STMT: - return (SgCycleStmt *) pt; - default: - return NULL; - } -} - - -SgReturnStmt * isSgReturnStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case RETURN_NODE: - case RETURN_STAT: - return (SgReturnStmt *) pt; - default: - return NULL; - } -} - -SgExitStmt * isSgExitStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case EXIT_STMT: - return (SgExitStmt *) pt; - default: - return NULL; - } -} - -SgGotoStmt * isSgGotoStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case GOTO_NODE: - return (SgGotoStmt *) pt; - default: - return NULL; - } -} - - -SgLabelListStmt * isSgLabelListStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case COMGOTO_NODE: - case ASSGOTO_NODE: - return (SgLabelListStmt *) pt; - default: -// SORRY; - return NULL; - } -} - - -SgAssignedGotoStmt * isSgAssignedGotoStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ASSGOTO_NODE: - return (SgAssignedGotoStmt *) pt; - default: - return NULL; - } -} - -SgComputedGotoStmt * isSgComputedGotoStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case COMGOTO_NODE: - return (SgComputedGotoStmt *) pt; - default: - return NULL; - } -} - -SgStopOrPauseStmt * isSgStopOrPauseStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case STOP_STAT: - return (SgStopOrPauseStmt *) pt; - default: - return NULL; - } -} - -SgCallStmt* isSgCallStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROC_STAT: - return (SgCallStmt *) pt; - default: - return NULL; - } -} - -SgProsHedrStmt* isSgProsHedrStmt (SgStatement *pt) /* Fortran M */ -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROS_HEDR: - return (SgProsHedrStmt *) pt; - default: - return NULL; - } -} - -SgProsCallStmt* isSgProsCallStmt (SgStatement *pt) /* Fortran M */ -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROS_STAT: - return (SgProsCallStmt *) pt; - default: - return NULL; - } -} - -SgProsCallLctn* isSgProsCallLctn (SgStatement *pt) /* Fortran M */ -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROS_STAT_LCTN: - return (SgProsCallLctn *) pt; - default: - return NULL; - } -} - -SgProsCallSubm* isSgProsCallSubm (SgStatement *pt) /* Fortran M */ -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROS_STAT_SUBM: - return (SgProsCallSubm *) pt; - default: - return NULL; - } -} - -SgIOStmt * isSgIOStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case 0: - return (SgIOStmt *) pt; - default: - SORRY; - return NULL; - } -} - - -SgInputOutputStmt * isSgInputOutputStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case READ_STAT: - case WRITE_STAT: - case PRINT_STAT: - return (SgInputOutputStmt *) pt; - default: - return NULL; - } -} - -SgIOControlStmt::SgIOControlStmt(int variant, SgExpression &controlSpecifierList):SgExecutableStatement(variant) -{ - switch (variant){ - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case REWIND_STAT: - case ENDFILE_STAT: - case FORMAT_STAT: - break; - default: - Message("illegal variant for SgIOControlStmt",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - BIF_LL2(thebif) = controlSpecifierList.thellnd; -} - -SgIOControlStmt * isSgIOControlStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case REWIND_STAT: - case ENDFILE_STAT: - case FORMAT_STAT: - return (SgIOControlStmt *) pt; - default: - return NULL; - } -} - -// ******************** Declaration Nodes *************************** - -SgDeclarationStatement * isSgDeclarationStatement (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case VAR_DECL: - case VAR_DECL_90: - case ENUM_DECL: - case STRUCT_DECL: - case CLASS_DECL: - case TECLASS_DECL: - case COLLECTION_DECL: - return (SgDeclarationStatement *) pt; - default: - return NULL; - } -} - -// the complete initial value ASSGN_OP expression ofthe i-th variable -// from Michael Golden -SgExpression * SgVarDeclStmt::completeInitialValue(int i) -{ - PTR_LLND varRefExp; - SgExpression *x; - - varRefExp = getPositionInExprList(BIF_LL1(thebif),i); - if (varRefExp == LLNULL) - x = NULL; - else if (NODE_CODE(varRefExp) == ASSGN_OP) - x = LlndMapping(varRefExp); - else - x = NULL; - - return x; -} - - -// sets the initial value ofthe i-th variable -// an alternative way to initialize variables. The low-level node -// (VAR_REF or ARRAY_REF) is replaced by a ASSIGN_OP low-level node. -void SgVarDeclStmt::setInitialValue(int i, SgExpression &initVal) // sets the initial value ofthe i-th variable -{ - int j; - SgExpression *list, *varRef; - list = this->expr(0); - for(j = 0; j < i; j++) if(list) list = list->rhs(); - if(!list) return; - varRef = list->lhs(); - if(!varRef) return; - if(varRef->variant() == ASSGN_OP){ - varRef->setRhs(initVal); - return; - } - SgExpression &e = SgAssignOp(*varRef, initVal); - list->setLhs(e); - return; -} - -// method below contributed by Michael Golden -// removes the initial value of the i-ith declaration - void SgVarDeclStmt::clearInitialValue(int i) - { - int j; - SgExpression *list, *varRef; - - list = this->expr(0); - for(j = 0; j < i; j++) - if (list) - list = list->rhs(); - if(!list) - return; - varRef = list->lhs(); - if(!varRef) - return; - - /* If there is an assignment here, then change it to just the LHS */ - /* Which is the variable itself */ - if (varRef->variant() == ASSGN_OP) - list->setLhs(*(varRef->lhs())); - - - } - - -SgVarDeclStmt * isSgVarDeclStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case VAR_DECL: - return (SgVarDeclStmt *) pt; - default: - return NULL; - } -} - - -SgIntentStmt * isSgIntentStmt (SgStatement *pt) /* Fortran M */ -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case INTENT_STMT: - return (SgIntentStmt *) pt; - default: - return NULL; - } -} - - -SgVarListDeclStmt::SgVarListDeclStmt(int variant, SgExpression &):SgDeclarationStatement(variant) - { - switch (variant) { - case INTENT_STMT: - case OPTIONAL_STMT: - case SAVE_DECL: - case PUBLIC_STMT: - case PRIVATE_STMT: - case EXTERN_STAT: - case INTRIN_STAT: - case DIM_STAT: - case ALLOCATABLE_STMT: - case POINTER_STMT: - case TARGET_STMT: - case MODULE_PROC_STMT: - break; - default: - Message("Illegal variant for SgVarListDeclStmt",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - }; - -// findStatementAttribute(variant, attribute); -// BIF_LL1(thesymb) = symbolrefList.thellnd; -// setSymbolAttributesInVarRefList(BIF_LL1(thesymb)); - SORRY; - } - -SgVarListDeclStmt::SgVarListDeclStmt(int variant, SgSymbol &, SgStatement &):SgDeclarationStatement(variant) - { - switch (variant) { - case INTENT_STMT: - case OPTIONAL_STMT: - case SAVE_DECL: - case PUBLIC_STMT: - case PRIVATE_STMT: - case EXTERN_STAT: - case INTRIN_STAT: - case DIM_STAT: - case ALLOCATABLE_STMT: - case POINTER_STMT: - case TARGET_STMT: - case MODULE_PROC_STMT: - break; - default: - Message("Illegal variant for SgVarListDeclStmt",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - }; - -// findStatementAttribute(variant,attribute); -// BIF_LL1(thesymb) = symbolList.thellnd; -// setSymbolAttributesInVarRefList(BIF_LL1(thesymb)); - SORRY; - } - -SgVarListDeclStmt * isSgVarListDeclStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case INTENT_STMT: - case OPTIONAL_STMT: - case SAVE_DECL: - case PUBLIC_STMT: - case PRIVATE_STMT: - case EXTERN_STAT: - case INTRIN_STAT: - case DIM_STAT: - case ALLOCATABLE_STMT: - case POINTER_STMT: - case TARGET_STMT: - case MODULE_PROC_STMT: - case PROCESSORS_STAT: - case STATIC_STMT: - return (SgVarListDeclStmt *) pt; - default: - return NULL; - } -} - - - -SgStructureDeclStmt * isSgStructureDeclStmtSgStructureDeclStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case STRUCT_DECL: - return (SgStructureDeclStmt *) pt; - default: - return NULL; - } -} - -SgNestedVarListDeclStmt::SgNestedVarListDeclStmt(int variant, SgExpression &listOfVarList):SgDeclarationStatement(VAR_DECL) -{ - int listVariant; - - switch (variant) { - case NAMELIST_STAT: - listVariant = NAMELIST_LIST; - break; - case EQUI_STAT: - listVariant = EQUI_LIST; - break; - case COMM_STAT: - listVariant = COMM_LIST; - break; - case PROS_COMM: /* Fortran M */ - listVariant = COMM_LIST; - break; - default: - Message("Illegal variant in SgNestedVarListDeclStmt",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - }; - BIF_CODE(thebif) = variant; -// checkIfListOfVariant(listVariant, listOfVarList); - listVariant = listVariant; SORRY; - BIF_LL1(thebif) = listOfVarList.thellnd; -} - -SgNestedVarListDeclStmt * isSgNestedVarListDeclStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case NAMELIST_STAT: - case EQUI_STAT: - case PROS_COMM: - case COMM_STAT: - return (SgNestedVarListDeclStmt *) pt; - default: - return NULL; - } -} - - - -SgParameterStmt * isSgParameterStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PARAM_DECL: - return (SgParameterStmt *) pt; - default: - return NULL; - } -} - - -SgImplicitStmt * isSgImplicitStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case IMPL_DECL: - return (SgImplicitStmt *) pt; - default: - return NULL; - } -} - - -SgInportStmt * isSgInportStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case INPORT_DECL: - return (SgInportStmt *) pt; - default: - return NULL; - } -} - - -SgOutportStmt * isSgOutportStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case OUTPORT_DECL: - return (SgOutportStmt *) pt; - default: - return NULL; - } -} - - -SgChannelStmt * isSgChannelStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case CHANNEL_STAT: - return (SgChannelStmt *) pt; - default: - return NULL; - } -} - - -SgMergerStmt * isSgMergerStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case MERGER_STAT: - return (SgMergerStmt *) pt; - default: - return NULL; - } -} - - -SgMoveportStmt * isSgMoveportStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case MOVE_PORT: - return (SgMoveportStmt *) pt; - default: - return NULL; - } -} - - -SgSendStmt * isSgSendStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case SEND_STAT: - return (SgSendStmt *) pt; - default: - return NULL; - } -} - - -SgReceiveStmt * isSgReceiveStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case RECEIVE_STAT: - return (SgReceiveStmt *) pt; - default: - return NULL; - } -} - - -SgEndchannelStmt * isSgEndchannelStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case ENDCHANNEL_STAT: - return (SgEndchannelStmt *) pt; - default: - return NULL; - } -} - - -SgProbeStmt * isSgProbeStmt(SgStatement *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case PROBE_STAT: - return (SgProbeStmt *) pt; - default: - return NULL; - } -} - - -SgProcessorsRefExp * isSgProcessorsRefExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case PROCESSORS_REF: - return (SgProcessorsRefExp *) pt; - default: - return NULL; - } -} - - -SgPortTypeExp * isSgPortTypeExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case PORT_TYPE_OP: - case INPORT_TYPE_OP: - case OUTPORT_TYPE_OP: - return (SgPortTypeExp *) pt; - default: - return NULL; - } -} - -SgInportExp * isSgInportExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case INPORT_NAME: - return (SgInportExp *) pt; - default: - return NULL; - } -} - -SgOutportExp * isSgOutportExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case OUTPORT_NAME: - return (SgOutportExp *) pt; - default: - return NULL; - } -} - -SgFromportExp * isSgFromportExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case FROMPORT_NAME: - return (SgFromportExp *) pt; - default: - return NULL; - } -} - -SgToportExp * isSgToportExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case TOPORT_NAME: - return (SgToportExp *) pt; - default: - return NULL; - } -} - -SgIO_statStoreExp * isSgIO_statStoreExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case IOSTAT_STORE: - return (SgIO_statStoreExp *) pt; - default: - return NULL; - } -} - -SgEmptyStoreExp * isSgEmptyStoreExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case EMPTY_STORE: - return (SgEmptyStoreExp *) pt; - default: - return NULL; - } -} - -SgErrLabelExp * isSgErrLabelExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case ERR_LABEL: - return (SgErrLabelExp *) pt; - default: - return NULL; - } -} - -SgEndLabelExp * isSgEndLabelExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case END_LABEL: - return (SgEndLabelExp *) pt; - default: - return NULL; - } -} - -SgDataImpliedDoExp * isSgDataImpliedDoExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DATA_IMPL_DO: - return (SgDataImpliedDoExp *) pt; - default: - return NULL; - } -} - -SgDataEltExp * isSgDataEltExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DATA_ELT: - return (SgDataEltExp *) pt; - default: - return NULL; - } -} - -SgDataSubsExp * isSgDataSubsExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DATA_SUBS: - return (SgDataSubsExp *) pt; - default: - return NULL; - } -} - -SgDataRangeExp * isSgDataRangeExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case DATA_RANGE: - return (SgDataRangeExp *) pt; - default: - return NULL; - } -} - -SgIconExprExp * isSgIconExprExp(SgExpression *pt) /* Fortran M */ -{ - if (!pt) - return NULL; - switch(NODE_CODE(pt->thellnd)) - { - case ICON_EXPR: - return (SgIconExprExp *) pt; - default: - return NULL; - } -} - - - - -#ifdef NOT_YET_IMPLEMENTED -class SgUseStmt: public SgDeclarationStatement{ - // Fortran 90 module usuage statement - // variant = USE_STMT - public: - SgUseStmt(SgSymbol &moduleName, SgExpression &renameList, SgStatement &scope):SgDeclarationStatement(USE_STMT) - { - SORRY; - }; - // renameList must be a list of low-level nodes of variant RENAME_NODE - ~SgUseStmt(){RemoveFromTableBfnd((void *) this);}; - - int isOnly() - { - SORRY; - }; - SgSymbol *moduleName() - { - SORRY; - }; - void setModuleName(SgSymbol &moduleName) - { - SORRY; - }; - int numberOfRenames() - { - SORRY; - }; - SgExpression *renameNode(int i) - { - SORRY; - }; - void addRename(SgSymbol &localName, SgSymbol &useName) - { - SORRY; - }; - void addRenameNode(SgExpression &renameNode) - { - SORRY; - }; - void deleteRenameNode(int i) - { - SORRY; - }; - void deleteTheRenameNode(SgExpression &renameNode) - { - SORRY; - }; -}; - - -SgUseStmt * isSgUseStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case USE_STMT: - return (SgUseStmt *) pt; - default: - return NULL; - } -} - - - -class SgStmtFunctionStmt: public SgDeclarationStatement{ - // Fortran statement function declaration - // variant == STMTFN_DECL - public: - SgStmtFunctionStmt(SgSymbol &name, SgExpression &args, SgStatement Body):SgDeclarationStatement(STMTFN_DECL) - { - SORRY; - }; - ~SgStmtFunctionStmt(){RemoveFromTableBfnd((void *) this);}; - - SgSymbol *name() - { - SORRY; - }; - void setName(SgSymbol &name) - { - SORRY; - }; - SgType *type() - { - SORRY; - }; - int numberOfParameters() - { - SORRY; - }; // the number of parameters - SgSymbol *parameter(int i) - { - SORRY; - }; // the i-th parameter -}; - -class SgMiscellStmt: public SgDeclarationStatement{ - // Fortran 90 simple miscellaneous statements - // variant == CONTAINS_STMT, PRIVATE_STMT, SEQUENCE_STMT - public: - SgMiscellStmt(int variant):SgDeclarationStatement(variant) {} - ~SgMiscellStmt(){RemoveFromTableBfnd((void *) this);}; -}; - - - -SgStmtFunctionStmt * isSgStmtFunctionStmt (SgStatement *pt) -{ - - if (!pt) - return NULL; - switch(BIF_CODE(pt->thebif)) - { - case STMTFN_DECL: - return (SgStmtFunctionStmt *) pt; - default: - return NULL; - } -} -#endif - -// -// -// More stuffs for types and symbols -// -// - - -SgVariableSymb * isSgVariableSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case VARIABLE_NAME: - return (SgVariableSymb *) pt; - default: - return NULL; - } -} - - -SgConstantSymb * isSgConstantSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case CONST_NAME : - return (SgConstantSymb *) pt; - default: - return NULL; - } -} - -SgFunctionSymb::SgFunctionSymb(int variant):SgSymbol(variant) -{ - switch (variant) { - case PROGRAM_NAME: - case PROCEDURE_NAME: - case FUNCTION_NAME: - case MEMBER_FUNC: - break; - default: - Message("SgFunctionSymb variant invalid",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } -} - -SgFunctionSymb::SgFunctionSymb(int variant, char *identifier, SgType &t, - SgStatement &scope):SgSymbol(variant,identifier,t,scope) -{ - switch (variant) { - case PROGRAM_NAME: - case PROCEDURE_NAME: - case FUNCTION_NAME: - case MEMBER_FUNC: - break; - default: - Message("SgFunctionSymb variant invalid",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - SYMB_TYPE(thesymb) = t.thetype; -} - -SgFunctionSymb::SgFunctionSymb(int variant, const char *identifier, SgType &t, - SgStatement &scope) :SgSymbol(variant, identifier, t, scope) -{ - switch (variant) { - case PROGRAM_NAME: - case PROCEDURE_NAME: - case FUNCTION_NAME: - case MEMBER_FUNC: - break; - default: - Message("SgFunctionSymb variant invalid", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - SYMB_TYPE(thesymb) = t.thetype; -} - -SgExpression * SgFunctionRefExp::AddArg( char *name, SgType &t) - // to add a formal parameter to a function symbol. -{ - PTR_SYMB symb; - SgExpression *arg = NULL; - SgSymbol *s; - SgSymbol *f = this->funName(); - if(!f){ - Message("SgFunctionRefExp::AddArg: no symbol for function_ref", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - s = new SgVariableSymb(name, t, *f->scope()); //create the variable with scope -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - symb = s->thesymb; - appendSymbToArgList(f->thesymb,symb); - - if(LibFortranlanguage()){ - Message("Fortran function protos do not have arg lists", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - else{ - arg = SgMakeDeclExp(s, &t); - NODE_OPERAND0(this->thellnd) = - addToExprList(NODE_OPERAND0(this->thellnd),arg->thellnd); - } - return arg; -} - -SgFunctionSymb * isSgFunctionSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case PROGRAM_NAME: - case PROCEDURE_NAME: - case FUNCTION_NAME: - case MEMBER_FUNC: - return (SgFunctionSymb *) pt; - default: - return NULL; - } -} - - -SgMemberFuncSymb * isSgMemberFuncSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case MEMBER_FUNC: - return (SgMemberFuncSymb *) pt; - default: - return NULL; - } -} - -SgFieldSymb * isSgFieldSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case ENUM_NAME: - case FIELD_NAME: - return (SgFieldSymb *) pt; - default: - return NULL; - } -} - - -SgClassSymb * isSgClassSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case CLASS_NAME: - case TECLASS_NAME: - case UNION_NAME: - case STRUCT_NAME: - case COLLECTION_NAME: - return (SgClassSymb *) pt; - default: - return NULL; - } -} - -#ifdef NOT_YET_IMPLEMENTED -class SgTypeSymb: public SgSymbol{ - // a C typedef. the type() function returns the base type. - // variant == TYPE_NAME - public: - SgTypeSymb(char *name, SgType &baseType):SgSymbol(TYPE_NAME) - { - SORRY; - }; - SgType &baseType() - { - SORRY; - }; - ~SgTypeSymb(){RemoveFromTableSymb((void *) this);}; -}; - - -SgTypeSymb * isSgTypeSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case TYPE_NAME: - return (SgTypeSymb *) pt; - default: - return NULL; - } -} -#endif - -SgLabelSymb * isSgLabelSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case LABEL_NAME: - return (SgLabelSymb *) pt; - default: - return NULL; - } -} - -SgLabelVarSymb * isSgLabelVarSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case LABEL_NAME: - return (SgLabelVarSymb *) pt; - default: - return NULL; - } -} - - -SgExternalSymb * isSgExternalSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case ROUTINE_NAME: - return (SgExternalSymb *) pt; - default: - return NULL; - } -} - -SgConstructSymb * isSgConstructSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case CONSTRUCT_NAME: - return (SgConstructSymb *) pt; - default: - return NULL; - } -} - -SgInterfaceSymb * isSgInterfaceSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case INTERFACE_NAME: - return (SgInterfaceSymb *) pt; - default: - return NULL; - } -} - - - -SgModuleSymb * isSgModuleSymb (SgSymbol *pt) -{ - - if (!pt) - return NULL; - switch(SYMB_CODE(pt->thesymb)) - { - case MODULE_NAME: - return (SgModuleSymb *) pt; - default: - return NULL; - } -} - -// ********************* Types ******************************* - - -SgArrayType * isSgArrayType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_ARRAY: - return (SgArrayType *) pt; - default: - return NULL; - } -} - -#ifdef NOT_YET_IMPLEMENTED -class SgClassType: public SgType{ - // a C struct or Fortran Record, a C++ class, a C Union and a C Enum - // and a pC++ collection. note: derived classes are another type. - // this type is very simple. it only contains the standard type - // info from SgType and a pointer to the class declaration stmt - // and a pointer to the symbol that is the first field in the struct. - // variant == T_STRUCT, T_ENUM, T_CLASS, T_TECLASS T_ENUM, T_COLLECTION - public: - // why is struct_decl needed. No appropriate field found. - // assumes that first_field has been declared as - // FIELD_NAME and the remaining fields have been stringed to it. - SgClassType(int variant, char *name, SgStatement &struct_decl, int num_fields, - SgSymbol &first_field):SgType(variant) - { - - SORRY; - }; - SgStatement &structureDecl() - { - SORRY; - }; - SgSymbol *firstFieldSymb() - { return SymbMapping(TYPE_FIRST_FIELD(thetype)); }; - SgSymbol *fieldSymb(int i) - { return SymbMapping(GetThOfFieldListForType(thetype, i)); } - int numberOfFields() - { return lenghtOfFieldListForType(thetype); } - ~SgClassType(){RemoveFromTableType((void *) this);}; -}; - - -SgClassType * isSgClassType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_STRUCT: - case T_ENUM: - case T_CLASS: - case T_TECLASS: - case T_COLLECTION: - return (SgClassType *) pt; - default: - return NULL; - } -} -#endif - -SgPointerType::SgPointerType(SgType &base_type):SgType(T_POINTER) -{ TYPE_BASE(thetype) = base_type.thetype; } - -SgPointerType::SgPointerType(SgType *base_type):SgType(T_POINTER) -{ TYPE_BASE(thetype) = base_type->thetype; } - -SgPointerType * isSgPointerType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_POINTER: - return (SgPointerType *) pt; - default: - return NULL; - } -} - - -SgReferenceType * isSgReferenceType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_REFERENCE: - return (SgReferenceType *) pt; - default: - return NULL; - } -} - - -SgFunctionType * isSgFunctionType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_FUNCTION: - return (SgFunctionType *) pt; - default: - return NULL; - } -} - - - - -SgDerivedType * isSgDerivedType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_DERIVED_TYPE: - return (SgDerivedType *) pt; - default: - return NULL; - } -} - -SgDerivedClassType * isSgDerivedClassType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_DERIVED_CLASS: - return (SgDerivedClassType *) pt; - default: - return NULL; - } -} - - -SgDescriptType * isSgDescriptType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_DESCRIPT: - return (SgDescriptType *) pt; - default: - return NULL; - } -} - - - -SgDerivedCollectionType * isSgDerivedCollectionType (SgType *pt) -{ - - if (!pt) - return NULL; - switch(TYPE_CODE(pt->thetype)) - { - case T_DERIVED_COLLECTION: - return (SgDerivedCollectionType *) pt; - default: - return NULL; - } -} - -// perhaps this function can use LlndMapping -SgExpression * SgSubscriptExp::lbound() -{ - PTR_LLND ll = NULL; - ll = NODE_OPERAND0(thellnd); - if (ll && (NODE_CODE(ll) == DDOT)) - ll = NODE_OPERAND0(ll); - return LlndMapping(ll); -} - -SgExpression * SgSubscriptExp::ubound() -{ - PTR_LLND ll = NULL; - - ll = NODE_OPERAND0(thellnd); - if (ll && (NODE_CODE(ll) == DDOT)) - ll = NODE_OPERAND1(ll); - else - ll = NODE_OPERAND1(thellnd); - return LlndMapping(ll); -} - -SgExpression * SgSubscriptExp::step() -{ - PTR_LLND ll = NULL; - ll = NODE_OPERAND0(thellnd); - if (ll && (NODE_CODE(ll) == DDOT)) - ll = NODE_OPERAND1(thellnd); - else - ll = makeInt(1); - return LlndMapping(ll); -} - -// -// miscelleanous functions -// - -// return a symbol with the name; -// if where is NULL the first symbol, whose name matches, found is returned; -// if where is non NULL the first symbol which scope included where -// is returned; as an example getSymbol("foo", GLOBAL_NODE) -// returns only the symbol named foo with scope = GLOBAL_NODE; - -SgSymbol *getSymbol(char *name, SgStatement *where) -{ - if (where) - return SymbMapping(getSymbolWithNameInScope(name, where->thebif)); - else - return SymbMapping(getSymbolWithNameInScope(name,NULL)); -} - -void SgSymbol::declareTheSymbol(SgStatement &st) -{ - SgClassStmt *cl = NULL; - SgFuncHedrStmt *fh = NULL; - SgSymbol *fsym; - if(LibFortranlanguage()){ - declareAVar(thesymb, st.thebif); - } - else{ - SgType *t = this->type(); - SgExpression *e = SgMakeDeclExp(this, t ); - SYMB_SCOPE(this->thesymb) = st.thebif; - SgStatement *hdr = &st; - while( (hdr->variant() != GLOBAL) && - ((cl = isSgClassStmt(hdr)) == NULL) && - ((fh = isSgFuncHedrStmt(hdr)) == NULL)) - hdr = hdr->controlParent(); - if(cl){ - if((fsym = cl->name()) != NULL) - appendSymbToArgList(fsym->thesymb,this->thesymb); - } - if(fh){ - if((fsym = &(fh->name())) != NULL) - appendSymbToArgList(fsym->thesymb,this->thesymb); - } - e = new SgExprListExp(*e); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, e, 1); -#endif - SgVarDeclStmt *s = new SgVarDeclStmt(*e, *t); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - st.insertStmtAfter(*s, *s->controlParent()); - } - } - -SgExpression *SgSymbol::makeDeclExpr() -{ - if(LibFortranlanguage()){ - return LlndMapping(makeDeclExp(thesymb)); - } - else return SgMakeDeclExp(this, this->type()); -} - -SgVarDeclStmt *SgSymbol::makeVarDeclStmt() -{ - if(LibFortranlanguage()){ - return - isSgVarDeclStmt(BfndMapping(makeDeclStmt(thesymb))); - } - else{ - SgType *t = this->type(); - SgExpression *e = SgMakeDeclExp(this, t ); - e = new SgExprListExp(*e); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, e, 1); -#endif - SgVarDeclStmt *s = new SgVarDeclStmt(*e, *t); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - return s; - } - } - -SgVarDeclStmt *SgSymbol::makeVarDeclStmtWithParamList - (SgExpression &parlist) -{ return - isSgVarDeclStmt - (BfndMapping(makeDeclStmtWPar(thesymb, parlist.thellnd)));} - - -// -// -// -// Main file for debug purpose, check the routines in the -// in this file -// -// -// - -#ifdef DEBUGLIB -main() -{ - SgProject project("test.proj"); - SgFile file("simple.f"); - SgValueExp c1(1), c2(2), c3(3), c100(100); - SgExpression *pt; - SgVarRefExp *e1, *e2, *e3, *e4; - SgStatement *themain, *first, *firstex, *last; - SgFuncHedrStmt *ptfunc; - SgSymbol *ptsymb; - SgSymbol *i1; - SgSymbol *i2; - SgSymbol *i3; - SgSymbol *i4; - SgSymbol *anarray; - SgAssignStmt *stmt, *stmt1; - SgIfStmt *anif; - SgStatement *anotherif; - SgWhileStmt *awhile; - SgForStmt *afor; - SgReturnStmt *areturn; - SgCallStmt *afuncall; - SgArrayType *typearray; - SgType basetype(T_FLOAT); - - - printf("There is %d files in that project\n",project.numberOfFiles()); - first = (file.firstStatement()); - themain = (file.mainProgram()); - - ptfunc = new SgFuncHedrStmt("funct1"); - - ptsymb = new SgVariableSymb("var1"); - pt = new SgVarRefExp(*ptsymb); - ptfunc->AddArg(*pt); - - ptsymb = new SgVariableSymb("var2"); - pt = new SgVarRefExp(*ptsymb); - ptfunc->AddArg(*pt); - - first->insertStmtAfter(*ptfunc); - - // lets add a statement to that function - i1 = new SgVariableSymb("i1"); - i1->declareTheSymbol(*ptfunc); - e1 = new SgVarRefExp(*i1); - - i2 = new SgVariableSymb("i2"); - i2->declareTheSymbol(*ptfunc); - e2 = new SgVarRefExp(*i2); - - i3 = new SgVariableSymb("i3"); - i3->declareTheSymbol(*ptfunc); - e3 = new SgVarRefExp(*i3); - - i4 = new SgVariableSymb("i4"); - i4->declareTheSymbol(*ptfunc); - e4 = new SgVarRefExp(*i4); - - firstex = (ptfunc->lastDeclaration()); - stmt = new SgAssignStmt((*e1), (*e2) + ((*e3) + c1) * (*e4)); - - stmt1 = new SgAssignStmt(*e2,*e3); - - anif = new SgIfStmt(c1 > c2 , *stmt1, stmt->copy()); - anotherif = &(anif->copy()); - - awhile = new SgWhileStmt( (*e4)< c2 , anif->copy()); - - afor = new SgForStmt(* i1, c1, c2, c3, awhile->copy()); - areturn = new SgReturnStmt(); - - afuncall = new SgCallStmt(*ptfunc->symbol()); - afuncall->addArg(c1.copy()); - afuncall->addArg(c2.copy()); - afuncall->addArg(c3.copy()); - -// let insert what we have created - firstex->insertStmtAfter(*anif); - firstex->insertStmtAfter(stmt->copy()); - firstex->insertStmtAfter(*awhile); - firstex->insertStmtAfter(*afor); - - last = (ptfunc->lastExecutable()); - last->insertStmtAfter(*areturn); - - - themain->insertStmtAfter(*anotherif); - themain->insertStmtAfter(*afuncall); - -// Let's try array - typearray = new SgArrayType(basetype); - typearray->addRange(c1); - typearray->addRange(c2); - typearray->addRange(c3); - anarray = new SgVariableSymb("Array1",*typearray); - anarray->declareTheSymbol(*ptfunc); - -// make an array expression - pt = new SgArrayRefExp(*anarray,*e1,*e2,*e3); - stmt = new SgAssignStmt((*pt), (*e2) + ((*pt) + c1) * (*pt)); - firstex->insertStmtAfter(*stmt); - -// unparse the file - file.unparsestdout(); - file.saveDepFile("debug.dep"); - -} -#endif - - -// SgReturnStmt--inlines - -SgReturnStmt::SgReturnStmt(SgExpression &returnValue):SgExecutableStatement(RETURN_NODE) -{ - BIF_LL1(thebif) = returnValue.thellnd; - if (CurrentProject->Fortranlanguage()) - { - Message("Fortran return does not have expression",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - BIF_CODE(thebif) = RETURN_STAT; - } -} - -SgReturnStmt::SgReturnStmt():SgExecutableStatement(RETURN_NODE) -{ - if (CurrentProject->Fortranlanguage()) - BIF_CODE(thebif) = RETURN_STAT; -} - - - -/////////////////////////// METHOD FOR ATTRIBUTES (IN A SEPARATE FILES????) /////////////// - - -SgAttribute::SgAttribute(int t, void *pt, int size, SgStatement &st, int) -{ - type = t; - data = pt; - dataSize = size; - next = NULL; - // enum typenode { BIFNODE, LLNODE, SYMBNODE, TYPENODE, BLOBNODE, - // BLOB1NODE}; - typeNode = BIFNODE; - ptToSage = (void *)&st; - fileNumber = CurrentFileNumber; -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgAttribute::SgAttribute(int t, void *pt, int size, SgSymbol &st, int) -{ - type = t; - data = pt; - dataSize = size; - next = NULL; - typeNode = SYMBNODE; - ptToSage = (void *)&st; - fileNumber = CurrentFileNumber; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgAttribute::SgAttribute(int t, void *pt, int size, SgExpression &st, int) -{ - type = t; - data = pt; - dataSize = size; - next = NULL; - typeNode = LLNODE; - ptToSage = (void *)&st; - fileNumber = CurrentFileNumber; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgAttribute::SgAttribute(int t, void *pt, int size, SgType &st, int) -{ - type = t; - data = pt; - dataSize = size; - next = NULL; - typeNode = TYPENODE; - ptToSage = (void *)&st; - fileNumber = CurrentFileNumber; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgAttribute::SgAttribute(int t, void *pt, int size, SgLabel &st, int) -{ - type = t; - data = pt; - dataSize = size; - next = NULL; - typeNode = LABEL; - ptToSage = (void *)&st; - fileNumber = CurrentFileNumber; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgAttribute::SgAttribute(int t, void *pt, int size, SgFile &st, int) -{ - type = t; - data = pt; - dataSize = size; - next = NULL; - typeNode = FILENODE; - ptToSage = (void *)&st; - fileNumber = CurrentFileNumber; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgAttribute::~SgAttribute() -{ -#if __SPF - removeFromCollection(this); -#endif -} - -int SgAttribute::getAttributeType() -{ - return type; -} - -void SgAttribute::setAttributeType(int t) -{ - type = t; -} - -void *SgAttribute::getAttributeData() -{ - return data; -} - -void *SgAttribute::setAttributeData(void *d) -{ - void *temp; - temp = data; - data = d; - return temp; -} - -int SgAttribute::getAttributeSize() -{ - return dataSize; -} - -void SgAttribute::setAttributeSize(int s) -{ - dataSize = s; -} - -typenode SgAttribute::getTypeNode() -{ - return typeNode; -} - -void *SgAttribute::getPtToSage() -{ - return ptToSage; -} - -void SgAttribute::setPtToSage(void *sa) -{ - ptToSage = sa; -} - -void SgAttribute::resetPtToSage() -{ - ptToSage = NULL; -} - -void SgAttribute::setPtToSage(SgStatement &st) -{ - ptToSage = (void *) &st; - typeNode = BIFNODE; - -} - -void SgAttribute::setPtToSage(SgSymbol &st) -{ - ptToSage = (void *) &st; - typeNode = SYMBNODE; -} - -void SgAttribute::setPtToSage(SgExpression &st) -{ - ptToSage = (void *) &st; - typeNode = LLNODE; -} - -void SgAttribute::setPtToSage(SgType &st) -{ - ptToSage = (void *) &st; - typeNode = TYPENODE; -} - -void SgAttribute::setPtToSage(SgLabel &st) -{ - ptToSage = (void *) &st; - typeNode = LABEL; -} - -void SgAttribute::setPtToSage(SgFile &st) -{ - ptToSage = (void *) &st; - typeNode = FILENODE; -} - -SgStatement *SgAttribute::getStatement() -{ - if (typeNode == BIFNODE) - return (SgStatement *) ptToSage; - else - return NULL; -} - -SgExpression *SgAttribute::getExpression() -{ - if (typeNode == LLNODE) - return (SgExpression *) ptToSage; - else - return NULL; -} - -SgSymbol *SgAttribute::getSgSymbol() -{ - if (typeNode == SYMBNODE) - return (SgSymbol *) ptToSage; - else - return NULL; -} - -SgType *SgAttribute::getType() -{ - if (typeNode == TYPENODE) - return (SgType *) ptToSage; - else - return NULL; -} - -SgLabel *SgAttribute::getLabel() -{ - if (typeNode == LABEL) - return (SgLabel *) ptToSage; - else - return NULL; -} - -SgFile *SgAttribute::getFile() -{ - if (typeNode == FILENODE) - return (SgFile *) ptToSage; - else - return NULL; -} - -int SgAttribute::getfileNumber() -{ - return fileNumber; -} - -SgAttribute *SgAttribute::copy() -{ - return NULL; -} - -SgAttribute *SgAttribute::getNext() -{ - return next; -} - -void SgAttribute::setNext(SgAttribute *s) -{ - next = s; -} - -int SgAttribute::listLenght() -{ - SgAttribute *first; - int nb = 0; - - first = this; - while (first) - { - nb++; - first = first->getNext(); - } - return nb; -} - -SgAttribute *SgAttribute::getInlist(int num) -{ - SgAttribute *first; - int nb = 0; - - first = this; - while (first) - { - if (nb == num) - return first; - nb++; - first = first->getNext(); - } - return NULL; -} - - -void SgAttribute::save(FILE *file) -{ - SgStatement *stat; - SgSymbol *symb; - SgExpression *exp; - SgType *ty; - int id = 0; - int i; - char *pt; - char c1,c2,c; - unsigned int mask = 15; - - if (!file) return; - - switch (typeNode) - { - case BIFNODE: - stat = (SgStatement *) ptToSage; - id = stat->id(); - break; - case SYMBNODE: - symb = (SgSymbol *) ptToSage; - id = symb->id(); - break; - case LLNODE: - exp = (SgExpression *) ptToSage; - id = exp->id(); - break; - case TYPENODE: - ty = (SgType * ) ptToSage; - id = ty->id(); - break; - case BLOBNODE: - case BLOB1NODE: - case LABEL: - case FILENODE: - break; - default: - break; - } - fprintf(file,"ID %d typeNode %d FileNum %d TYPE %d DATASIZE %d\n",id,typeNode,fileNumber,type,dataSize); - - if (dataSize && data) - { // simple way of storing the data in ascii form; - pt = (char *) data; - for (i = 0; i> 4; - c2 = (c2 & mask) + 'a'; - fprintf(file,"%c%c",c1,c2); - } - fprintf(file,"\n"); - } -} - - - -void SgAttribute::save(FILE *file,void (*savefunction)(void *dat, FILE *f)) -{ - SgStatement *stat; - SgSymbol *symb; - SgExpression *exp; - SgType *ty; - int id = 0; - - if (!file || !savefunction) return; - - switch (typeNode) - { - case BIFNODE: - stat = (SgStatement *) ptToSage; - id = stat->id(); - break; - case SYMBNODE: - symb = (SgSymbol *) ptToSage; - id = symb->id(); - break; - case LLNODE: - exp = (SgExpression *) ptToSage; - id = exp->id(); - break; - case TYPENODE: - ty = (SgType * ) ptToSage; - id = ty->id(); - break; - case BLOBNODE: - case BLOB1NODE: - case LABEL: - case FILENODE: - break; - default: - break; - } - fprintf(file,"ID %d typeNode %d FileNum %d TYPE %d DATASIZE %d\n",id,typeNode,fileNumber,type,dataSize); - (*savefunction)(data,file); -} - - - -///////////////////// ATTRIBUTES METHODS FOR FILES ///////////////////////////////// - -void SgFile::saveAttributes(char *file) -{ - int i; - int nba; - SgAttribute *att; - FILE *outfilea; - - if (!file) - return; - outfilea = fopen(file,"w"); - if (!outfilea) - { - Message("Cannot open output file; unparsing stdout",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - outfilea = stdout; - } - nba = this->numberOfAttributes(); - fprintf(outfilea,"%d\n",nba); - for (i=0 ; i< nba; i++) - { - att = this->attribute(i); - if (att) - att->save(outfilea); - } - fclose(outfilea); -} - - -void SgFile::saveAttributes(char *file, void (*savefunction)(void *dat,FILE *f)) -{ - int i; - int nba; - SgAttribute *att; - FILE *outfilea; - - if (!file) - return; - outfilea = fopen(file,"w"); - if (!outfilea) - { - Message("Cannot open output file; unparsing stdout",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - outfilea = stdout; - } - nba = this->numberOfAttributes(); - fprintf(outfilea,"%d\n",nba); - for (i=0 ; i< nba; i++) - { - att = this->attribute(i); - if (att) - att->save(outfilea,savefunction); - } - fclose(outfilea); -} - - - -void SgFile::readAttributes(char *file) -{ - int i,j; - int nba = 0; - FILE *infilea; - char *str; - char buf1[64],buf2[64],buf3[64],buf4[64],buf5[64]; - int id, tn,f,t,ds; - char c1,c2,c; - SgStatement *stat; - PTR_BFND bf; - - if (!file) - return; - infilea = fopen(file,"r"); - if (!infilea) - { - Message("Cannot open input file",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - return; - } - // first read the number of attributes; - fscanf(infilea,"%d", &nba); - for (i=0; i< nba; i++) - { - fscanf(infilea,"%s%d%s%d%s%d%s%d%s%d", - buf1,&id,buf2,&tn,buf3,&f,buf4,&t,buf5,&ds); - str = NULL; - if (ds) - { - // skip return; - fscanf(infilea,"%c",&c1); - //read the data; - str = new char[ds]; -#ifdef __SPF - addToCollection(__LINE__, __FILE__, str, 2); -#endif - for (j=0;jaddAttribute(t, (void *) str,ds); - break; - case SYMBNODE: - break; - case LLNODE: - break; - case TYPENODE: - break; - } - } -} - - -void SgFile::readAttributes(char *file, void * (*readfunction)(FILE *f)) -{ - int i; - int nba = 0; - FILE *infilea; - void *str; - char buf1[64],buf2[64],buf3[64],buf4[64],buf5[64]; - int id, tn,f,t,ds; - char c1; - SgStatement *stat; - PTR_BFND bf; - - if (!file) - return; - infilea = fopen(file,"r"); - if (!infilea) - { - Message("Cannot open input file",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - return; - } - // first read the number of attributes; - fscanf(infilea,"%d", &nba); - for (i=0; i< nba; i++) - { - fscanf(infilea,"%s%d%s%d%s%d%s%d%s%d", - buf1,&id,buf2,&tn,buf3,&f,buf4,&t,buf5,&ds); - str = NULL; - fscanf(infilea,"%c",&c1); - // read the attributes; - str = (*readfunction)(infilea); - // now allocate the attribute; - switch (tn) - { - case BIFNODE: - stat = NULL; - bf = Get_bif_with_id(id); - if (bf) - stat = (SgStatement *) GetMappingInTableForBfnd(bf); - if (stat) - stat->addAttribute(t, (void *) str,ds); - break; - case SYMBNODE: - break; - case LLNODE: - break; - case TYPENODE: - break; - } - } -} - -int SgFile::numberOfAttributes() -{ - int i; - int nb = 0; - - for (i=0 ; i < allocatedForfileTableAttribute; i++) - { - if (fileTableAttribute[i]) - nb = nb + fileTableAttribute[i]->listLenght(); - } - for (i=0 ; i < allocatedForbfndTableAttribute; i++) - { - if (bfndTableAttribute[i]) - nb = nb + bfndTableAttribute[i]->listLenght(); - } - - for (i=0 ; i < allocatedForllndTableAttribute; i++) - { - if (llndTableAttribute[i]) - nb = nb + llndTableAttribute[i]->listLenght(); - } - - for (i=0 ; i < allocatedForsymbolTableAttribute; i++) - { - if (symbolTableAttribute[i]) - nb = nb + symbolTableAttribute[i]->listLenght(); - } - - for (i=0 ; i < allocatedForlabelTableAttribute; i++) - { - if (labelTableAttribute[i]) - nb = nb + labelTableAttribute[i]->listLenght(); - } - return nb; -} - -SgAttribute *SgFile::attribute(int num) -{ - int i; - int nb = 0; - - // to be optimize later, not very efficient for large amout of attribute. - for (i=0 ; i < allocatedForfileTableAttribute; i++) - { - if (fileTableAttribute[i]) - { - if ((nb <= num+1) && (num+1 <= nb + fileTableAttribute[i]->listLenght())) - { - return fileTableAttribute[i]->getInlist(num - nb); - } - nb = nb + fileTableAttribute[i]->listLenght(); - } - } - for (i=0 ; i < allocatedForbfndTableAttribute; i++) - { - if (bfndTableAttribute[i]) - { - if ((nb <= num+1) && (num+1 <= nb + bfndTableAttribute[i]->listLenght())) - { - return bfndTableAttribute[i]->getInlist(num - nb); - } - nb = nb + bfndTableAttribute[i]->listLenght(); - } - } - - for (i=0 ; i < allocatedForllndTableAttribute; i++) - { - if (llndTableAttribute[i]) - { - if ((nb <= num+1) && (num+1 <= nb + llndTableAttribute[i]->listLenght())) - { - return llndTableAttribute[i]->getInlist(num - nb); - } - nb = nb + llndTableAttribute[i]->listLenght(); - } - } - - for (i=0 ; i < allocatedForsymbolTableAttribute; i++) - { - if (symbolTableAttribute[i]) - { - if ((nb <= num+1) && (num+1 <= nb + symbolTableAttribute[i]->listLenght())) - { - return symbolTableAttribute[i]->getInlist(num - nb); - } - nb = nb + symbolTableAttribute[i]->listLenght(); - } - } - - for (i=0 ; i < allocatedForlabelTableAttribute; i++) - { - if (labelTableAttribute[i]) - { - if ((nb <= num+1) && (num+1 <= nb + labelTableAttribute[i]->listLenght())) - { - return labelTableAttribute[i]->getInlist(num - nb); - } - nb = nb + labelTableAttribute[i]->listLenght(); - } - } - return NULL; -} - -////////////////// NOW the function for ATTRIBUTES IN THE CLASS ///////////////////// - -////////////////// ATTRIBUTE FOR SgFile ///////////////////// -// Kataev 15.07.2013 - -int SgFile::numberOfFileAttributes() -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForFileAttribute(filept); - if (!first) - return 0; - while (first) - { - first = first->getNext(); - nb++; - } - return nb; -} - - -int SgFile::numberOfAttributes(int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForFileAttribute(filept); - if (!first) - return 0; - while (first) - { - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return nb; -} - - - -SgAttribute *SgFile::getAttribute(int i) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForFileAttribute(filept); - if (!first) - return NULL; - while (first) - { - if (nb == i) - return first; - first = first->getNext(); - nb++; - } - return NULL; -} - - -SgAttribute *SgFile::getAttribute(int i, int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForFileAttribute(filept); - if (!first) - return NULL; - while (first) - { - if ((nb == i) && (first->getAttributeType() == type)) - return first; - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return NULL; -} - -void *SgFile::attributeValue(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeData(); - else - return NULL; -} - - -void *SgFile::attributeValue(int i, int type) -{ - SgAttribute *first; - - if ( (first = getAttribute(i,type)) != 0) - return first->getAttributeData(); - else - return NULL; -} - -int SgFile::attributeType(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeType(); - else - return 0; -} - - -void *SgFile::deleteAttribute(int i) -{ - SgAttribute *tobedel, *before, *after; - void *data = NULL; - - tobedel = getAttribute(i); - if (!tobedel) return NULL; - - if (i > 0) - { - before = getAttribute(i-1); - before->setNext(tobedel->getNext()); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } else - { - after = tobedel->getNext(); - SetMappingInTableForFileAttribute(filept,after); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } - - return data; -} - -void SgFile::addAttribute(int type, void *a, int size) -{ - SgAttribute *first, *last; - first = GetMappingInTableForFileAttribute(filept); - if (!first) - { - first = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, first, 1); -#endif - SetMappingInTableForFileAttribute(filept,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - first->setNext(last); - } -} - - -void SgFile::addAttribute(SgAttribute *att) -{ - SgAttribute *first, *last; - if (!att) return; - first = GetMappingInTableForFileAttribute(filept); - if (!first) - { - first = att; - SetMappingInTableForFileAttribute(filept,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = att; - first->setNext(last); - } -} - - -void SgFile::addAttribute(int type) -{ - addAttribute(type, NULL, 0); -} - - -void SgFile::addAttribute(void *a, int size) -{ - addAttribute(0, a, size); -} - - - -int SgStatement::numberOfAttributes() -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForBfndAttribute(thebif); - if (!first) - return 0; - while (first) - { - first = first->getNext(); - nb++; - } - return nb; -} - - -int SgStatement::numberOfAttributes(int type) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForBfndAttribute(thebif); - if (!first) - return 0; - while (first) - { - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return nb; -} - -SgAttribute *SgStatement::getAttribute(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForBfndAttribute(thebif); - if (!first) - return NULL; - while (first) - { - if (nb == i) - return first; - first = first->getNext(); - nb++; - } - return NULL; -} - - -SgAttribute *SgStatement::getAttribute(int i, int type) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForBfndAttribute(thebif); - if (!first) - return NULL; - while (first) - { - if ((nb == i) && (first->getAttributeType() == type)) - return first; - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return NULL; -} - -void *SgStatement::attributeValue(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - - if ((first = getAttribute(i)) != 0) - return first->getAttributeData(); - else - return NULL; -} - - -void *SgStatement::attributeValue(int i, int type) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - - if ((first = getAttribute(i, type)) != 0) - return first->getAttributeData(); - else - return NULL; -} - -int SgStatement::attributeType(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first; - - if ((first = getAttribute(i)) != 0) - return first->getAttributeType(); - else - return 0; -} - - -void *SgStatement::deleteAttribute(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *tobedel, *before, *after; - void *data = NULL; - - tobedel = getAttribute(i); - if (!tobedel) return NULL; - - if (i > 0) - { - before = getAttribute(i - 1); - before->setNext(tobedel->getNext()); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - //TODO: crash here - //delete tobedel; - } - else - { - after = tobedel->getNext(); - SetMappingInTableForBfndAttribute(thebif, after); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - //TODO: crash here - //delete tobedel; - } - - return data; -} - -void SgStatement::addAttribute(int type, void *a, int size) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgAttribute *first, *last; - first = GetMappingInTableForBfndAttribute(thebif); - if (!first) - { - first = new SgAttribute(type, a, size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, first, 1); -#endif - SetMappingInTableForBfndAttribute(thebif, first); - } - else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = new SgAttribute(type, a, size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - first->setNext(last); - } -} - -void SgStatement::addAttributeTree(SgAttribute *firstAtt) -{ - if (!firstAtt) - return; - SetMappingInTableForBfndAttribute(thebif, firstAtt); -} - -void SgStatement::addAttribute(SgAttribute *att) -{ - SgAttribute *first, *last; - if (!att) return; - first = GetMappingInTableForBfndAttribute(thebif); - if (!first) - { - first = att; - SetMappingInTableForBfndAttribute(thebif,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = att; - first->setNext(last); - } -} - - -void SgStatement::addAttribute(int type) -{ - addAttribute(type, NULL, 0); -} - -void SgStatement::addAttribute(void *a, int size) -{ - addAttribute(0, a, size); -} - - - - -////////////////// ATTRIBUTE FOR SgExpression ///////////////////// - - -int SgExpression::numberOfAttributes() -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLlndAttribute(thellnd); - if (!first) - return 0; - while (first) - { - first = first->getNext(); - nb++; - } - return nb; -} - - -int SgExpression::numberOfAttributes(int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLlndAttribute(thellnd); - if (!first) - return 0; - while (first) - { - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return nb; -} - - - -SgAttribute *SgExpression::getAttribute(int i) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLlndAttribute(thellnd); - if (!first) - return NULL; - while (first) - { - if (nb == i) - return first; - first = first->getNext(); - nb++; - } - return NULL; -} - - -SgAttribute *SgExpression::getAttribute(int i, int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLlndAttribute(thellnd); - if (!first) - return NULL; - while (first) - { - if ((nb == i) && (first->getAttributeType() == type)) - return first; - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return NULL; -} - -void *SgExpression::attributeValue(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeData(); - else - return NULL; -} - - -void *SgExpression::attributeValue(int i, int type) -{ - SgAttribute *first; - - if ( (first = getAttribute(i,type)) != 0) - return first->getAttributeData(); - else - return NULL; -} - -int SgExpression::attributeType(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeType(); - else - return 0; -} - - -void *SgExpression::deleteAttribute(int i) -{ - SgAttribute *tobedel, *before, *after; - void *data = NULL; - - tobedel = getAttribute(i); - if (!tobedel) return NULL; - - if (i > 0) - { - before = getAttribute(i-1); - before->setNext(tobedel->getNext()); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } else - { - after = tobedel->getNext(); - SetMappingInTableForLlndAttribute(thellnd,after); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } - - return data; -} - -void SgExpression::addAttribute(int type, void *a, int size) -{ - SgAttribute *first, *last; - first = GetMappingInTableForLlndAttribute(thellnd); - if (!first) - { - first = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, first, 1); -#endif - SetMappingInTableForLlndAttribute(thellnd,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - first->setNext(last); - } -} - - -void SgExpression::addAttribute(SgAttribute *att) -{ - SgAttribute *first, *last; - if (!att) return; - first = GetMappingInTableForLlndAttribute(thellnd); - if (!first) - { - first = att; - SetMappingInTableForLlndAttribute(thellnd,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = att; - first->setNext(last); - } -} - -void SgExpression::addAttributeTree(SgAttribute* firstAtt) -{ - if (!firstAtt) - return; - SetMappingInTableForLlndAttribute(thellnd, firstAtt); -} - -void SgExpression::addAttribute(int type) -{ - addAttribute(type, NULL, 0); -} - - -void SgExpression::addAttribute(void *a, int size) -{ - addAttribute(0, a, size); -} - - - -////////////////// ATTRIBUTE FOR SgSymbol ///////////////////// - - -int SgSymbol::numberOfAttributes() -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForSymbolAttribute(thesymb); - if (!first) - return 0; - while (first) - { - first = first->getNext(); - nb++; - } - return nb; -} - - -int SgSymbol::numberOfAttributes(int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForSymbolAttribute(thesymb); - if (!first) - return 0; - while (first) - { - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return nb; -} - - - -SgAttribute *SgSymbol::getAttribute(int i) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForSymbolAttribute(thesymb); - if (!first) - return NULL; - while (first) - { - if (nb == i) - return first; - first = first->getNext(); - nb++; - } - return NULL; -} - - -SgAttribute *SgSymbol::getAttribute(int i, int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForSymbolAttribute(thesymb); - if (!first) - return NULL; - while (first) - { - if ((nb == i) && (first->getAttributeType() == type)) - return first; - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return NULL; -} - -void *SgSymbol::attributeValue(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeData(); - else - return NULL; -} - - -void *SgSymbol::attributeValue(int i, int type) -{ - SgAttribute *first; - - if ( (first = getAttribute(i,type)) != 0) - return first->getAttributeData(); - else - return NULL; -} - -int SgSymbol::attributeType(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeType(); - else - return 0; -} - - -void *SgSymbol::deleteAttribute(int i) -{ - SgAttribute *tobedel, *before, *after; - void *data = NULL; - - tobedel = getAttribute(i); - if (!tobedel) return NULL; - - if (i > 0) - { - before = getAttribute(i-1); - before->setNext(tobedel->getNext()); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } else - { - after = tobedel->getNext(); - SetMappingInTableForSymbolAttribute(thesymb,after); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } - - return data; -} - -void SgSymbol::addAttribute(int type, void *a, int size) -{ - SgAttribute *first, *last; - first = GetMappingInTableForSymbolAttribute(thesymb); - if (!first) - { - first = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, first, 1); -#endif - SetMappingInTableForSymbolAttribute(thesymb,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - first->setNext(last); - } -} - - -void SgSymbol::addAttribute(SgAttribute *att) -{ - SgAttribute *first, *last; - if (!att) return; - first = GetMappingInTableForSymbolAttribute(thesymb); - if (!first) - { - first = att; - SetMappingInTableForSymbolAttribute(thesymb,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = att; - first->setNext(last); - } -} - - -void SgSymbol::addAttribute(int type) -{ - addAttribute(type, NULL, 0); -} - - -void SgSymbol::addAttribute(void *a, int size) -{ - addAttribute(0, a, size); -} - - -void SgSymbol::changeName(const char *name) -{ - if (name) - { - if (SYMB_IDENT(thesymb)) - { -#ifdef __SPF - removeFromCollection(SYMB_IDENT(thesymb)); -#endif - free(SYMB_IDENT(thesymb)); - } - - char *str = (char *)xmalloc(strlen(name) + 1); - strcpy(str, name); - SYMB_IDENT(thesymb) = str; - } -} - - -////////////////// ATTRIBUTE FOR SgType ///////////////////// - - -int SgType::numberOfAttributes() -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForTypeAttribute(thetype); - if (!first) - return 0; - while (first) - { - first = first->getNext(); - nb++; - } - return nb; -} - - -int SgType::numberOfAttributes(int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForTypeAttribute(thetype); - if (!first) - return 0; - while (first) - { - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return nb; -} - - - -SgAttribute *SgType::getAttribute(int i) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForTypeAttribute(thetype); - if (!first) - return NULL; - while (first) - { - if (nb == i) - return first; - first = first->getNext(); - nb++; - } - return NULL; -} - - -SgAttribute *SgType::getAttribute(int i, int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForTypeAttribute(thetype); - if (!first) - return NULL; - while (first) - { - if ((nb == i) && (first->getAttributeType() == type)) - return first; - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return NULL; -} - -void *SgType::attributeValue(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeData(); - else - return NULL; -} - - -void *SgType::attributeValue(int i, int type) -{ - SgAttribute *first; - - if ( (first = getAttribute(i,type)) != 0) - return first->getAttributeData(); - else - return NULL; -} - -int SgType::attributeType(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeType(); - else - return 0; -} - - -void *SgType::deleteAttribute(int i) -{ - SgAttribute *tobedel, *before, *after; - void *data = NULL; - - tobedel = getAttribute(i); - if (!tobedel) return NULL; - - if (i > 0) - { - before = getAttribute(i-1); - before->setNext(tobedel->getNext()); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } else - { - after = tobedel->getNext(); - SetMappingInTableForTypeAttribute(thetype,after); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } - - return data; -} - -void SgType::addAttribute(int type, void *a, int size) -{ - SgAttribute *first, *last; - first = GetMappingInTableForTypeAttribute(thetype); - if (!first) - { - first = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, first, 1); -#endif - SetMappingInTableForTypeAttribute(thetype,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - first->setNext(last); - } -} - - -void SgType::addAttribute(SgAttribute *att) -{ - SgAttribute *first, *last; - if (!att) return; - first = GetMappingInTableForTypeAttribute(thetype); - if (!first) - { - first = att; - SetMappingInTableForTypeAttribute(thetype,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = att; - first->setNext(last); - } -} - - -void SgType::addAttribute(int type) -{ - addAttribute(type, NULL, 0); -} - - -void SgType::addAttribute(void *a, int size) -{ - addAttribute(0, a, size); -} - -////////////////// ATTRIBUTE FOR SgLabel ///////////////////// -// Kataev 21.03.2013 - -SgLabel::SgLabel(SgLabel &lab) -{ -#ifndef __SPF - Message("SgLabel: copy constructor not allowed", 0); -#endif - thelabel = lab.thelabel; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgLabel::SgLabel(PTR_LABEL lab) -{ - thelabel = lab; - SetMappingInTableForLabel(thelabel, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgLabel::SgLabel(int i) -{ - thelabel = (PTR_LABEL)newNode(LABEL_KIND); - LABEL_STMTNO(thelabel) = i; - SetMappingInTableForLabel(thelabel, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgLabel::~SgLabel() -{ -#if __SPF - removeFromCollection(this); -#endif - RemoveFromTableLabel((void *)this); -} - -int SgLabel::numberOfAttributes() -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLabelAttribute(thelabel); - if (!first) - return 0; - while (first) - { - first = first->getNext(); - nb++; - } - return nb; -} - - -int SgLabel::numberOfAttributes(int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLabelAttribute(thelabel); - if (!first) - return 0; - while (first) - { - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return nb; -} - - - -SgAttribute *SgLabel::getAttribute(int i) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLabelAttribute(thelabel); - if (!first) - return NULL; - while (first) - { - if (nb == i) - return first; - first = first->getNext(); - nb++; - } - return NULL; -} - - -SgAttribute *SgLabel::getAttribute(int i, int type) -{ - SgAttribute *first; - int nb = 0; - first = GetMappingInTableForLabelAttribute(thelabel); - if (!first) - return NULL; - while (first) - { - if ((nb == i) && (first->getAttributeType() == type)) - return first; - if (first->getAttributeType() == type) - nb++; - first = first->getNext(); - } - return NULL; -} - -void *SgLabel::attributeValue(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeData(); - else - return NULL; -} - - -void *SgLabel::attributeValue(int i, int type) -{ - SgAttribute *first; - - if ( (first = getAttribute(i,type)) != 0) - return first->getAttributeData(); - else - return NULL; -} - -int SgLabel::attributeType(int i) -{ - SgAttribute *first; - - if ( (first = getAttribute(i)) != 0) - return first->getAttributeType(); - else - return 0; -} - - -void *SgLabel::deleteAttribute(int i) -{ - SgAttribute *tobedel, *before, *after; - void *data = NULL; - - tobedel = getAttribute(i); - if (!tobedel) return NULL; - - if (i > 0) - { - before = getAttribute(i-1); - before->setNext(tobedel->getNext()); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } else - { - after = tobedel->getNext(); - SetMappingInTableForLabelAttribute(thelabel,after); - data = tobedel->getAttributeData(); -#ifdef __SPF - removeFromCollection(tobedel); -#endif - delete tobedel; - } - - return data; -} - -void SgLabel::addAttribute(int type, void *a, int size) -{ - SgAttribute *first, *last; - first = GetMappingInTableForLabelAttribute(thelabel); - if (!first) - { - first = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, first, 1); -#endif - SetMappingInTableForLabelAttribute(thelabel,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = new SgAttribute(type,a,size, *this, CurrentFileNumber); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - first->setNext(last); - } -} - - -void SgLabel::addAttribute(SgAttribute *att) -{ - SgAttribute *first, *last; - if (!att) return; - first = GetMappingInTableForLabelAttribute(thelabel); - if (!first) - { - first = att; - SetMappingInTableForLabelAttribute(thelabel,first); - } else - { - while (first->getNext()) - { - first = first->getNext(); - } - last = att; - first->setNext(last); - } -} - - -void SgLabel::addAttribute(int type) -{ - addAttribute(type, NULL, 0); -} - - -void SgLabel::addAttribute(void *a, int size) -{ - addAttribute(0, a, size); -} - -//////////////////////////////////////////////////////////////////////// -// This routines performa garbage collection on Expression Statements // -// not to use simultaneously with the data dependence information that// -// creates nodes not to be removed // -// This use the attribute mechanism // -// two flags are used, one the user can set to avoid a node to be // -// garbage // -// #define NOGARBAGE_ATTRIBUTE // -// the following one internal to the system // -// #define GARBAGE_ATTRIBUTE // -// return the number of nodes collected // -//////////////////////////////////////////////////////////////////////// - - -void saveattXXXGarbage (void *dat,FILE *f) -{ - int *t; - if (!dat || !f) - return; - - t = (int *) dat; - fprintf(f,"Value of the attributes---> %d %d\n",t[0], t[1]); - -} - -void markExpression(SgExpression *exp) -{ - int *garinfo; - - if (!exp) return; - if (!isALoNode(exp->variant())) - { - Message("Trying to mark a non Expression Node in Garbage Collection",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - return; - } - - garinfo = (int *) exp->attributeValue(0,GARBAGE_ATTRIBUTE); - if (garinfo[1]) return; // avoid looping, already visited (necessary???); - garinfo[0]++; - garinfo[1] = 1; // visited; - - markExpression(exp->lhs()); - markExpression(exp->rhs()); -} - -int SgFile::expressionGarbageCollection(int deleteExpressionNode, int verbose) -{ - - SgExpression *exp, *previous, *def, *use, *ann; - SgStatement *stmt; - SgSymbol *symb; - SgType *type; - int *garinfo; - int i,j; - SgConstantSymb *cstsymb; - SgArrayType *arr; - int nbatt, typeat; - int curident; - PTR_LLND last = NULL; - int nbdeleted = 0; - - if (verbose) - printf("garbage collection in process, please wait (did you had coffee yet?)\n"); - - if (deleteExpressionNode) - setFreeListForExpressionNode(); - else - resetFreeListForExpressionNode(); - - for (exp = this->firstExpression(); exp; exp = exp->nextInExprTable()) - { - garinfo = new int[2]; -#ifdef __SPF - addToCollection(__LINE__, __FILE__, garinfo, 2); -#endif - garinfo[0] = 0; - garinfo[1] = 0; - exp->addAttribute(GARBAGE_ATTRIBUTE,(void *) garinfo, 2*sizeof(int)); - } - - for (stmt = this->firstStatement(); stmt; stmt = stmt->lexNext()) - { - markExpression(stmt->expr(0)); - markExpression(stmt->expr(1)); - markExpression(stmt->expr(2)); - def = (SgExpression *) stmt->attributeValue(0,DEFINEDLIST_ATTRIBUTE); - markExpression(def); - use = (SgExpression *) stmt->attributeValue(0,USEDLIST_ATTRIBUTE); - markExpression(use); - nbatt = stmt->numberOfAttributes(); - for (j = 0; j < nbatt ; j++) - { - typeat = stmt->attributeType(j); - if (typeat == ANNOTATION_EXPR_ATTRIBUTE) - { - ann = (SgExpression *) stmt->attributeValue(j); - markExpression(ann); - } - } - } - - // needs more, to be completed later; - - for (symb = this->firstSymbol(); symb; symb = symb->next()) - { - // according to the type symbol, it may have pointer to a llnd; - if ( (cstsymb = isSgConstantSymb(symb)) != 0) - { - markExpression(cstsymb->constantValue()); - } - } - - for (type = this->firstType(); type; type = type->next()) - { - if ( (arr = isSgArrayType(type)) != 0) - { - for (i = 0; i < arr->dimension(); i++) - markExpression(type->length()); - } - if ((type->variant() != DEFAULT) && isAtomicType(type->variant())) - { - // check for the range; an mark it; - markExpression(type->length()); - } - } - // actually remove the nodes; - // this->saveAttributes("markedNODES",saveattXXXGarbage); For debug purpose; - previous = this->firstExpression(); - if (previous) - { - // keep the first one to avoid to much trouble; - // to be removed later. - for (exp = previous->nextInExprTable(); exp; exp = exp->nextInExprTable()) - { - if (!isALoNode(exp->variant()) || (exp->variant() == DEFAULT)) - { - Message("Trying to USE a non Expression Node in Garbage Collection",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - if (!exp->getAttribute(0,NOGARBAGE_ATTRIBUTE)) - { - garinfo = (int *) exp->attributeValue(0,GARBAGE_ATTRIBUTE); - if (!garinfo[0]) - { - // remove the node; - // first remove all the attribute; -#ifdef __SPF - removeFromCollection(garinfo); -#endif - delete garinfo; - // removes all the attributes; - while (exp->deleteAttribute(0)); - // now delete the node from the data base; - NODE_NEXT(previous->thellnd) = NODE_NEXT(exp->thellnd); - curident = exp->id(); - libFreeExpression(exp->thellnd); - llndTableClass[curident] = NULL; -#ifdef __SPF - removeFromCollection(exp); -#endif - delete exp; - exp = previous; - nbdeleted++; - } else - previous = exp; - } else - previous = exp; - } - // now remove the garbage attribute for all nodes; - previous = this->firstExpression(); - for (exp = previous; exp; exp = exp->nextInExprTable()) - { - if (!isALoNode(exp->variant()) || (exp->variant() == DEFAULT)) - { - Message("Trying to USE (1) a non Expression Node in Garbage Collection",0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - nbatt = exp->numberOfAttributes(); - for (j = 0; j < nbatt ; j++) - { - typeat = exp->attributeType(j); - if (typeat == GARBAGE_ATTRIBUTE) - { - garinfo = (int *) exp->attributeValue(0,GARBAGE_ATTRIBUTE); -#ifdef __SPF - removeFromCollection(garinfo); -#endif - delete garinfo; - exp->deleteAttribute(j); - j--; - } - } - } - - // needs also to update the llnode numbers; - // no need to check the table, already allocated; - curident = 1; - previous = this->firstExpression(); - for (exp = previous; exp; exp = exp->nextInExprTable()) - { - if (!isALoNode(exp->variant()) || (exp->variant() == DEFAULT)) - { - Message("Trying to USE (1) a non Expression Node in Garbage Collection",0); - } - last = exp->thellnd; - llndTableAttribute[curident] = llndTableAttribute[NODE_ID(exp->thellnd)]; - NODE_ID(exp->thellnd) = curident; - llndTableClass[curident] = (void *) exp; - curident++; - } - number_of_ll_node = curident-1; - CUR_FILE_NUM_LLNDS() = curident-1; - CUR_FILE_CUR_LLND() = last; - } - return nbdeleted; -} - -//////////////////////////// TEMPLATE RELATED STUFF ///////////////////////// - -SgTemplateStmt::SgTemplateStmt(SgExpression *arglist) - :SgStatement(TEMPLATE_FUNDECL){ - if(arglist) - BIF_LL1(thebif) = arglist->thellnd; - // probably should change the scope of the symbols in this list. -} -SgExpression * SgTemplateStmt::AddArg(char *name, SgType &t){ - // returns decl expr created. if name == null this is a type arg - PTR_SYMB symb; - SgExpression *arg; - SgSymbol *s; - - s = new SgVariableSymb(name, t, *this); //create the variable with scope -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - symb = s->thesymb; - appendSymbToArgList(BIF_SYMB(thebif),symb); - arg = SgMakeDeclExp(s, &t); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg->thellnd); - return arg; -} - -SgExpression * SgTemplateStmt::AddArg(char *name, SgType &t, - SgExpression &init) -{ - PTR_SYMB symb; - PTR_LLND ll; - SgExpression *arg, *ref; - SgSymbol *s; - - if(name == NULL){ - name = new char; -#ifdef __SPF - addToCollection(__LINE__, __FILE__, name, 1); -#endif - *name = (char) 0; - } - s = new SgVariableSymb(name, t, *this); //create the variable with scope -#ifdef __SPF - addToCollection(__LINE__, __FILE__, s, 1); -#endif - symb = s->thesymb; - appendSymbToArgList(BIF_SYMB(thebif),symb); - ref = SgMakeDeclExp(s, &t); - arg = &SgAssignOp(*ref, init); - ll = BIF_LL1(thebif); - ll = NODE_OPERAND0(ll); - NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg->thellnd); - return arg; -} - -int SgTemplateStmt::numberOfArgs(){ - return exprListLength(BIF_LL1(thebif)); -} -SgExpression * SgTemplateStmt::arg(int i){ - return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); -} -SgExpression * SgTemplateStmt::argList(){ - return LlndMapping(BIF_LL1(thebif)); -} -void SgTemplateStmt::addFunction(SgFuncHedrStmt &theTemplateFunc){ - this->insertStmtAfter(theTemplateFunc,*this); -} -void SgTemplateStmt::addClass(SgClassStmt &theTemplateClass){ - this->insertStmtAfter(theTemplateClass,*this); -} -SgFuncHedrStmt * SgTemplateStmt::isFunction(){ - PTR_BLOB blob; - SgStatement *x; - blob = lookForBifInBlobList(BIF_BLOB1(BIF_CP(thebif)), thebif); - if (!blob) - return NULL; - x = BfndMapping(BLOB_VALUE(blob)); - return isSgFuncHedrStmt(x); -} -SgClassStmt * SgTemplateStmt::isClass(){ - PTR_BLOB blob; - SgStatement *x; - blob = lookForBifInBlobList(BIF_BLOB1(BIF_CP(thebif)), thebif); - if (!blob) - return NULL; - x = BfndMapping(BLOB_VALUE(blob)); - return isSgClassStmt(x); -} - -//- the T_DERIVED_TEMPLATE class functions - -SgDerivedTemplateType::SgDerivedTemplateType(SgExpression *arg_vals, - SgSymbol *classname): SgType(T_DERIVED_TEMPLATE){ - if(classname) - TYPE_TEMPL_NAME(thetype) = classname->thesymb; - if(arg_vals) - TYPE_TEMPL_ARGS(thetype) = arg_vals->thellnd; - -} -SgExpression * SgDerivedTemplateType::argList(){ - return LlndMapping(TYPE_TEMPL_ARGS(thetype)); -} - -void SgDerivedTemplateType::addArg(SgExpression *arg){ - TYPE_TEMPL_ARGS(thetype) = - addToExprList(TYPE_TEMPL_ARGS(thetype),arg->thellnd); -} - -int SgDerivedTemplateType::numberOfArgs(){ - return exprListLength(TYPE_TEMPL_ARGS(thetype)); -} -SgExpression * SgDerivedTemplateType::arg(int i){ - return LlndMapping(getPositionInExprList(TYPE_TEMPL_ARGS(thetype), i)); -} -void SgDerivedTemplateType::setName(SgSymbol &s){ - TYPE_TEMPL_NAME(thetype) = s.thesymb; -} -SgSymbol * SgDerivedTemplateType::typeName(){ - return SymbMapping(TYPE_TEMPL_NAME(thetype)); -} - -////////////////////////////////////// ADDED GENERIC METHODS ///////////////////// - -SgStatement::SgStatement(int code, SgLabel *lab, SgSymbol *symb, SgExpression *e1, SgExpression *e2, SgExpression *e3) -{ - thebif = (PTR_BFND)newNode(code); - - BIF_SYMB(thebif) = NULL; - BIF_LL1(thebif) = NULL; - BIF_LL2(thebif) = NULL; - BIF_LL3(thebif) = NULL; - BIF_LABEL(thebif) = NULL; - - if (lab) BIF_LABEL(thebif) = lab->thelabel; - if (symb) BIF_SYMB(thebif) = symb->thesymb; - if (e1) BIF_LL1(thebif) = e1->thellnd; - if (e2) BIF_LL2(thebif) = e2->thellnd; - if (e3) BIF_LL3(thebif) = e3->thellnd; - - // this should be function of low_level.c - switch (BIF_CODE(thebif)) - { // node that can be a bif control parent - case GLOBAL: - case PROG_HEDR: - case PROC_HEDR: - case PROS_HEDR: - case BASIC_BLOCK: - case IF_NODE: - case WHERE_BLOCK_STMT: - case LOOP_NODE: - case FOR_NODE: - case FORALL_NODE: - case WHILE_NODE: - case CDOALL_NODE: - case SDOALL_NODE: - case DOACROSS_NODE: - case CDOACROSS_NODE: - case FUNC_HEDR: - case ENUM_DECL: - case STRUCT_DECL: - case UNION_DECL: - case CLASS_DECL: - case TECLASS_DECL: - case COLLECTION_DECL: - case SWITCH_NODE: - case EXTERN_C_STAT: - addControlEndToStmt(thebif); - break; - } - - fileID = current_file_id; - project = CurrentProject; - unparseIgnore = false; -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::SgType(int var, SgExpression *len, SgType *base) -{ - if (!isATypeNode(var)) - { - Message("Attempt to create a type node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thetype = (PTR_TYPE)newNode(T_INT); - } - else - thetype = (PTR_TYPE)newNode(var); - - if (len) - { - TYPE_RANGES(thetype) = len->thellnd; - } - if (base) - { - TYPE_BASE(thetype) = base->thetype; - } - SetMappingInTableForType(thetype, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::SgType(int var, SgSymbol *symb, SgExpression *len, SgType *base) -{ - if (!isATypeNode(var)) - { - Message("Attempt to create a type node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thetype = (PTR_TYPE)newNode(T_INT); - } - else - thetype = (PTR_TYPE)newNode(var); - - if (len) - { - TYPE_RANGES(thetype) = len->thellnd; - } - if (base) - { - TYPE_BASE(thetype) = base->thetype; - } - if (symb) - { - TYPE_SYMB(thetype) = symb->thesymb; - } - SetMappingInTableForType(thetype, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::SgType(int var, SgSymbol *symb) -{ - if (!isATypeNode(var)) - { - Message("Attempt to create a type node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thetype = (PTR_TYPE)newNode(T_INT); - } - else - thetype = (PTR_TYPE)newNode(var); - if (symb) - { - TYPE_SYMB_DERIVE(thetype) = symb->thesymb; - } - SetMappingInTableForType(thetype, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::SgType(int var, SgSymbol *firstfield, SgStatement *structstmt) -{ - if (!isATypeNode(var)) - { - Message("Attempt to create a type node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thetype = (PTR_TYPE)newNode(T_INT); - } - else - thetype = (PTR_TYPE)newNode(var); - - if (structstmt) - TYPE_COLL_ORI_CLASS(thetype) = structstmt->thebif; - if (firstfield) - TYPE_COLL_FIRST_FIELD(thetype) = firstfield->thesymb; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::SgType(PTR_TYPE type) -{ - thetype = type; - SetMappingInTableForType(thetype, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::SgType(SgType &t) -{ - thetype = t.thetype; -#ifndef __SPF - Message("SgType: no copy constructor allowed", 0); -#endif - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - -SgType::~SgType() -{ -#if __SPF - removeFromCollection(this); -#endif -} - -SgSymbol::SgSymbol(int variant, const char *identifier, SgType *type, SgStatement *scope, SgSymbol *structsymb, SgSymbol *nextfield) -{ - if (!isASymbNode(variant)) - { - Message("Attempt to create a symbol node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); - } - else - thesymb = newSymbol(variant, identifier, NULL); - - if (type) - SYMB_TYPE(thesymb) = type->thetype; - - if (scope) - SYMB_SCOPE(thesymb) = scope->thebif; - - if (structsymb) - { - if (variant == MEMBER_FUNC) - SYMB_MEMBER_BASENAME(thesymb) = structsymb->thesymb; - else - SYMB_FIELD_BASENAME(thesymb) = structsymb->thesymb; - } - - if (nextfield) - { - if (variant == FIELD_NAME) - SYMB_NEXT_FIELD(thesymb) = nextfield->thesymb; - else - SYMB_MEMBER_NEXT(thesymb) = nextfield->thesymb; - } - SetMappingInTableForSymb(thesymb, (void *)this); - - fileID = current_file_id; - project = CurrentProject; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - - -SgExpression::SgExpression(int variant, char *str) -{ - if (!isALoNode(variant)) - { - Message("Attempt to create a low level node with a variant that is not", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - // arbitrary choice for the variant - thellnd = (PTR_LLND)newNode(EXPR_LIST); - } - else - thellnd = (PTR_LLND)newNode(variant); - NODE_STR(thellnd) = str; - SetMappingInTableForLlnd(thellnd, (void *)this); - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 1); -#endif -} - - -///// a supoort routine for the sage code generator ////// - - -SgLabel* getLabel(int id) -{ - PTR_LABEL lab; - - // first check its there; - if ( (lab = Get_label_with_id(id)) != 0) - return LabelMapping(lab); - else - { - SgLabel *ret = new SgLabel(id); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, ret, 1); -#endif - return ret; - } -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.uni b/projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.uni deleted file mode 100644 index ea138c3..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.uni +++ /dev/null @@ -1,40 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/Sage++/makefile.win - -LIBDIR = ../../lib - -HDRS = ../h -LIBINCLUDE = ../lib/include -SAGEINCLUDE = -I$(HDRS) -I$(LIBINCLUDE) - -# Directory in which include files can be found -INCLUDEDIR = ./h -INCL = -I$(INCLUDEDIR) $(SAGEINCLUDE) - -CFLAGS = $(INCL) -c -Wall -TOOLSage_SRC = libSage++.cpp - -TOOLSage_HDR = $(LIBINCLUDE)/macro.h $(LIBINCLUDE)/bif_node.def \ - $(LIBINCLUDE)/type.def $(LIBINCLUDE)/symb.def $(LIBINCLUDE)/libSage++.h - -TOOLSage_OBJ = libSage++.o - -libSage++.o: libSage++.cpp $(TOOLSage_HDR) - $(CXX) $(CFLAGS) libSage++.cpp - -$(LIBDIR)/libSage++.a: $(TOOLSage_OBJ) - ar qc $(LIBDIR)/libSage++.a $(TOOLSage_OBJ) - -all : $(LIBDIR)/libSage++.a - @echo "*** COMPILING LIBRARY Sage++ DONE" - - -clean: - rm -f libSage++.o - -cleanall: - rm -f libSage++.o diff --git a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.win b/projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.win deleted file mode 100644 index 3237d9e..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/Sage++/makefile.win +++ /dev/null @@ -1,49 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/Sage++/makefile.win - -OUTDIR = ../../obj -LIBDIR = ../../lib - -HDRS = ../h -LIBINCLUDE = ../lib/include -SAGEINCLUDE = -I$(HDRS) -I$(LIBINCLUDE) - -# Directory in which include files can be found -INCLUDEDIR = ./h -INCL = -I$(INCLUDEDIR) $(SAGEINCLUDE) - -LIB32=$(LINKER) -lib -LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libSage++.lib" - -# -w don't issue warning now. -#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" $(INCL) \ -# /Fp"$(OUTDIR)/libSage++.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c -CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" $(INCL) \ - /Fp"$(OUTDIR)/libSage++.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c - -TOOLSage_SRC = libSage++.cpp - -TOOLSage_HDR = $(LIBINCLUDE)/macro.h $(LIBINCLUDE)/bif_node.def \ - $(LIBINCLUDE)/type.def $(LIBINCLUDE)/symb.def $(LIBINCLUDE)/libSage++.h - -TOOLSage_OBJ = $(OUTDIR)/libSage++.obj - -$(OUTDIR)/libSage++.obj: libSage++.cpp $(TOOLSage_HDR) - $(CXX) $(CFLAGS) libSage++.cpp - -$(LIBDIR)/libSage++.lib: $(TOOLSage_OBJ) - $(LIB32) @<< - $(LIB32_FLAGS) $(TOOLSage_OBJ) -<< - -all : $(LIBDIR)/libSage++.lib - @echo "*** COMPILING LIBRARY Sage++ DONE" - - -clean: - -cleanall: diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/Makefile b/projects/dvm_svn/fdvm/trunk/Sage/h/Makefile deleted file mode 100644 index 0eb57af..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -####################################################################### -## pC++/Sage++ Copyright (C) 1993 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - - -CC = gcc -CC = cc -CXX = g++ -CXX = DCC - -LINKER = $(CC) - -all: tag.h - -tag.h: head tag - ( cat head; \ - sed < tag \ - '/#defin/s/\([^ ]*\) \([^ ]*\)\(.*\)/ tag \[ \2 \] = \"\2\";/')\ - > tag.h diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/bif.h b/projects/dvm_svn/fdvm/trunk/Sage/h/bif.h deleted file mode 100644 index c76326a..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/bif.h +++ /dev/null @@ -1,453 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/************************************************************************ - * * - * BIF NODES * - * * - ************************************************************************/ - -struct bfnd { - - int variant, id; /* variant and identification tags */ - int index; /* used in the strongly con. comp. routines */ - int g_line, l_line; /* global & local line numbers */ - int decl_specs; /* declaration specifiers stored with - bif nodes: static, extern, friend, and inline */ - - PTR_LABEL label; - PTR_BFND thread; - - PTR_FNAME filename; /* point to the source filename */ - - PTR_BFND control_parent; /* current bif node in on the control blob list - of control_parent */ - PTR_PLNK prop_list; /* property list */ - - union bfnd_union { - - struct { - PTR_BFND bf_ptr1; /* used by the parser and should */ - PTR_CMNT cmnt_ptr; /* to attach comments */ - - PTR_SYMB symbol; /* a symbol table entry */ - - PTR_LLND ll_ptr1; /* an L-value expr tree */ - PTR_LLND ll_ptr2; /* an R-value expr tree */ - PTR_LLND ll_ptr3; /* a spare expr tree (see below) */ - - PTR_LABEL lbl_ptr; /* used by do */ - - PTR_BLOB bl_ptr1; /* a list of control dep subnodes */ - PTR_BLOB bl_ptr2; /* another such list (for if stmt) */ - - PTR_DEP dep_ptr1; /* a list of dependences nodes */ - PTR_DEP dep_ptr2; /* another list of dep nodes */ - - PTR_SETS sets; /* a list of sets like GEN, KILL etc */ - } Template; - - struct { - PTR_BFND proc_list; /* a list of procedures in this file */ - PTR_CMNT cmnt_ptr; - - PTR_SYMB list; /* list of global const and type */ - - PTR_LLND null_2; - PTR_LLND null_3; - PTR_LLND null_4; - - PTR_LABEL null_5; - - PTR_BLOB control; /* used for list of procedures */ - PTR_BLOB null_6; - - PTR_DEP null_7; - PTR_DEP null_8; - - PTR_SETS null_9; - } Global; - - struct { - PTR_BFND next_prog; - PTR_CMNT cmnt_ptr; - - PTR_SYMB prog_symb; - - PTR_LLND null_1; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB control; - PTR_BLOB format_group; - - PTR_DEP null_5; - PTR_DEP null_6; - - PTR_SETS null_7; - } program; - - struct { - PTR_BFND next_proc; - PTR_CMNT cmnt_ptr; - - PTR_SYMB proc_symb; - - PTR_LLND null_1; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB control; - PTR_BLOB format_group; - - PTR_DEP null_5; - PTR_DEP null_6; - - PTR_SETS null_7; - } procedure; - - struct { - PTR_BFND next_func; - PTR_CMNT cmnt_ptr; - - PTR_SYMB func_symb; - - PTR_LLND ftype; - PTR_LLND null_1; - PTR_LLND null_2; - - PTR_LABEL null_3; - - PTR_BLOB control; - PTR_BLOB format_group; - - PTR_DEP null_4; - PTR_DEP null_5; - - PTR_SETS null_6; - } function; - - struct { - PTR_BFND next_bif; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND null_2; - PTR_LLND null_3; - PTR_LLND null_4; - - PTR_LABEL null_5; - - PTR_BLOB control; - PTR_BLOB null_6; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } basic_block; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND null_2; - PTR_LLND null_3; - PTR_LLND null_4; - - PTR_LABEL null_5; - - PTR_BLOB null_6; - PTR_BLOB null_7; - - PTR_DEP null_8; - PTR_DEP null_9; - - PTR_SETS sets; - } control_end; - - struct { - PTR_BFND true_branch; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND condition; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB control_true; - PTR_BLOB control_false; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } if_node; - - struct { - PTR_BFND true_branch; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND condition; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB control_true; - PTR_BLOB control_false; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } where_node; - - struct { - PTR_BFND loop_end; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND null_2; - PTR_LLND null_3; - PTR_LLND null_4; - - PTR_LABEL null_5; - - PTR_BLOB control; - PTR_BLOB null_6; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } loop_node; - - struct { - PTR_BFND for_end; - PTR_CMNT cmnt_ptr; - - PTR_SYMB control_var; - - PTR_LLND range; - PTR_LLND increment; - PTR_LLND where_cond; - - PTR_LABEL doend; - - PTR_BLOB control; - PTR_BLOB null_1; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } for_node; - - struct { - PTR_BFND forall_end; - PTR_CMNT cmnt_ptr; - - PTR_SYMB control_var; - - PTR_LLND range; - PTR_LLND increment; - PTR_LLND where_cond; - - PTR_LABEL null_1; - - PTR_BLOB control; - PTR_BLOB null_2; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } forall_nd; - - struct { - PTR_BFND alldo_end; - PTR_CMNT cmnt_ptr; - - PTR_SYMB control_var; - - PTR_LLND range; - PTR_LLND increment; - PTR_LLND null_0; - - PTR_LABEL null_1; - - PTR_BLOB control; - PTR_BLOB null_2; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } alldo_nd; - - struct { - PTR_BFND while_end; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND condition; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB control; - PTR_BLOB null_5; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } while_node; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND condition; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB control_true; - PTR_BLOB control_false; - - PTR_DEP null_5; - PTR_DEP null_6; - - PTR_SETS sets; - } exit_node; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND l_value; - PTR_LLND r_value; - PTR_LLND null_2; - - PTR_LABEL null_3; - - PTR_BLOB null_4; - PTR_BLOB null_5; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } assign; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND l_value; - PTR_LLND r_value; - PTR_LLND null_2; - - PTR_LABEL null_3; - - PTR_BLOB null_4; - PTR_BLOB null_5; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } identify; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND spec_string; - PTR_LLND null_2; - PTR_LLND null_3; - - PTR_LABEL null_4; - - PTR_BLOB null_5; - PTR_BLOB null_6; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } format; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND format; /* used by blaze only */ - PTR_LLND expr_list; - PTR_LLND control_list; /* used by cedar fortan only */ - - PTR_LABEL null_2; - - PTR_BLOB null_3; - PTR_BLOB null_4; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } write_stat; - - struct { - PTR_BFND next_stat; - PTR_CMNT cmnt_ptr; - - PTR_SYMB null_1; - - PTR_LLND format; /* used by blaze only */ - PTR_LLND var_list; - PTR_LLND control_list; /* used by cedar fortran */ - - PTR_LABEL null_2; - - PTR_BLOB null_3; - PTR_BLOB null_4; - - PTR_DEP dep_from; - PTR_DEP dep_to; - - PTR_SETS sets; - } read_stat; - } entry; - }; - -#define __BIF_DEF__ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/compatible.h b/projects/dvm_svn/fdvm/trunk/Sage/h/compatible.h deleted file mode 100644 index 4768420..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/compatible.h +++ /dev/null @@ -1,77 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* Simple compatibility module for pC++/Sage (phb) */ - -/* include it only once... */ -#ifndef COMPATIBLE_H -#define COMPATIBLE_H - -#include "sage.h" - -#ifndef _NEEDALLOCAH_ -# if (defined(__ksr__) || (defined(SAGE_solaris2) && !defined(__GNUC__))) -# define _NEEDALLOCAH_ -# endif -#endif - -#ifdef __hpux -# ifndef SYS5 -# define SYS5 1 -# endif -#endif - -#ifdef _SEQUENT_ -# define NO_u_short - -# ifndef SYS5 -# define SYS5 1 -# endif -#endif - -#ifdef sparc -# if (defined(__svr4__) || defined(SAGE_solaris2)) /* Solaris 2!!! YUK! */ -# ifndef SYS5 -# define SYS5 1 -# endif -# endif -#endif - -#ifndef SYS5 -# define BSD 1 -#endif - -#ifdef _NEEDCALLOC_ -# ifdef CALLOC_DEF -# undef CALLOC_DEF -# endif - -# ifndef CALLOC_DEF -# ifdef __GNUC__ - extern void *calloc(); -# define CALLOC_DEF -# endif -# endif - -# ifndef CALLOC_DEF -# ifdef __ksr__ - extern void *calloc(); -# define CALLOC_DEF -# endif -# endif - -# ifndef CALLOC_DEF -# ifdef cray -# include "fixcray.h" -# endif -# endif - -# ifndef CALLOC_DEF - extern char *calloc(); -# endif - -#endif - -#endif diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/db.h b/projects/dvm_svn/fdvm/trunk/Sage/h/db.h deleted file mode 100644 index 36a1371..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/db.h +++ /dev/null @@ -1,187 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * db.h -- contains all definitions needed by the data base * - * management routines * - * * - ****************************************************************/ - - -#ifndef CallSiteE - -#ifndef FILE -# include -#endif - -#ifndef DEP_DIR -# include "defs.h" -#endif - -#ifndef __BIF_DEF__ -# include "bif.h" -#endif - -#ifndef __LL_DEF__ -# include "ll.h" -#endif - -#ifndef __SYMB_DEF__ -# include "symb.h" -#endif - -#ifndef MAX_LP_DEPTH -# include "sets.h" -#endif - - -/* - * Definitions for inquiring the information about variables - */ -#define Use 1 /* for inquiring USE info */ -#define Mod 2 /* for inquiring MOD info */ -#define UseMod 3 /* for inquiring both USE and MOD info */ -#define Alias 4 /* for inquiring ALIAS information */ - - -/* - * Definitions for inquiring the information about procedures - * This previous four definitions are shared here - */ -#define ProcDef 5 /* procedure's definition */ -#define CallSite 6 /* list of the call sites of this procedure */ -#define CallSiteE 7 /* the call sites extended with loop info */ -#define ExternProc 8 /* list of external procedures references */ - -/* - * Definitions for inquiring the information about files - */ -#define IncludeFile 1 /* list of files included by this file */ -#define GlobalVarRef 2 /* list of global variables referenced */ -#define ExternProcRef 3 /* list of external procedure referenced */ - - -/* - * Definitions for inquiring the information about project - */ -#define ProjFiles 1 /* get a list of .dep files make up the project */ -#define ProjNames 2 /* list of all procedures in the project */ -#define UnsolvRef 3 /* list of unsolved global references */ -#define ProjGlobals 4 /* list of all global declarations */ -#define ProjSrc 5 /* list of source files (e.g. .h, .c and .f) */ -/* - * Definition for blobl tree - */ -#define IsLnk 0 /* this blob1 node is only a link */ -#define IsObj 1 /* this blob1 node is a real object */ - - -/***************************** - * Some data structures used * - ******************************/ - -typedef struct proj_obj *PTR_PROJ; -typedef struct file_obj *PTR_FILE; -typedef struct blob1 *PTR_BLOB1; -typedef struct obj_info *PTR_INFO; -typedef char *(*PCF)(); - - -/* - * structure for the whole project - */ -struct proj_obj { - char *proj_name; /* project filename */ - PTR_BLOB file_chain; /* list of all opened files in the project */ - PTR_BLOB *hash_tbl; /* hash table of procedures declared */ - PTR_PROJ next; /* point to next project */ -}; - - -/* - * Structure for each files in the project - */ -struct file_obj { - char *filename; /* filename of the .dep file */ - FILE *fid; /* its file id */ - int lang; /* type of language */ - PTR_HASH *hash_tbl; /* hash table for this file obj */ - PTR_BFND global_bfnd; /* global BIF node for this file */ - PTR_BFND head_bfnd, /* head of BIF node for this file */ - cur_bfnd; - PTR_LLND head_llnd, /* head of low level node */ - cur_llnd; - PTR_SYMB head_symb, /* head of symbol node */ - cur_symb; - PTR_TYPE head_type, /* head of type node */ - cur_type; - PTR_BLOB head_blob, /* head of blob node */ - cur_blob; - PTR_DEP head_dep, /* head of dependence node */ - cur_dep; - PTR_LABEL head_lab, /* head of label node */ - cur_lab; - PTR_CMNT head_cmnt, /* head of comment node */ - cur_cmnt; - PTR_FNAME head_file; - int num_blobs, /* no. of blob nodes */ - num_bfnds, /* no. of bif nodes */ - num_llnds, /* no. of ll nodes */ - num_symbs, /* no. of symb nodes */ - num_label, /* no. of label nodes */ - num_types, /* no. of type nodes */ - num_files, /* no. of filename nodes */ - num_dep, /* no. of dependence nodes */ - num_cmnt; /* no. of comment nodes */ -}; - - -/* - * A cons obj structure - */ -struct blob1{ - char tag; /* type of this blob node */ - char *ref; /* pointer to the objects of interest */ - PTR_BLOB1 next;/* point to next cons obj */ -}; - - -/* - * Structure for information objects - */ -struct obj_info { - char *filename; /* filename of the reference */ - int g_line; /* absolute line number in the file */ - int l_line; /* relative line number to the object */ - char *source; /* source line */ -}; - - -/* - * Structure for property list - */ -struct prop_link { - char *prop_name; /* property name */ - char *prop_val; /* property value */ - PTR_PLNK next; /* point to the next property list */ -}; - -/* - * declaration of data base routines - */ -PTR_PROJ OpenProj(); -PTR_PROJ SelectProj(); -PTR_BLOB1 GetProjInfo(); -PTR_BLOB1 GetProcInfo(); -PTR_BLOB1 GetTypeInfo(); -PTR_BLOB1 GetTypeDef (); -PTR_BLOB1 GetVarInfo (); -PTR_BLOB1 GetDepInfo (); - -int AddToProj(); -int DelFromProj(); -#endif /* CallSiteE */ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/db.new.h b/projects/dvm_svn/fdvm/trunk/Sage/h/db.new.h deleted file mode 100644 index a37f189..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/db.new.h +++ /dev/null @@ -1,190 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * db.h -- contains all definitions needed by the data base * - * management routines * - * * - ****************************************************************/ - - -#ifndef CallSiteE - -#ifndef FILE -# include -#endif - -#ifndef DEP_DIR -# include "defs.h" -#endif - -#ifndef __BIF_DEF__ -# include "bif.h" -#endif - -#ifndef __LL_DEF__ -# include "ll.h" -#endif - -#ifndef __SYMB_DEF__ -# include "symb.h" -#endif - -#ifndef MAX_LP_DEPTH -# include "sets.h" -#endif - - -/* - * Definitions for inquiring the information about variables - */ -#define Use 1 /* for inquiring USE info */ -#define Mod 2 /* for inquiring MOD info */ -#define UseMod 3 /* for inquiring both USE and MOD info */ -#define Alias 4 /* for inquiring ALIAS information */ - - -/* - * Definitions for inquiring the information about procedures - * This previous four definitions are shared here - */ -#define ProcDef 5 /* procedure's definition */ -#define CallSite 6 /* list of the call sites of this procedure */ -#define CallSiteE 7 /* the call sites extended with loop info */ -#define ExternProc 8 /* list of external procedures references */ - -/* - * Definitions for inquiring the information about files - */ -#define IncludeFile 1 /* list of files included by this file */ -#define GlobalVarRef 2 /* list of global variables referenced */ -#define ExternProcRef 3 /* list of external procedure referenced */ - - -/* - * Definitions for inquiring the information about project - */ -#define ProjFiles 1 /* get a list of .dep files make up the project */ -#define ProjNames 2 /* list of all procedures in the project */ -#define UnsolvRef 3 /* list of unsolved global references */ -#define ProjGlobals 4 /* list of all global declarations */ -#define ProjSrc 5 /* list of source files (e.g. .h, .c and .f) */ -/* - * Definition for blobl tree - */ -#define IsLnk 0 /* this blob1 node is only a link */ -#define IsObj 1 /* this blob1 node is a real object */ - - -/***************************** - * Some data structures used * - ******************************/ - -typedef struct proj_obj *PTR_PROJ; -typedef struct file_obj *PTR_FILE; -typedef struct blob1 *PTR_BLOB1; -typedef struct obj_info *PTR_INFO; - - -/* - * structure for the whole project - */ -struct proj_obj { - char *proj_name; /* project filename */ - PTR_BLOB file_chain; /* list of all opened files in the project */ - PTR_BLOB *hash_tbl; /* hash table of procedures declared */ - PTR_PROJ next; /* point to next project */ -}; - - -/* - * Structure for each files in the project - */ -struct file_obj { - char *filename; /* filename of the .dep file */ - FILE *fid; /* its file id */ - int lang; /* type of language */ - PTR_HASH *hash_tbl; /* hash table for this file obj */ - PTR_BFND global_bfnd; /* global BIF node for this file */ - PTR_BFND head_bfnd, /* head of BIF node for this file */ - cur_bfnd; - PTR_LLND head_llnd, /* head of low level node */ - cur_llnd; - PTR_SYMB head_symb, /* head of symbol node */ - cur_symb; - PTR_TYPE head_type, /* head of type node */ - cur_type; - PTR_BLOB head_blob, /* head of blob node */ - cur_blob; - PTR_DEP head_dep, /* head of dependence node */ - cur_dep; - PTR_LABEL head_lab, /* head of label node */ - cur_lab; - PTR_CMNT head_cmnt, /* head of comment node */ - cur_cmnt; - PTR_FNAME head_file; - int num_blobs, /* no. of blob nodes */ - num_bfnds, /* no. of bif nodes */ - num_llnds, /* no. of ll nodes */ - num_symbs, /* no. of symb nodes */ - num_label, /* no. of label nodes */ - num_types, /* no. of type nodes */ - num_files, /* no. of filename nodes */ - num_dep, /* no. of dependence nodes */ - num_cmnt; /* no. of comment nodes */ -}; - - -/* - * A cons obj structure - */ -struct blob1{ - char tag; /* type of this blob node */ - char *ref; /* pointer to the objects of interest */ - PTR_BLOB1 next;/* point to next cons obj */ -}; - - -/* - * Structure for information objects - */ -struct obj_info { - char *filename; /* filename of the reference */ - int g_line; /* absolute line number in the file */ - int l_line; /* relative line number to the object */ - char *source; /* source line */ -}; - - -/* - * Structure for property list - */ -struct prop_link { - char *prop_name; /* property name */ - char *prop_val; /* property value */ - PTR_PLNK next; /* point to the next property list */ -}; - -/* - * declaration of data base routines - */ -typedef char *(*PCF)(); - -extern PCF UnparseBfnd[]; -extern PCF UnparseLlnd[]; -extern PCF UnparseSymb[]; -extern PCF UnparseType[]; - -PTR_PROJ OpenProj(); -PTR_BLOB1 GetProjInfo(); -PTR_BLOB1 GetProcInfo(); -PTR_BLOB1 GetTypeInfo(); -PTR_BLOB1 GetTypeDef (); -PTR_BLOB1 GetVarInfo (); -PTR_BLOB1 GetDepInfo (); - -#endif CallSiteE diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/defines.h b/projects/dvm_svn/fdvm/trunk/Sage/h/defines.h deleted file mode 100644 index 0a0f6be..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/defines.h +++ /dev/null @@ -1,56 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* label type codes */ - -#define LABUNKNOWN 0 -#define LABEXEC 1 -#define LABFORMAT 2 -#define LABOTHER 3 - - -/* parser states */ - -#define OUTSIDE 0 -#define INSIDE 1 -#define INDCL 2 -#define INDATA 3 -#define INEXEC 4 - -/* nesting states */ -#define IN_OUTSIDE 4 -#define IN_MODULE 3 -#define IN_PROC 2 -#define IN_INTERNAL_PROC 1 - -/* Control stack type */ - -#define CTLIF 0 -#define CTLELSEIF 1 -#define CTLELSE 2 -#define CTLDO 3 -#define CTLALLDO 4 - - -/* name classes -- vclass values */ - -#define CLUNKNOWN 0 -#define CLPARAM 1 -#define CLVAR 2 -#define CLENTRY 3 -#define CLMAIN 4 -#define CLBLOCK 5 -#define CLPROC 6 -#define CLNAMELIST 7 - -/* These are tobe used in decl_stat field of symbol */ -#define SOFT 0 /* Canbe Redeclared */ -#define HARD 1 /* Not allowed to redeclre */ - -/* Attributes (used in attr) */ -#define ATT_CLUSTER 0 -#define ATT_GLOBAL 1 - -#define SECTION_SUBSCRIPT 1 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/defs.h b/projects/dvm_svn/fdvm/trunk/Sage/h/defs.h deleted file mode 100644 index 66ec91f..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/defs.h +++ /dev/null @@ -1,131 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -#include "tag" - -#define hashMax 1007 /*max hash table size */ - -/**************** variant tags for dependence nodes *********************/ - -#define DEP_DIR 0200 /* direction vector information only */ -#define DEP_DIST 0000 /* direction and distance vector */ - -#define NO_ALL_ST_DEP 0010 /* no all statiionary dir for this pair of statements */ -#define DEP_CROSS 0100 /* dependence MUST wrap around loop */ -#define DEP_UNCROSS 0000 /* dependence MAY not wrap around loop */ - -#define DEP_FLOW 0 -#define DEP_ANTI 1 -#define DEP_OUTPUT 2 - -/************************************************************************/ - -typedef struct bfnd *PTR_BFND; -typedef struct llnd *PTR_LLND; -typedef struct blob *PTR_BLOB; -//typedef struct string *PTR_STRING; -typedef struct symb *PTR_SYMB; -typedef struct hash_entry *PTR_HASH; -typedef struct data_type *PTR_TYPE; -typedef struct dep *PTR_DEP; -typedef struct sets *PTR_SETS; -typedef struct def *PTR_DEF; -typedef struct deflst *PTR_DEFLST; -typedef struct Label *PTR_LABEL; -typedef struct cmnt *PTR_CMNT; -typedef struct file_name *PTR_FNAME; -typedef struct prop_link *PTR_PLNK; - -struct blob { - PTR_BFND ref; - PTR_BLOB next; -}; - - -struct Label { - int id; /* identification tag */ - PTR_BFND scope; /* level at which ident is declared */ - PTR_BLOB ud_chain; /* use-definition chain */ - unsigned labused :1; /* if it's been referenced */ - unsigned labinacc:1; /* illegal use of this label */ - unsigned labdefined:1; /* if this label been defined */ - unsigned labtype:2; /* UNKNOWN, EXEC, FORMAT, and OTHER */ - long stateno; /* statement label */ - PTR_LABEL next; /* point to next label entry */ - PTR_BFND statbody; /* point to body of statement */ - PTR_SYMB label_name; /* label name for VPC++ */ - /* The variant will be LABEL_NAME */ -}; - - -struct Ctlframe { - int ctltype; /* type of control frame */ - int level; /* block level */ - int dolabel; /* DO loop's end label */ - PTR_SYMB donamep; /* DO loop's control variable name */ - PTR_SYMB block_list; /* start of local decl */ - PTR_SYMB block_end; /* end of local decl */ - PTR_BFND loop_hedr; /* save the current loop header */ - PTR_BFND header; /* header of the block */ - PTR_BFND topif; /* keep track of if header */ - struct Ctlframe *next; /* thread */ -}; - -struct cmnt { - int id; - int type; - int counter; /* New Added for VPC++ */ - char* string; - struct cmnt *next; - struct cmnt *thread; -}; - - -struct file_name { /* for keep source filenames in the project */ - int id; - char *name; - PTR_FNAME next; -}; - - -#define NO 0 -#define YES 1 -#ifndef FALSE -# define FALSE 0 -#endif -#ifndef TRUE -# define TRUE 1 -#endif -#define BOOL int -#define EOL -1 -#define SAME_GROUP 0 -#define NEW_GROUP1 1 -#define NEW_GROUP2 2 -#define FULL 0 -#define HALF 1 - -#define DEFINITE 1 -#define DEFINITE_SAME 7 -#define DEFINITE_DIFFER 0 -#define FIRST_LARGER 2 -#define SECOND_LARGER 4 - - -/* - * Tags for various languages - */ -#define ForSrc 0 /* This is a Fortran program */ -#define CSrc 1 /* This is a C program */ -#define BlaSrc 2 /* This is a Blaze program */ - - -#define BFNULL (PTR_BFND) 0 -#define LLNULL (PTR_LLND) 0 -#define BLNULL (PTR_BLOB) 0 -#define SMNULL (PTR_SYMB) 0 -#define HSNULL (PTR_HASH) 0 -#define TYNULL (PTR_TYPE) 0 -#define LBNULL (PTR_LABEL)0 -#define CMNULL (PTR_CMNT)0 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/dep.h b/projects/dvm_svn/fdvm/trunk/Sage/h/dep.h deleted file mode 100644 index 281cb2a..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/dep.h +++ /dev/null @@ -1,39 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/************************************************************************/ -/* */ -/* DEPENDENCE NODES */ -/* */ -/************************************************************************/ - -# define MAX_LP_DEPTH 10 -# define MAX_DEP (MAX_LP_DEPTH+1) - -struct ref { /* reference of a variable */ - PTR_BFND stmt; /* statement containing reference */ - PTR_LLND refer; /* pointer to the actual reference */ - } ; - - -struct dep { /* data dependencies */ - - int id; /* identification for reading/writing */ - PTR_DEP thread; - - char type; /* flow-, output-, or anti-dependence */ - char direct[MAX_DEP]; /* direction/distance vector */ - - PTR_SYMB symbol; /* symbol table entry */ - struct ref from; /* tail of dependence */ - struct ref to; /* head of dependence */ - PTR_BFND from_hook, to_hook; /* bifs where dep is hooked in */ - - PTR_DEP from_fwd, from_back; /* list of dependencies going to tail */ - PTR_DEP to_fwd, to_back; /* list of dependencies going to head */ - - } ; - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/dep_str.h b/projects/dvm_svn/fdvm/trunk/Sage/h/dep_str.h deleted file mode 100644 index 1ef42a2..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/dep_str.h +++ /dev/null @@ -1,173 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * Structure of the dep files generated by parsers * - * * - ****************************************************************/ - -/*#include - */ -#ifndef MAX_DEP -#include dep.h -#endif - -#include "compatible.h" -/*#ifdef NO_u_short - *#ifndef DEF_USHORT - *#define DEF_USHORT 1 - */ - - - - - -typedef unsigned int u_shrt; -/*#endif -#endif - */ - -#define D_MAGIC 0420 - -struct preamble { /* structure of preamble of dep file */ - u_shrt ptrsize; /* bit length of pointers (32 or 64) phb */ - u_shrt language; /* source language type */ - u_shrt num_blobs; /* number of blob nodes */ - u_shrt num_bfnds; /* number of bif nodes */ - u_shrt num_llnds; /* number of low level nodes */ - u_shrt num_symbs; /* number of symbol nodes */ - u_shrt num_types; /* number of type nodes */ - u_shrt num_label; /* number of label nodes */ - u_shrt num_dep; /* number of dep nodes */ - u_shrt num_cmnts; /* number of comment nodes */ - u_shrt num_files; /* number of filename nodes */ - u_shrt global_bfnd; /* id of the global bif node */ -}; - - -struct locs { - long llnd; /* offset of llnd in the dep file */ - long symb; /* symbol nodes */ - long type; /* type nodes */ - long labs; /* label nodes */ - long cmnt; /* comment nodes */ - long file; /* filename nodes */ - long deps; /* dep nodes */ - long strs; /* string tables */ -}; - -struct bf_nd { /* structure of bif node in dep file */ - u_shrt id; /* id of this bif node */ - u_shrt variant; /* type of this bif node */ - u_shrt cp; /* control parent of this node */ - u_shrt bf_ptr1; - u_shrt cmnt_ptr; - u_shrt symbol; - u_shrt ll_ptr1; - u_shrt ll_ptr2; - u_shrt ll_ptr3; - u_shrt dep_ptr1; - u_shrt dep_ptr2; - u_shrt label; - u_shrt lbl_ptr; - u_shrt g_line; - u_shrt l_line; - u_shrt decl_specs; - u_shrt filename; -}; - - -struct ll_nd { - u_shrt id; - u_shrt variant; - u_shrt type; -}; - - -struct sym_nd { - u_shrt id; - u_shrt variant; - u_shrt type; - u_shrt attr; - u_shrt next; - u_shrt scope; - u_shrt ident; -}; - - -struct typ_nd { - u_shrt id; - u_shrt variant; - u_shrt name; -}; - - -struct lab_nd { - u_shrt id; - u_shrt labtype; - u_shrt body; - u_shrt name; - long stat_no; -}; - - -struct fil_nd { - u_shrt id; - u_shrt name; -}; - - -struct cmt_nd { - u_shrt id; - u_shrt type; - u_shrt next; - u_shrt str; -}; - - -struct dep_nd { - u_shrt id; - u_shrt type; - u_shrt sym; - u_shrt from_stmt; - u_shrt from_ref; - u_shrt to_stmt; - u_shrt to_ref; - u_shrt from_hook; - u_shrt to_hook; - u_shrt from_fwd; - u_shrt from_back; - u_shrt to_fwd; - u_shrt to_back; - u_shrt dire[MAX_DEP]; -}; - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/dep_struct.h b/projects/dvm_svn/fdvm/trunk/Sage/h/dep_struct.h deleted file mode 100644 index 7822bbc..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/dep_struct.h +++ /dev/null @@ -1,147 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * Structure of the dep files generated by parsers * - * * - ****************************************************************/ - -/*#include - */ -#ifndef MAX_DEP -#include dep.h -#endif - -#include "compatible.h" -/*#ifdef NO_u_short - *#ifndef DEF_USHORT - *#define DEF_USHORT 1 - */ - - - - - -/*typedef unsigned int u_short;*/ -/*#endif -#endif - */ - -#define D_MAGIC 0420 - -struct preamble { /* structure of preamble of dep file */ - u_short ptrsize; /* bit length of pointers (32 or 64) phb */ - u_short language; /* source language type */ - u_short num_blobs; /* number of blob nodes */ - u_short num_bfnds; /* number of bif nodes */ - u_short num_llnds; /* number of low level nodes */ - u_short num_symbs; /* number of symbol nodes */ - u_short num_types; /* number of type nodes */ - u_short num_label; /* number of label nodes */ - u_short num_dep; /* number of dep nodes */ - u_short num_cmnts; /* number of comment nodes */ - u_short num_files; /* number of filename nodes */ - u_short global_bfnd; /* id of the global bif node */ -}; - - -struct locs { - long llnd; /* offset of llnd in the dep file */ - long symb; /* symbol nodes */ - long type; /* type nodes */ - long labs; /* label nodes */ - long cmnt; /* comment nodes */ - long file; /* filename nodes */ - long deps; /* dep nodes */ - long strs; /* string tables */ -}; - -struct bf_nd { /* structure of bif node in dep file */ - u_short id; /* id of this bif node */ - u_short variant; /* type of this bif node */ - u_short cp; /* control parent of this node */ - u_short bf_ptr1; - u_short cmnt_ptr; - u_short symbol; - u_short ll_ptr1; - u_short ll_ptr2; - u_short ll_ptr3; - u_short dep_ptr1; - u_short dep_ptr2; - u_short label; - u_short lbl_ptr; - u_short g_line; - u_short l_line; - u_short decl_specs; - u_short filename; -}; - - -struct ll_nd { - u_short id; - u_short variant; - u_short type; -}; - - -struct sym_nd { - u_short id; - u_short variant; - u_short type; - u_short attr; - u_short next; - u_short scope; - u_short ident; -}; - - -struct typ_nd { - u_short id; - u_short variant; - u_short name; -}; - - -struct lab_nd { - u_short id; - u_short labtype; - u_short body; - u_short name; - long stat_no; -}; - - -struct fil_nd { - u_short id; - u_short name; -}; - - -struct cmt_nd { - u_short id; - u_short type; - u_short next; - u_short str; -}; - - -struct dep_nd { - u_short id; - u_short type; - u_short sym; - u_short from_stmt; - u_short from_ref; - u_short to_stmt; - u_short to_ref; - u_short from_hook; - u_short to_hook; - u_short from_fwd; - u_short from_back; - u_short to_fwd; - u_short to_back; - u_short dire[MAX_DEP]; -}; diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/elist.h b/projects/dvm_svn/fdvm/trunk/Sage/h/elist.h deleted file mode 100644 index 79885cb..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/elist.h +++ /dev/null @@ -1,79 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -struct ELIST_rec - { - int type; /* 0 for int, 1 for string, 2 for ELIST */ - char * car; - struct ELIST_rec * cdr; - }; - -#define TEINT 0 -#define TESTRING 1 -#define TELIST 2 - -typedef struct ELIST_rec * ELIST; - - -/* - the following two defines are pretty bad. But have been done so as to - avoid globals which look like global variables. For these to go away - libdb.a has to change. -*/ -#define currentFile cur_file -#define currentProject cur_proj - -extern PTR_FILE currentFile; /* actually cur_file */ -extern PTR_PROJ currentProject; /* actually cur_proj */ - -#ifndef TRUE -# define TRUE 1 -#endif -#ifndef FALSE -# define FALSE 0 -#endif - -/* functions that are used within the cbaselib */ -ELIST ENew( /* etype */ ); -void EFree( /* e */ ); -ELIST ECopy( /* e */ ); -ELIST ECpCar( /* e */ ); -ELIST ECpCdr( /* e */ ); -ELIST EAppend( /* e1, e2 */ ); -ELIST EString( /* s */ ); -ELIST ENumber( /* n */ ); -ELIST ECons( /* e1, e2 */ ); -int ENumP(/*e*/); -int EStringP(/*e*/); -int EListP(/*e*/); - -#define ECar(x) ((x)->car) -#define ECdr(x) ((x)->cdr) -#define ECaar(x) (ECar((ELIST)ECar(x))) -#define ECdar(x) (ECdr((ELIST)ECar(x))) -#define ECadr(x) (ECar(ECdr(x))) -#define ECddr(x) (ECdr(ECdr(x))) - -#define ECaaar(x) (ECar((ELIST)ECaar(x))) -#define ECdaar(x) (ECdr((ELIST)ECaar(x))) -#define ECadar(x) (ECar(ECdar(x))) -#define ECaadr(x) (ECar((ELIST)ECadr(x))) -#define ECaddr(x) (ECar(ECddr(x))) -#define ECddar(x) (ECdr(ECdar(x))) -#define ECdadr(x) (ECdr((ELIST)ECadr(x))) -#define ECdddr(x) (ECdr(ECddr(x))) - -char *Allocate(/* size */); - -PTR_BFND FindCurrBifNode( /* id */ ); -PTR_LLND FindLLNode( /* id */ ); -PTR_LABEL FindLabNode(/* id */); -PTR_SYMB FindSymbolNode(/* id */); -PTR_TYPE FindTypeNode(/* id */); -PTR_FILE FindFileObj(/* filename */); -PTR_DEP FindDepNode(/* id */); -PTR_BFND MakeDeclStmt(/* s */); -int VarId(/* id */); diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/f90.h b/projects/dvm_svn/fdvm/trunk/Sage/h/f90.h deleted file mode 100644 index 958120a..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/f90.h +++ /dev/null @@ -1,27 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* The following 16 different options are used to - declare variables are as follows: - ( stored in symptr->attr ) */ - -#define ALLOCATABLE_BIT 1 -#define DIMENSION_BIT 2 -#define EXTERNAL_BIT 8 -#define IN_BIT 16 -#define INOUT_BIT 32 -#define INTRINSIC_BIT 64 -#define OPTIONAL_BIT 128 -#define OUT_BIT 256 -#define PARAMETER_BIT 512 -#define POINTER_BIT 1024 -#define PRIVATE_BIT 2048 -#define PUBLIC_BIT 4096 -#define SAVE_BIT 8192 -#define SEQUENCE_BIT 16384 -#define RECURSIVE_BIT 32768 -#define TARGET_BIT 65536 -#define PROCESSORS_BIT 131072 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/fixcray.h b/projects/dvm_svn/fdvm/trunk/Sage/h/fixcray.h deleted file mode 100644 index adaa0fb..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/fixcray.h +++ /dev/null @@ -1,10 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -# ifdef CRAY-C90 - extern void *calloc(); -# define CALLOC_DEF -# endif diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/fm.h b/projects/dvm_svn/fdvm/trunk/Sage/h/fm.h deleted file mode 100644 index 520a9bd..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/fm.h +++ /dev/null @@ -1,10 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* FORTRAN M additions */ - -#define PLAIN 0 -#define LCTN 1 -#define SUBM 2 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/head b/projects/dvm_svn/fdvm/trunk/Sage/h/head deleted file mode 100644 index 333fa33..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/head +++ /dev/null @@ -1,2 +0,0 @@ -/* don't modify this file directly, it is made by a clever 'sed' -script using "tag". Run make tag.h to regenerate this file */ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/leak_detector.h b/projects/dvm_svn/fdvm/trunk/Sage/h/leak_detector.h deleted file mode 100644 index d26beac..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/leak_detector.h +++ /dev/null @@ -1,18 +0,0 @@ -#pragma once - -#ifdef _WIN32 -#ifdef _DEBUG - -#define _CRTDBG_MAP_ALLOC -#include -#include - -#ifdef _DEBUG - #ifndef DBG_NEW - #define DBG_NEW new ( _NORMAL_BLOCK , __FILE__ , __LINE__ ) - #define new DBG_NEW - #endif -#endif - -#endif -#endif \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/list.h b/projects/dvm_svn/fdvm/trunk/Sage/h/list.h deleted file mode 100644 index 4172c53..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/list.h +++ /dev/null @@ -1,34 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - -#define BIFNDE 0 -#define DEPNDE 1 -#define LLNDE 2 -#define SYMNDE 3 -#define LISNDE 4 -#define BIFLISNDE 5 -#define UNUSED -1 -#define NUMLIS 100 -#define DEPARC 1 -#define MAXGRNODE 50 - -typedef struct lis_node *LIST; - -struct lis_node { - int variant; /* one of BIFNDE, BIFLISNDE, DEPNDE, LLNDE, SYMNDE, LISNDE */ - union list_union { - PTR_BFND bfnd; - PTR_BLOB biflis; - PTR_DEP dep; - PTR_LLND llnd; - PTR_SYMB symb; - LIST lisp; - } entry; - LIST next; - } ; - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/ll.h b/projects/dvm_svn/fdvm/trunk/Sage/h/ll.h deleted file mode 100644 index a29f48d..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/ll.h +++ /dev/null @@ -1,163 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/************************************************************************/ -/* */ -/* low level nodes */ -/* */ -/************************************************************************/ - -struct llnd { - - int variant, id; /* variant and identification tags */ - - PTR_LLND thread; /* connects nodes together by allocation order */ - - PTR_TYPE type; /* to be modified */ - - union llnd_union { - - char *string_val;/* for integers floats doubles and strings*/ - int ival; - double dval; /* for floats and doubles */ - char cval; - int bval; /* for booleans */ - - struct { /* for range, upper, and lower */ - PTR_SYMB symbol; - int dim; - } array_op; - - struct { - PTR_SYMB symbol; - - PTR_LLND ll_ptr1; - PTR_LLND ll_ptr2; - } Template; - - struct { /* for complexes and double complexes */ - PTR_SYMB null; - - PTR_LLND real_part; - PTR_LLND imag_part; - } complex; - - struct { - PTR_LABEL lab_ptr; - - PTR_LLND null_1; - PTR_LLND next; - } label_list; - - struct { - PTR_SYMB null_1; - - PTR_LLND item; - PTR_LLND next; - } list; - - struct { - PTR_SYMB null_1; - - PTR_LLND size; - PTR_LLND list; - } cons; - - struct { - PTR_SYMB control_var; - - PTR_LLND array; - PTR_LLND range; - } access; - - struct { - PTR_SYMB control_var; - - PTR_LLND array; - PTR_LLND range; - } ioaccess; - - struct { - PTR_SYMB symbol; - - PTR_LLND null_1; - PTR_LLND null_2; - } const_ref; - - struct { - PTR_SYMB symbol; - - PTR_LLND null_1; - PTR_LLND null_2; - } var_ref; - - struct { - PTR_SYMB symbol; - - PTR_LLND index; - PTR_LLND array_elt; - } array_ref; - - struct { - PTR_SYMB null_1; - - PTR_LLND access; - PTR_LLND index; - } access_ref; - - struct { - PTR_SYMB null_1; - - PTR_LLND cons; - PTR_LLND index; - } cons_ref; - - struct { - PTR_SYMB symbol; - - PTR_LLND null_1; - PTR_LLND rec_field; /* for record fields */ - } record_ref; - - - struct { - PTR_SYMB symbol; - - PTR_LLND param_list; - PTR_LLND next_call; - } proc; - - struct { - PTR_SYMB null_1; - - PTR_LLND operand; - PTR_LLND null_2; - } unary_op; - - struct { - PTR_SYMB null_1; - - PTR_LLND l_operand; - PTR_LLND r_operand; - } binary_op; - - struct { - PTR_SYMB null_1; - - PTR_LLND ddot; - PTR_LLND stride; - } seq; - - struct { - PTR_SYMB null_1; - - PTR_LLND sp_label; - PTR_LLND sp_value; - } spec_pair; - - } entry; -}; - -#define __LL_DEF__ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/prop.h b/projects/dvm_svn/fdvm/trunk/Sage/h/prop.h deleted file mode 100644 index f7451f2..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/prop.h +++ /dev/null @@ -1,24 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * Definitions for the property list * - * * - ****************************************************************/ - -#ifndef __PROP__ - -typedef struct prop_link *PTR_PLNK; -struct prop_link { - char *prop_name; /* property name */ - char *prop_val; /* property value */ - PTR_PLNK next; /* point to the next property list */ -}; - -#define __PROP__ - -#endif diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/sage.h b/projects/dvm_svn/fdvm/trunk/Sage/h/sage.h deleted file mode 100644 index 8463cde..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/sage.h +++ /dev/null @@ -1,21 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* Standard include file for all sage products (phb) */ - -/* include it only once... */ -#ifndef SAGE_H -#define SAGE_H - -#include "version.h" -#include "sageroot.h" -#include "sagearch.h" - -#define SAGE_INFO "'finger sage@cica.indiana.edu' for more information.\n \ -Send bug reports to sage-bugs@cica.indiana.edu\n" - -#endif - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/sagearch.h b/projects/dvm_svn/fdvm/trunk/Sage/h/sagearch.h deleted file mode 100644 index fcb11de..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/sagearch.h +++ /dev/null @@ -1,2 +0,0 @@ -#define SAGE_iris4d -#define SAGE_ARCH iris4d diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/sageroot.h b/projects/dvm_svn/fdvm/trunk/Sage/h/sageroot.h deleted file mode 100644 index 9828210..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/sageroot.h +++ /dev/null @@ -1 +0,0 @@ -#define SAGEROOT "/usr/people/podd/sage" diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/sets.h b/projects/dvm_svn/fdvm/trunk/Sage/h/sets.h deleted file mode 100644 index 8a393ae..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/sets.h +++ /dev/null @@ -1,86 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -# define MAX_LP_DEPTH 10 -# define MAX_DEP 11 - -struct ref { /* reference of a variable */ - PTR_BFND stmt; /* statement containing reference */ - PTR_LLND refer; /* pointer to the actual reference */ - } ; - -struct refl { - PTR_SYMB id; - struct ref * node; - struct refl * next; - }; - -typedef struct refl * PTR_REFL; - -/* Added by Mannho from here */ - -struct aref { - PTR_SYMB id; - PTR_LLND decl_ranges; - PTR_LLND use_bnd0; /* undecidable list because index with variables */ - PTR_LLND mod_bnd0; - PTR_LLND use_bnd1; /* decidable with induction variables */ - PTR_LLND mod_bnd1; - PTR_LLND use_bnd2; /* decidable with only constants */ - PTR_LLND mod_bnd2; - struct aref *next; -}; - -typedef struct aref *PTR_AREF; - -/* Added by Mannho to here */ - -struct sets { - PTR_REFL gen; /* local attribute */ - PTR_REFL in_def; /* inhereted attrib */ - PTR_REFL use; /* local attribute */ - PTR_REFL in_use; /* inherited attrib */ - PTR_REFL out_def; /* synth. attrib */ - PTR_REFL out_use; /* synth. attrib */ - PTR_AREF arefl; /* array reference */ - }; - - -struct dep { /* data dependencies */ - - int id; /* identification for reading/writing */ - PTR_DEP thread; - - char type; /* flow-, output-, or anti-dependence */ - char direct[MAX_DEP]; /* direction/distance vector */ - - PTR_SYMB symbol; /* symbol table entry */ - struct ref from; /* tail of dependence */ - struct ref to; /* head of dependence */ - - PTR_DEP from_fwd, from_back; /* list of dependencies going to tail */ - PTR_DEP to_fwd, to_back; /* list of dependencies going to head */ - - } ; - -#define AR_DIM_MAX 5 -#define MAX_NEST_DEPTH 10 - -struct subscript{ - int decidable; /* if 1 then analysis is ok. if 2 then vector range */ - /* if it is 0 it is not analizable. */ - PTR_LLND parm_exp; /* this is a symbolic expression involving */ - /* procedure parameters or common variables. */ - int offset; /* This is the constant term in a linear form */ - PTR_LLND vector; /* pointer to ddot for vector range */ - int coefs[MAX_NEST_DEPTH]; /* if coef[2] = 3 then the second */ - /* level nesting induction var has*/ - /* coef 3 in this position. */ - PTR_LLND coefs_symb[MAX_NEST_DEPTH]; - /* if coefs[2] is not null then this is the*/ - /* pointer to a symbolic coef. in terms of */ - /* procedure parameters, globals or commons*/ - }; diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/symb.h b/projects/dvm_svn/fdvm/trunk/Sage/h/symb.h deleted file mode 100644 index d2c4adf..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/symb.h +++ /dev/null @@ -1,225 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* VPC Version modified by Jenq-Kuen Lee Nov 15 , 1987 */ -/* Original Filename : symb.h */ -/* New filename : vsymb.h */ - -/************************************************************************ - * * - * hash and symbol table entries * - * * - ************************************************************************/ - - -struct hash_entry - { - char *ident; - struct hash_entry *next_entry; - PTR_SYMB id_attr; - }; - -struct symb { - int variant; - int id; - char *ident; - struct hash_entry *parent; - PTR_SYMB outer; /* pointer to symbol in enclosing block */ - PTR_SYMB next_symb; /* pointer to next symbol in same block */ - PTR_SYMB id_list; /* used for making lists of ids */ - PTR_SYMB thread; /* list of all allocated symbol pointers */ - PTR_TYPE type; /* data type of this identifier */ - PTR_BFND scope; /* level at which ident is declared */ - PTR_BLOB ud_chain; /* use_definition chain */ - int attr; /* attributes of the variable */ - int dovar; /* set if used as loop's control variable */ - int decl; /* field that the parser use in keeping track - of declarations */ - - union symb_union { - PTR_LLND const_value; /* for constants */ - - struct { /* for enum-field and record field */ - int tag; - int offset; - PTR_SYMB declared_name ; /* used for friend construct */ - PTR_SYMB next; - PTR_SYMB base_name; /* name of record or enumerated type */ - PTR_LLND restricted_bit ; /* Used by VPC++ for restricted bit number */ - } field; - - struct { /* for variant fields */ - int tag; - int offset; - PTR_SYMB next; - PTR_SYMB base_name; - PTR_LLND variant_list; - } variant_field; - - - struct { /* for program */ - PTR_SYMB symb_list; - PTR_LABEL label_list; - PTR_BFND prog_hedr; - } prog_decl; - - struct { /* for PROC */ - int seen; - int num_input, num_output, num_io; - PTR_SYMB in_list; - PTR_SYMB out_list; - PTR_SYMB symb_list; - int local_size; - PTR_LABEL label_list; - PTR_BFND proc_hedr; - PTR_LLND call_list; - } proc_decl; - - struct { /* for FUNC */ - int seen; - int num_input, num_output, num_io; - PTR_SYMB in_list; - PTR_SYMB out_list; - PTR_SYMB symb_list; - int local_size; - PTR_LABEL label_list; - PTR_BFND func_hedr; - PTR_LLND call_list; - } func_decl; - - struct { /* for variable declaration */ - int local; /* local or input or output or both param*/ - int num1, num2, num3 ; /*24.02.03*/ - PTR_SYMB next_out; /* for list of output parameters*//*perestanovka c next_out *24.02.03*/ - PTR_SYMB next_in; /* for list of input parameters*/ - int offset; - int dovar; /* set if being used as DO control var */ - } var_decl; - - struct { - int seen ; - int num_input, num_output, num_io ; - PTR_SYMB in_list ; - PTR_SYMB out_list ; - PTR_SYMB symb_list; - int local_size; - PTR_LABEL label_list ; - PTR_BFND func_hedr ; - PTR_LLND call_list ; - /* the following information for field */ - int tag ; - int offset ; - PTR_SYMB declared_name; /* used for friend construct */ - PTR_SYMB next ; - PTR_SYMB base_name ; - /* the following is newly added */ - - } member_func ; /* New one for VPC */ - - - /* an attempt to unify the data structure */ - struct { - int seen ; - int num_input, num_output, num_io ; - PTR_SYMB in_list ; - PTR_SYMB out_list ; - PTR_SYMB symb_list; - int local_size; - PTR_LABEL label_list ; - PTR_BFND func_hedr ; - PTR_LLND call_list ; - /* the following information for field */ - int tag ; - int offset ; - PTR_SYMB declared_name; /* used for friend construct */ - PTR_SYMB next ; - PTR_SYMB base_name ; - - /* the following is newly added */ - } Template ; /* New one for VPC */ - - } entry; -}; - -struct data_type { - int variant; - int id; - int length; - PTR_TYPE thread; /* list of all allocated symbol pointers */ - PTR_SYMB name; /* type name */ - PTR_BLOB ud_chain; /* use_definition chain */ - union type_union { - /* no entry needed for T_INT, T_CHAR, T_FLOAT, T_DOUBLE, T_VOID T_BOOL */ - - - - struct { /* for T_SUBRANGE */ - PTR_TYPE base_type; /* = to T_INT, T_CHAR, T_FLOAT */ - PTR_LLND lower, upper; - } subrange; - - struct { /* for T_ARRAY */ - PTR_TYPE base_type; /* New order */ - int num_dimensions; - PTR_LLND ranges; - } ar_decl; - - struct { - PTR_TYPE base_type ; - int dummy1; - PTR_LLND ranges ; - PTR_LLND kind_len ; - int dummy3; - int dummy4; - int dummy5; - } Template ; /* for T_DESCRIPT,T_ARRAY,T_FUNCTION,T_POINTER */ - PTR_TYPE base_type; /* for T_LIST */ - - struct { /* for T_RECORD or T_ENUM */ - int num_fields; - int record_size; - PTR_SYMB first; - } re_decl; - /* the following is added fro VPC */ - - struct { - PTR_SYMB symbol; - PTR_SYMB scope_symbol; - } derived_type ; /* for type name deriving type */ - - struct { /* for class T_CLASS T_UNION T_STRUCT */ - int num_fields; - int record_size; - PTR_SYMB first; - PTR_BFND original_class ; - PTR_TYPE base_type; /* base type or inherited collection */ - } derived_class ; - - struct { /* for class T_DERIVED_TEMPLATE */ - PTR_SYMB templ_name; - PTR_LLND args; /* argument list for templ */ - } templ_decl ; - - /* for T_MEMBER_POINTER and */ - struct { /* for class T_DERIVED_COLLECTION */ - PTR_SYMB collection_name; - PTR_TYPE base_type; /* base type or inherited collection */ - } col_decl ; - - struct { /* for T_DESCRIPT */ - PTR_TYPE base_type ; - int signed_flag ; - PTR_LLND ranges ; - int long_short_flag ; - int mod_flag ; - int storage_flag; - int access_flag; - } descriptive ; - - } entry; -}; - - -#define __SYMB_DEF__ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/symblob.h b/projects/dvm_svn/fdvm/trunk/Sage/h/symblob.h deleted file mode 100644 index 945b9a0..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/symblob.h +++ /dev/null @@ -1,17 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - - -typedef struct sblob *PTR_SBLOB; - -struct sblob { PTR_SYMB symb; - PTR_SBLOB next; - }; - -struct sblob syms[100]; - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/tag b/projects/dvm_svn/fdvm/trunk/Sage/h/tag deleted file mode 100644 index 343d1f5..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/tag +++ /dev/null @@ -1,628 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/******************* variant tags for bif nodes **********************/ - -#define GLOBAL 100 -#define PROG_HEDR 101 -#define PROC_HEDR 102 -#define BASIC_BLOCK 103 -#define CONTROL_END 104 -#define IF_NODE 105 -#define LOOP_NODE 106 -#define FOR_NODE 107 -#define FORALL_NODE 108 -#define WHILE_NODE 109 -#define EXIT_NODE 110 -#define ASSIGN_STAT 111 -#define M_ASSIGN_STAT 112 -#define PROC_STAT 113 -#define SUM_ACC 114 /* accumulation statements */ -#define MULT_ACC 115 -#define MAX_ACC 116 -#define MIN_ACC 117 -#define CAT_ACC 118 -#define OR_ACC 119 -#define AND_ACC 120 -#define READ_STAT 121 -#define WRITE_STAT 122 -#define OTHERIO_STAT 123 -#define CDOALL_NODE 124 -#define SDOALL_NODE 125 -#define DOACROSS_NODE 126 -#define CDOACROSS_NODE 127 -#define DVM_INTERVAL_DIR 128 /* DVM-F */ -#define DVM_ENDINTERVAL_DIR 129 /* DVM-F */ -#define FUNC_HEDR 130 -#define WHERE_NODE 131 -#define ALLDO_NODE 132 -#define IDENTIFY 133 -#define FORMAT_STAT 134 -#define STOP_STAT 135 -#define RETURN_STAT 136 -#define ELSEIF_NODE 137 -#define ARITHIF_NODE 138 -#define GOTO_NODE 139 -#define ASSGOTO_NODE 140 -#define COMGOTO_NODE 141 -#define PAUSE_NODE 142 -#define STOP_NODE 143 -#define ASSLAB_STAT 144 -#define LOGIF_NODE 145 -#define DVM_DEBUG_DIR 146 /* DVM-F */ -#define DVM_ENDDEBUG_DIR 147 /* DVM-F */ -#define DVM_TRACEON_DIR 148 /* DVM-F */ -#define DVM_TRACEOFF_DIR 149 /* DVM-F */ -#define BLOB 150 -#define SIZES 151 -#define COMMENT_STAT 152 -#define CONT_STAT 153 -#define VAR_DECL 154 -#define PARAM_DECL 155 -#define COMM_STAT 156 -#define EQUI_STAT 157 -#define IMPL_DECL 158 -#define DATA_DECL 159 -#define SAVE_DECL 160 -#define ENTRY_STAT 162 -#define STMTFN_STAT 163 -#define DIM_STAT 164 -#define BLOCK_DATA 165 -#define EXTERN_STAT 166 -#define INTRIN_STAT 167 -#define ENUM_DECL 168 /* New added for VPC */ -#define CLASS_DECL 169 /* New added for VPC */ -#define UNION_DECL 170 /* New added for VPC */ -#define STRUCT_DECL 171 /* New added for VPC */ -#define DERIVED_CLASS_DECL 172 /* New added for VPC */ -#define EXPR_STMT_NODE 173 /* New added for VPC */ -#define DO_WHILE_NODE 174 /* New added for VPC */ -#define SWITCH_NODE 175 /* New added for VPC */ -#define CASE_NODE 176 /* New added for VPC */ -#define DEFAULT_NODE 177 /* New added for VPC */ -#define BREAK_NODE 178 /* New added for VPC */ -#define CONTINUE_NODE 179 /* New added for VPC */ -#define RETURN_NODE 180 /* New added for VPC */ -#define ASM_NODE 181 /* New added for VPC */ -#define SPAWN_NODE 182 /* New added for CC++ */ -#define PARFOR_NODE 183 /* New added for CC++ */ -#define PAR_NODE 184 /* New added for CC++ */ -#define LABEL_STAT 185 /* New added for VPC */ -#define PROS_COMM 186 /* Fortran M */ -#define ATTR_DECL 187 /* attribute declaration */ -#define NAMELIST_STAT 188 -#define FUTURE_STMT 189 /* NEW added for VPC */ -#define COLLECTION_DECL 190 /* NEW added for PC++ */ -#define TEMPLATE_DECL 191 /* added by dbg for templates */ -#define TEMPLATE_FUNDECL 192 /* added by dbg for template function*/ -#define TECLASS_DECL 193 /* added for pC++ */ -#define ELSEWH_NODE 194 /*F95*/ -#define STATIC_STMT 195 /*F95*/ -#define INCLUDE_LINE 196 /*F95*/ -#define PREPROCESSOR_DIR 197 /*C,C++*/ -#define PRINT_STAT 200 -#define BACKSPACE_STAT 201 -#define REWIND_STAT 202 -#define ENDFILE_STAT 203 -#define INQUIRE_STAT 204 -#define OPEN_STAT 205 -#define CLOSE_STAT 206 -#define EXTERN_C_STAT 207 /* Added by PHB for 'extern "C" {}' */ -#define INCLUDE_STAT 208 -#define TRY_STAT 209 /* added by dbg for C++ exceptions */ -#define CATCH_STAT 210 /* moreexcpt handling (part of try) */ -#define DVM_PARALLEL_ON_DIR 211 /* DVM-F */ -#define DVM_SHADOW_START_DIR 212 /* DVM-F */ -#define DVM_SHADOW_GROUP_DIR 213 /* DVM-F */ -#define DVM_SHADOW_WAIT_DIR 214 /* DVM-F */ -#define DVM_REDUCTION_START_DIR 215 /* DVM-F */ -#define DVM_REDUCTION_GROUP_DIR 216 /* DVM-F */ -#define DVM_REDUCTION_WAIT_DIR 217 /* DVM-F */ -#define DVM_DYNAMIC_DIR 218 /* DVM-F */ -#define DVM_ALIGN_DIR 219 /* DVM-F */ -#define DVM_REALIGN_DIR 220 /* DVM-F */ -#define DVM_REALIGN_NEW_DIR 221 /* DVM-F */ -#define DVM_REMOTE_ACCESS_DIR 222 /* DVM-F */ -#define HPF_INDEPENDENT_DIR 223 /* HPF */ -#define DVM_SHADOW_DIR 224 /* DVM-F */ -#define PARDO_NODE 225 /* Following added for PCF Fortran */ -#define PARSECTIONS_NODE 226 -#define SECTION_NODE 227 -#define GUARDS_NODE 228 -#define LOCK_NODE 229 -#define UNLOCK_NODE 230 -#define CRITSECTION_NODE 231 -#define POST_NODE 232 -#define WAIT_NODE 233 -#define CLEAR_NODE 234 -#define POSTSEQ_NODE 235 -#define WAITSEQ_NODE 236 -#define SETSEQ_NODE 237 -#define ASSIGN_NODE 238 -#define RELEASE_NODE 239 -#define PRIVATE_NODE 240 -#define SCOMMON_NODE 241 -#define PARREGION_NODE 242 -#define PDO_NODE 243 -#define PSECTIONS_NODE 244 -#define SINGLEPROCESS_NODE 245 -#define SKIPPASTEOF_NODE 246 -#define DVM_NEW_VALUE_DIR 247 /* DVM-F */ -#define DVM_VAR_DECL 248 /* DVM-F */ -#define DVM_POINTER_DIR 249 /* DVM-F */ -#define INTENT_STMT 250 /* Added for Fortran 90 */ -#define OPTIONAL_STMT 251 -#define PUBLIC_STMT 252 -#define PRIVATE_STMT 253 -#define ALLOCATABLE_STMT 254 -#define POINTER_STMT 255 -#define TARGET_STMT 256 -#define ALLOCATE_STMT 257 -#define NULLIFY_STMT 258 -#define DEALLOCATE_STMT 259 -#define SEQUENCE_STMT 260 -#define CYCLE_STMT 261 -#define EXIT_STMT 262 -#define CONTAINS_STMT 263 -#define WHERE_BLOCK_STMT 264 -#define MODULE_STMT 265 -#define USE_STMT 266 -#define INTERFACE_STMT 267 -#define MODULE_PROC_STMT 268 -#define OVERLOADED_ASSIGN_STAT 269 -#define POINTER_ASSIGN_STAT 270 -#define OVERLOADED_PROC_STAT 271 -#define DECOMPOSITION_STMT 275 -#define ALIGN_STMT 276 -#define DVM_DISTRIBUTE_DIR 277 /* DVM-F */ -#define REDUCE_STMT 278 -#define PROS_HEDR 279 /* Fortran M */ -#define PROS_STAT 280 /* Fortran M */ -#define PROS_STAT_LCTN 281 /* Fortran M */ -#define PROS_STAT_SUBM 282 /* Fortran M */ -#define PROCESSES_STAT 283 /* Fortran M */ -#define PROCESSES_END 284 /* Fortran M */ -#define PROCESS_DO_STAT 285 /* Fortran M */ -#define PROCESSORS_STAT 286 /* Fortran M */ -#define CHANNEL_STAT 287 /* Fortran M */ -#define MERGER_STAT 288 /* Fortran M */ -#define MOVE_PORT 289 /* Fortran M */ -#define SEND_STAT 290 /* Fortran M */ -#define RECEIVE_STAT 291 /* Fortran M */ -#define ENDCHANNEL_STAT 292 /* Fortran M */ -#define PROBE_STAT 293 /* Fortran M */ -#define INPORT_DECL 294 /* Fortran M */ -#define OUTPORT_DECL 295 /* Fortran M */ -#define HPF_TEMPLATE_STAT 296 /* HPF */ -#define HPF_ALIGN_STAT 297 /* HPF */ -#define HPF_PROCESSORS_STAT 298 /* HPF */ -#define DVM_REDISTRIBUTE_DIR 299 /* DVM-F */ -#define DVM_TASK_REGION_DIR 605 /* DVM-F */ -#define DVM_END_TASK_REGION_DIR 606 /* DVM-F */ -#define DVM_ON_DIR 607 /* DVM-F */ -#define DVM_END_ON_DIR 608 /* DVM-F */ -#define DVM_TASK_DIR 609 /* DVM-F */ -#define DVM_MAP_DIR 610 /* DVM-F */ -#define DVM_PARALLEL_TASK_DIR 611 /* DVM-F */ -#define DVM_INHERIT_DIR 612 /* DVM-F */ -#define DVM_INDIRECT_GROUP_DIR 613 /* DVM-F */ -#define DVM_INDIRECT_ACCESS_DIR 614 /* DVM-F */ -#define DVM_REMOTE_GROUP_DIR 615 /* DVM-F */ -#define DVM_RESET_DIR 616 /* DVM-F */ -#define DVM_PREFETCH_DIR 617 /* DVM-F */ -#define DVM_OWN_DIR 618 /* DVM-F */ -#define DVM_HEAP_DIR 619 /* DVM-F */ -#define DVM_ASYNCID_DIR 620 /* DVM-F */ -#define DVM_ASYNCHRONOUS_DIR 621 /* DVM-F */ -#define DVM_ENDASYNCHRONOUS_DIR 622 /* DVM-F */ -#define DVM_ASYNCWAIT_DIR 623 /* DVM-F */ -#define DVM_F90_DIR 624 /* DVM-F */ -#define DVM_BARRIER_DIR 625 /* DVM-F */ -#define FORALL_STAT 626 /* F95 */ -#define DVM_CONSISTENT_GROUP_DIR 627 /* DVM-F */ -#define DVM_CONSISTENT_START_DIR 628 /* DVM-F */ -#define DVM_CONSISTENT_WAIT_DIR 629 /* DVM-F */ -#define DVM_CONSISTENT_DIR 630 /* DVM-F */ -#define DVM_CHECK_DIR 631 /* DVM-F */ -#define DVM_IO_MODE_DIR 632 /* DVM-F */ -#define DVM_LOCALIZE_DIR 633 /* DVM-F */ -#define DVM_SHADOW_ADD_DIR 634 /* DVM-F */ -#define DVM_CP_CREATE_DIR 635 /* DVM-F */ -#define DVM_CP_LOAD_DIR 636 /* DVM-F */ -#define DVM_CP_SAVE_DIR 637 /* DVM-F */ -#define DVM_CP_WAIT_DIR 638 /* DVM-F */ -#define DVM_EXIT_INTERVAL_DIR 639 /* DVM-F */ -#define DVM_TEMPLATE_CREATE_DIR 640 /* DVM-F */ -#define DVM_TEMPLATE_DELETE_DIR 641 /* DVM-F */ -#define PRIVATE_AR_DECL 642 /* DVM-F */ - -/***************** variant tags for low level nodes ********************/ - -#define INT_VAL 300 -#define FLOAT_VAL 301 -#define DOUBLE_VAL 302 -#define BOOL_VAL 303 -#define CHAR_VAL 304 -#define STRING_VAL 305 -#define CONST_REF 306 -#define VAR_REF 307 -#define ARRAY_REF 308 -#define RECORD_REF 309 /* diff struct between Blaze and VPC++ */ -#define ENUM_REF 310 -#define VAR_LIST 311 -#define EXPR_LIST 312 -#define RANGE_LIST 313 -#define CASE_CHOICE 314 -#define DEF_CHOICE 315 -#define VARIANT_CHOICE 316 -#define COMPLEX_VAL 317 -#define LABEL_REF 318 -#define KEYWORD_VAL 319 /* Strings to be printed with quotes */ -#define DDOT 324 -#define RANGE_OP 325 -#define UPPER_OP 326 -#define LOWER_OP 327 -#define EQ_OP 328 -#define LT_OP 329 -#define GT_OP 330 -#define NOTEQL_OP 331 -#define LTEQL_OP 332 -#define GTEQL_OP 333 -#define ADD_OP 334 -#define SUBT_OP 335 -#define OR_OP 336 -#define MULT_OP 337 -#define DIV_OP 338 -#define MOD_OP 339 -#define AND_OP 340 -#define EXP_OP 341 -#define ARRAY_MULT 342 -#define CONCAT_OP 343 /* cancatenation of strings */ -#define XOR_OP 344 /* .XOR. in fortran */ -#define EQV_OP 345 /* .EQV. in fortran */ -#define NEQV_OP 346 /* .NEQV. in fortran */ -#define MINUS_OP 350 /* unary operations */ -#define NOT_OP 351 -#define ASSGN_OP 352 /* New ADDED For VPC */ -#define DEREF_OP 353 /* New ADDED For VPC */ -#define POINTST_OP 354 /* New ADDED For VPC */ /* ptr->x */ -#define FUNCTION_OP 355 /* New ADDED For VPC */ /* (*DD)() */ -#define MINUSMINUS_OP 356 /* New ADDED For VPC */ -#define PLUSPLUS_OP 357 /* New ADDED For VPC */ -#define BITAND_OP 358 /* New ADDED For VPC */ -#define BITOR_OP 359 /* New ADDED For VPC */ -#define STAR_RANGE 360 /* operations with no operands 360.. */ -#define PROC_CALL 370 -#define FUNC_CALL 371 -#define CONSTRUCTOR_REF 380 -#define ACCESS_REF 381 -#define CONS 382 -#define ACCESS 383 -#define IOACCESS 384 -#define CONTROL_LIST 385 -#define SEQ 386 -#define SPEC_PAIR 387 -#define COMM_LIST 388 -#define STMT_STR 389 -#define EQUI_LIST 390 -#define IMPL_TYPE 391 -#define STMTFN_DECL 392 -#define BIT_COMPLEMENT_OP 393 -#define EXPR_IF 394 -#define EXPR_IF_BODY 395 -#define FUNCTION_REF 396 -#define LSHIFT_OP 397 -#define RSHIFT_OP 398 -#define UNARY_ADD_OP 399 -#define SIZE_OP 400 -#define INTEGER_DIV_OP 401 -#define SUB_OP 402 -#define LE_OP 403 /* New added for VPC */ -#define GE_OP 404 /* New added for VPC */ -#define NE_OP 405 /* New added for VPC */ -#define CLASSINIT_OP 406 /* New added for VPC */ -#define CAST_OP 407 /* New added for VPC */ -#define ADDRESS_OP 408 /* New added for VPC */ -#define POINSTAT_OP 409 /* New added for VPC */ -#define COPY_NODE 410 /* New added for VPC */ -#define INIT_LIST 411 /* New added for VPC */ -#define VECTOR_CONST 412 /* New added for VPC */ -#define BIT_NUMBER 413 /* New added for VPC */ -#define ARITH_ASSGN_OP 414 /* New added for VPC */ -#define ARRAY_OP 415 /* New added for VPC */ -#define NEW_OP 416 /* New added for VPC */ -#define DELETE_OP 417 /* New added for VPC */ -#define NAMELIST_LIST 418 -#define THIS_NODE 419 /* New added for VPC */ -#define SCOPE_OP 420 /* New added for VPC */ -#define PLUS_ASSGN_OP 421 /* New added for VPC */ -#define MINUS_ASSGN_OP 422 /* New added for VPC */ -#define AND_ASSGN_OP 423 /* New added for VPC */ -#define IOR_ASSGN_OP 424 /* New added for VPC */ -#define MULT_ASSGN_OP 425 /* New added for VPC */ -#define DIV_ASSGN_OP 426 /* New added for VPC */ -#define MOD_ASSGN_OP 427 /* New added for VPC */ -#define XOR_ASSGN_OP 428 /* New added for VPC */ -#define LSHIFT_ASSGN_OP 429 /* New added for VPC */ -#define RSHIFT_ASSGN_OP 430 /* New added for VPC */ -#define ORDERED_OP 431 /* Following added for PCF FORTRAN */ -#define EXTEND_OP 432 -#define MAXPARALLEL_OP 433 -#define SAMETYPE_OP 434 -#define TYPE_REF 450 /* Added for FORTRAN 90 */ -#define STRUCTURE_CONSTRUCTOR 451 -#define ARRAY_CONSTRUCTOR 452 -#define SECTION_REF 453 -#define VECTOR_SUBSCRIPT 454 -#define SECTION_OPERANDS 455 -#define KEYWORD_ARG 456 -#define OVERLOADED_CALL 457 -#define INTERFACE_REF 458 -#define RENAME_NODE 459 -#define TYPE_NODE 460 -#define PAREN_OP 461 -#define PARAMETER_OP 462 -#define PUBLIC_OP 463 -#define PRIVATE_OP 464 -#define ALLOCATABLE_OP 465 -#define DIMENSION_OP 466 -#define EXTERNAL_OP 467 -#define IN_OP 468 -#define OUT_OP 469 -#define INOUT_OP 470 -#define INTRINSIC_OP 471 -#define POINTER_OP 472 -#define OPTIONAL_OP 473 -#define SAVE_OP 474 -#define TARGET_OP 475 -#define ONLY_NODE 476 -#define LEN_OP 477 -#define TYPE_OP 479 -#define DOTSTAR_OP 480 /* C++ .* operator */ -#define ARROWSTAR_OP 481 /* C++ ->* operator */ -#define FORDECL_OP 482 /* C++ for(int i; needs a new op */ -#define THROW_OP 483 /* C++ throw operator */ -#define PROCESSORS_REF 484 /* Fortran M */ -#define PORT_TYPE_OP 485 /* Fortran M */ -#define INPORT_TYPE_OP 486 /* Fortran M */ -#define OUTPORT_TYPE_OP 487 /* Fortran M */ -#define INPORT_NAME 488 /* Fortran M */ -#define OUTPORT_NAME 489 /* Fortran M */ -#define FROMPORT_NAME 490 /* Fortran M */ -#define TOPORT_NAME 491 /* Fortran M */ -#define IOSTAT_STORE 492 /* Fortran M */ -#define EMPTY_STORE 493 /* Fortran M */ -#define ERR_LABEL 494 /* Fortran M */ -#define END_LABEL 495 /* Fortran M */ -#define PROS_CALL 496 /* Fortran M */ -#define STATIC_OP 497 /* F95*/ -#define LABEL_ARG 498 -#define DATA_IMPL_DO 700 /* Fortran M */ -#define DATA_ELT 701 /* Fortran M */ -#define DATA_SUBS 702 /* Fortran M */ -#define DATA_RANGE 703 /* Fortran M */ -#define ICON_EXPR 704 /* Fortran M */ -#define BLOCK_OP 705 /* DVM-F */ -#define NEW_SPEC_OP 706 /* DVM-F */ -#define REDUCTION_OP 707 /* DVM-F */ -#define SHADOW_RENEW_OP 708 /* DVM-F */ -#define SHADOW_START_OP 709 /* DVM-F */ -#define SHADOW_WAIT_OP 710 /* DVM-F */ -#define DIAG_OP 711 /* DVM-F */ -#define REMOTE_ACCESS_OP 712 /* DVM-F */ -#define TEMPLATE_OP 713 /* DVM-F */ -#define PROCESSORS_OP 714 /* DVM-F */ -#define DYNAMIC_OP 715 /* DVM-F */ -#define ALIGN_OP 716 /* DVM-F */ -#define DISTRIBUTE_OP 717 /* DVM-F */ -#define SHADOW_OP 718 /* DVM-F */ -#define INDIRECT_ACCESS_OP 719 /* DVM-F */ -#define ACROSS_OP 720 /* DVM-F */ -#define NEW_VALUE_OP 721 /* DVM-F */ -#define SHADOW_COMP_OP 722 /* DVM-F */ -#define STAGE_OP 723 /* DVM-F */ -#define FORALL_OP 724 /* F95 */ -#define CONSISTENT_OP 725 /* DVM-F */ -#define INTERFACE_OPERATOR 726 /* F95 */ -#define INTERFACE_ASSIGNMENT 727 /* F95 */ -#define VAR_DECL_90 728 /* F95 */ -#define ASSIGNMENT_OP 729 /* F95 */ -#define OPERATOR_OP 730 /* F95 */ -#define KIND_OP 731 /* F95 */ -#define LENGTH_OP 732 /* F95 */ -#define RECURSIVE_OP 733 /* F95 */ -#define ELEMENTAL_OP 734 /* F95 */ -#define PURE_OP 735 /* F95 */ -#define DEFINED_OP 736 /* F95 */ -#define PARALLEL_OP 737 /*DVM-F */ -#define INDIRECT_OP 738 /*DVM-F */ -#define DERIVED_OP 739 /*DVM-F */ -#define DUMMY_REF 740 /*DVM-F */ -#define COMMON_OP 741 /*DVM-F */ -#define SHADOW_NAMES_OP 742 /*DVM-F */ - -/***************** variant tags for symbol table entries ********************/ - -#define CONST_NAME 500 /* constant types */ -#define ENUM_NAME 501 -#define FIELD_NAME 502 -#define VARIABLE_NAME 503 -#define TYPE_NAME 504 -#define PROGRAM_NAME 505 -#define PROCEDURE_NAME 506 -#define VAR_FIELD 507 -#define LABEL_VAR 508 /* dest of assigned goto stmt */ -#define FUNCTION_NAME 509 -#define MEMBER_FUNC 510 /* new added for VPC */ -#define CLASS_NAME 511 /* new added for VPC */ -#define UNION_NAME 512 /* new added for VPC */ -#define STRUCT_NAME 513 /* new added for VPC */ -#define LABEL_NAME 514 /* new added for VPC */ -#define COLLECTION_NAME 515 /* new added for VPC */ -#define ROUTINE_NAME 516 /*added for external statement*/ -#define CONSTRUCT_NAME 517 -#define INTERFACE_NAME 518 -#define MODULE_NAME 519 -#define TEMPLATE_CL_NAME 520 -#define TEMPLATE_FN_NAME 521 -#define TECLASS_NAME 522 -#define SHADOW_GROUP_NAME 523 /* DVM_F */ -#define REDUCTION_GROUP_NAME 524 /* DVM_F */ -#define REF_GROUP_NAME 525 /* DVM_F */ -#define ASYNC_ID 526 /* DVM_F */ -#define CONSISTENT_GROUP_NAME 527 /* DVM_F */ -#define NAMELIST_NAME 528 -#define COMMON_NAME 529 /* name of a common block (add Kataev N.A., 02.04.2014)*/ - -#define DEFAULT 550 -#define T_INT 551 /* scalar types */ -#define T_FLOAT 552 -#define T_DOUBLE 553 -#define T_CHAR 554 -#define T_BOOL 555 -#define T_STRING 556 -#define T_ENUM 557 -#define T_SUBRANGE 558 -#define T_LIST 559 -#define T_ARRAY 560 -#define T_RECORD 561 -#define T_ENUM_FIELD 562 -#define T_UNKNOWN 563 -#define T_COMPLEX 564 -#define T_VOID 565 /* New one for VPC */ -#define T_DESCRIPT 566 /* New one for VPC */ -#define T_FUNCTION 567 /* New one for VPC */ -#define T_POINTER 568 /* New one for VPC */ -#define T_UNION 569 /* New one for VPC */ -#define T_STRUCT 570 /* New one for VPC */ -#define T_CLASS 571 /* New one for VPC */ -#define T_DERIVED_CLASS 572 /* New one for VPC */ -#define T_DERIVED_TYPE 573 /* New one for VPC */ -#define T_COLLECTION 574 /* New one for PC++*/ -#define T_DERIVED_COLLECTION 575 /* New one for PC++*/ -#define T_REFERENCE 576 /* New one for PC++*/ -#define T_DERIVED_TEMPLATE 577 /* template type T */ -#define T_MEMBER_POINTER 578 /* need for C::* (ptr to memb ) */ -#define T_TECLASS 579 /* new one for pC++*/ -#define T_GATE 580 /* added for PCF FORTRAN */ -#define T_EVENT 581 -#define T_SEQUENCE 582 -#define T_DCOMPLEX 583 -#define T_LONG 584 -#define BY_USE 599 /* Fortran 90 */ -#define LOCAL 600 /* variable type */ -#define INPUT 601 -#define OUTPUT 602 -#define IO 603 -#define PROCESS_NAME 604 /* Fortran M */ - -#define OMP_PRIVATE 801 /* OpenMP Fortran */ -#define OMP_SHARED 802 /* OpenMP Fortran */ -#define OMP_FIRSTPRIVATE 803 /* OpenMP Fortran */ -#define OMP_LASTPRIVATE 804 /* OpenMP Fortran */ -#define OMP_THREADPRIVATE 805 /* OpenMP Fortran */ -#define OMP_COPYIN 806 /* OpenMP Fortran */ -#define OMP_COPYPRIVATE 807 /* OpenMP Fortran */ -#define OMP_DEFAULT 808 /* OpenMP Fortran */ -#define OMP_ORDERED 809 /* OpenMP Fortran */ -#define OMP_SCHEDULE 810 /* OpenMP Fortran */ -#define OMP_REDUCTION 811 /* OpenMP Fortran */ -#define OMP_IF 812 /* OpenMP Fortran */ -#define OMP_NUM_THREADS 813 /* OpenMP Fortran */ -#define OMP_NOWAIT 814 /* OpenMP Fortran */ -#define OMP_PARALLEL_DIR 820 /* OpenMP Fortran */ -#define OMP_END_PARALLEL_DIR 821 /* OpenMP Fortran */ -#define OMP_DO_DIR 822 /* OpenMP Fortran */ -#define OMP_END_DO_DIR 823 /* OpenMP Fortran */ -#define OMP_SECTIONS_DIR 824 /* OpenMP Fortran */ -#define OMP_END_SECTIONS_DIR 825 /* OpenMP Fortran */ -#define OMP_SECTION_DIR 826 /* OpenMP Fortran */ -#define OMP_SINGLE_DIR 827 /* OpenMP Fortran */ -#define OMP_END_SINGLE_DIR 828 /* OpenMP Fortran */ -#define OMP_WORKSHARE_DIR 829 /* OpenMP Fortran */ -#define OMP_END_WORKSHARE_DIR 830 /* OpenMP Fortran */ -#define OMP_PARALLEL_DO_DIR 831 /* OpenMP Fortran */ -#define OMP_END_PARALLEL_DO_DIR 832 /* OpenMP Fortran */ -#define OMP_PARALLEL_SECTIONS_DIR 833 /* OpenMP Fortran */ -#define OMP_END_PARALLEL_SECTIONS_DIR 834 /* OpenMP Fortran */ -#define OMP_PARALLEL_WORKSHARE_DIR 835 /* OpenMP Fortran */ -#define OMP_END_PARALLEL_WORKSHARE_DIR 836 /* OpenMP Fortran */ -#define OMP_MASTER_DIR 837 /* OpenMP Fortran */ -#define OMP_END_MASTER_DIR 838 /* OpenMP Fortran */ -#define OMP_CRITICAL_DIR 839 /* OpenMP Fortran */ -#define OMP_END_CRITICAL_DIR 840 /* OpenMP Fortran */ -#define OMP_BARRIER_DIR 841 /* OpenMP Fortran */ -#define OMP_ATOMIC_DIR 842 /* OpenMP Fortran */ -#define OMP_FLUSH_DIR 843 /* OpenMP Fortran */ -#define OMP_ORDERED_DIR 844 /* OpenMP Fortran */ -#define OMP_END_ORDERED_DIR 845 /* OpenMP Fortran */ -#define RECORD_DECL 846 /* OpenMP Fortran */ -#define FUNC_STAT 847 /* OpenMP Fortran */ -#define OMP_ONETHREAD_DIR 848 /* OpenMP Fortran */ -#define OMP_THREADPRIVATE_DIR 849 /* OpenMP Fortran */ -#define OMP_DEFAULT_SECTION_DIR 850 /* OpenMP Fortran */ -#define OMP_COLLAPSE 851 /* OpenMP Fortran */ - -#define ACC_REGION_DIR 900 /* ACC Fortran */ -#define ACC_END_REGION_DIR 901 /* ACC Fortran */ -#define ACC_CALL_STMT 907 /* ACC Fortran */ -#define ACC_KERNEL_HEDR 908 /* ACC Fortran */ -#define ACC_GET_ACTUAL_DIR 909 /* ACC Fortran */ -#define ACC_ACTUAL_DIR 910 /* ACC Fortran */ -#define ACC_CHECKSECTION_DIR 911 /* ACC Fortran */ -#define ACC_END_CHECKSECTION_DIR 912 /* ACC Fortran */ -#define ACC_ROUTINE_DIR 913 /* ACC Fortran */ -#define ACC_DECLARE_DIR 914 /* ACC Fortran */ - -#define ACC_TIE_OP 930 /* ACC Fortran */ -#define ACC_INLOCAL_OP 931 /* ACC Fortran */ -#define ACC_INOUT_OP 932 /* ACC Fortran */ -#define ACC_IN_OP 933 /* ACC Fortran */ -#define ACC_OUT_OP 934 /* ACC Fortran */ -#define ACC_LOCAL_OP 935 /* ACC Fortran */ -#define ACC_PRIVATE_OP 936 /* ACC Fortran */ -#define ACC_DEVICE_OP 937 /* ACC Fortran */ -#define ACC_CUDA_OP 938 /* ACC Fortran */ -#define ACC_HOST_OP 939 /* ACC Fortran */ - -#define ACC_GLOBAL_OP 940 /* ACC Fortran */ -#define ACC_ATTRIBUTES_OP 941 /* ACC Fortran */ -#define ACC_VALUE_OP 942 /* ACC Fortran */ -#define ACC_SHARED_OP 943 /* ACC Fortran */ -#define ACC_CONSTANT_OP 944 /* ACC Fortran */ -#define ACC_USES_OP 945 /* ACC Fortran */ -#define ACC_CALL_OP 946 /* ACC Fortran */ -#define ACC_CUDA_BLOCK_OP 947 /* ACC Fortran */ - -#define ACC_TARGETS_OP 948 /* ACC Fortran */ -#define ACC_ASYNC_OP 949 /* ACC Fortran */ - -#define SPF_ANALYSIS_DIR 950 /* SAPFOR */ -#define SPF_PARALLEL_DIR 951 /* SAPFOR */ -#define SPF_TRANSFORM_DIR 952 /* SAPFOR */ -#define SPF_NOINLINE_OP 953 /* SAPFOR */ -#define SPF_PARALLEL_REG_DIR 954 /* SAPFOR */ -#define SPF_END_PARALLEL_REG_DIR 955 /* SAPFOR */ -#define SPF_REGION_NAME 956 /* SAPFOR */ -#define SPF_EXPAND_OP 957 /* SAPFOR */ -#define SPF_FISSION_OP 958 /* SAPFOR */ -#define SPF_SHRINK_OP 959 /* SAPFOR */ -#define SPF_CHECKPOINT_DIR 960 /* SAPFOR */ -#define SPF_TYPE_OP 961 /* SAPFOR */ -#define SPF_VARLIST_OP 962 /* SAPFOR */ -#define SPF_EXCEPT_OP 963 /* SAPFOR */ -#define SPF_FILES_COUNT_OP 964 /* SAPFOR */ -#define SPF_INTERVAL_OP 965 /* SAPFOR */ -#define SPF_TIME_OP 966 /* SAPFOR */ -#define SPF_ITER_OP 967 /* SAPFOR */ -#define SPF_FLEXIBLE_OP 968 /* SAPFOR */ -#define SPF_PARAMETER_OP 969 /* SAPFOR */ -#define SPF_CODE_COVERAGE_OP 970 /* SAPFOR */ -#define SPF_UNROLL_OP 971 /* SAPFOR */ -#define SPF_COVER_OP 972 /* SAPFOR */ -#define SPF_MERGE_OP 973 /* SAPFOR */ -#define SPF_PROCESS_PRIVATE_OP 974 /* SAPFOR */ -#define SPF_WEIGHT_OP 975 /* SAPFOR */ - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/tag.doc b/projects/dvm_svn/fdvm/trunk/Sage/h/tag.doc deleted file mode 100644 index 14f9c11..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/tag.doc +++ /dev/null @@ -1,274 +0,0 @@ -/************************************************************************ - * * - * This file contains the documentation of the tags used in various * - * structures of the Sigma database * - * * - ************************************************************************/ - -/******************* variant tags for bif nodes **********************/ - -#define GLOBAL 100 /* pseudo root node */ -#define PROG_HEDR 101 /* main program node */ -#define PROC_HEDR 102 /* procedure/function node */ -#define BASIC_BLOCK 103 /* start node of a basic block */ -#define CONTROL_END 104 /* end of a block */ - -#define IF_NODE 105 /* an IF statement */ -#define ARITHIF_NODE 138 /* an arithmatic IF statement */ -#define LOGIF_NODE 145 /* a logical IF statement */ - -#define LOOP_NODE 106 /* a loop statement */ -#define FOR_NODE 107 /* a DO (in fortran) or a for (in C) statement */ -#define FORALL_NODE 108 /* a forall (Blaze??) statement */ -#define WHILE_NODE 109 /* a while statement */ -#define CDOALL_NODE 124 /* a CDOALL statement */ -#define SDOALL_NODE 125 /* a SDOALL statement */ -#define DOACROSS_NODE 126 /* a DOACROSS statement */ -#define CDOACROSS_NODE 127 /* a CDOACROSS statement */ -#define EXIT_NODE 110 /* an EXIT statement */ -#define GOTO_NODE 139 /* a GOTO statement */ -#define ASSGOTO_NODE 140 /* an ASSIGN GOTO statement */ -#define COMGOTO_NODE 141 /* a COMPUTED GOGO statement */ -#define PAUSE_NODE 142 /* a PAUSE statement */ -#define STOP_NODE 143 /* a STOP statement */ - -#define ASSIGN_STAT 111 /* an assignment statement */ -#define M_ASSIGN_STAT 112 /* a multiple assignment statement (Blaze??) */ -#define PROC_STAT 113 /* */ -#define ASSLAB_STAT 146 - -#define SUM_ACC 114 /* accumulation statements */ -#define MULT_ACC 115 -#define MAX_ACC 116 -#define MIN_ACC 117 -#define CAT_ACC 118 -#define OR_ACC 119 -#define AND_ACC 120 - -#define READ_STAT 121 -#define WRITE_STAT 122 -#define OTHERIO_STAT 123 - -#define BLOB 150 -#define SIZES 151 - - -#define FUNC_HEDR 130 -#define WHERE_NODE 131 -#define ALLDO_NODE 132 -#define IDENTIFY 133 -#define FORMAT_STAT 134 -#define STOP_STAT 135 -#define RETURN_STAT 136 -#define ELSEIF_NODE 137 - - /* NO_OP nodes */ -#define COMMENT_STAT 152 -#define CONT_STAT 153 -#define VAR_DECL 154 -#define PARAM_DECL 155 -#define COMM_STAT 156 -#define EQUI_STAT 157 -#define IMPL_DECL 158 -#define DATA_DECL 159 -#define SAVE_DECL 160 -#define ENTRY_STAT 162 -#define STMTFN_STAT 163 -#define DIM_STAT 164 -#define BLOCK_DATA 165 -#define EXTERN_STAT 166 -#define INTRIN_STAT 167 - -#define ENUM_DECL 168 /* New added for VPC */ -#define CLASS_DECL 169 /* New added for VPC */ -#define UNION_DECL 170 /* New added for VPC */ -#define STRUCT_DECL 171 /* New added for VPC */ -#define DERIVED_CLASS_DECL 172 /* New added for VPC */ -#define EXPR_STMT_NODE 173 /* New added for VPC */ -#define DO_WHILE_NODE 174 /* New added for VPC */ -#define SWITCH_NODE 175 /* New added for VPC */ -#define CASE_NODE 176 /* New added for VPC */ -#define DEFAULT_NODE 177 /* New added for VPC */ -#define BREAK_NODE 178 /* New added for VPC */ -#define CONTINUE_NODE 179 /* New added for VPC */ -#define RETURN_NODE 180 /* New added for VPC */ -#define ASM_NODE 181 /* New added for VPC */ -#define COBREAK_NODE 182 /* New added for VPC */ -#define COLOOP_NODE 183 /* New added for VPC */ -#define COEXEC_NODE 184 /* New added for VPC */ -#define LABEL_STAT 185 /* New added for VPC */ -#define PROC_COM 186 /* process common */ -#define ATTR_DECL 187 /* attribute declaration */ -#define NAMELIST_STAT 188 -#define FUTURE_STMT 189 /* NEW added for VPC */ - - -/***************** variant tags for low level nodes ********************/ - -#define INT_VAL 300 -#define FLOAT_VAL 301 -#define DOUBLE_VAL 302 -#define BOOL_VAL 303 -#define CHAR_VAL 304 -#define STRING_VAL 305 -#define COMPLEX_VAL 317 - -#define CONST_REF 306 -#define VAR_REF 307 -#define ARRAY_REF 308 -#define RECORD_REF 309 /* different structure between Blaze and VPC++ */ -#define ENUM_REF 310 -#define LABEL_REF 318 - -#define VAR_LIST 311 -#define EXPR_LIST 312 -#define RANGE_LIST 313 - -#define CASE_CHOICE 314 -#define DEF_CHOICE 315 -#define VARIANT_CHOICE 316 - -#define DDOT 324 -#define RANGE_OP 325 -#define UPPER_OP 326 -#define LOWER_OP 327 - -#define EQ_OP 328 -#define LT_OP 329 -#define GT_OP 330 -#define NOTEQL_OP 331 -#define LTEQL_OP 332 -#define GTEQL_OP 333 - -#define ADD_OP 334 -#define SUBT_OP 335 -#define OR_OP 336 - -#define MULT_OP 337 -#define DIV_OP 338 -#define MOD_OP 339 -#define AND_OP 340 - -#define EXP_OP 341 -#define ARRAY_MULT 342 -#define CONCAT_OP 343 /* cancatenation of strings */ -#define XOR_OP 344 /* .XOR. in fortran */ -#define EQV_OP 345 /* .EQV. in fortran */ -#define NEQV_OP 346 /* .NEQV. in fortran */ - -#define MINUS_OP 350 /* unary operations */ -#define NOT_OP 351 -#define ASSGN_OP 352 /* New ADDED For VPC */ -#define DEREF_OP 353 /* New ADDED For VPC */ -#define POINTST_OP 354 /* New ADDED For VPC */ /* ptr->x */ -#define FUNCTION_OP 355 /* New ADDED For VPC */ /* (*DD)() */ -#define MINUSMINUS_OP 356 /* New ADDED For VPC */ -#define PLUSPLUS_OP 357 /* New ADDED For VPC */ -#define BITAND_OP 358 /* New ADDED For VPC */ -#define BITOR_OP 359 /* New ADDED For VPC */ - - - - -#define STAR_RANGE 360 /* operations with no operands 360.. */ - -#define PROC_CALL 370 -#define FUNC_CALL 371 - - -#define CONSTRUCTOR_REF 380 -#define ACCESS_REF 381 -#define CONS 382 -#define ACCESS 383 -#define IOACCESS 384 -#define CONTROL_LIST 385 -#define SEQ 386 -#define SPEC_PAIR 387 -#define COMM_LIST 388 -#define STMT_STR 389 -#define EQUI_LIST 390 -#define IMPL_TYPE 391 -#define STMTFN_DECL 392 -#define BIT_COMPLEMENT_OP 393 -#define EXPR_IF 394 -#define EXPR_IF_BODY 395 -#define FUNCTION_REF 396 -#define LSHIFT_OP 397 -#define RSHIFT_OP 398 -#define UNARY_ADD_OP 399 -#define SIZE_OP 400 -#define INTEGER_DIV_OP 401 -#define SUB_OP 402 -#define LE_OP 403 /* New added for VPC */ -#define GE_OP 404 /* New added for VPC */ -#define NE_OP 405 /* New added for VPC */ - -#define CLASSINIT_OP 406 /* New added for VPC */ -#define CAST_OP 407 /* New added for VPC */ -#define ADDRESS_OP 408 /* New added for VPC */ -#define POINSTAT_OP 409 /* New added for VPC */ -#define COPY_NODE 410 /* New added for VPC */ -#define INIT_LIST 411 /* New added for VPC */ -#define VECTOR_CONST 412 /* New added for VPC */ -#define BIT_NUMBER 413 /* New added for VPC */ -#define ARITH_ASSGN_OP 414 /* New added for VPC */ -#define ARRAY_OP 415 /* New added for VPC */ -#define NEW_OP 416 /* New added for VPC */ -#define DELETE_OP 417 /* New added for VPC */ -#define NAMELIST_LIST 418 -#define THIS_NODE 419 /* New added for VPC */ -#define SCOPE_OP 420 /* New added for VPC */ - - -/***************** variant tags for symbol table entries ********************/ - - -#define CONST_NAME 500 /* constant types */ -#define ENUM_NAME 501 -#define FIELD_NAME 502 -#define VARIABLE_NAME 503 -#define TYPE_NAME 504 -#define PROGRAM_NAME 505 -#define PROCEDURE_NAME 506 -#define VAR_FIELD 507 -#define LABEL_VAR 508 /* dest of assigned goto stmt */ -#define FUNCTION_NAME 509 -#define MEMBER_FUNC 510 /* new added for VPC */ -#define CLASS_NAME 511 /* new added for VPC */ -#define UNION_NAME 512 /* new added for VPC */ -#define STRUCT_NAME 513 /* new added for VPC */ -#define LABEL_NAME 514 /* new added for VPC */ - - -#define DEFAULT 550 - -#define T_INT 551 /* scalar types */ -#define T_FLOAT 552 -#define T_DOUBLE 553 -#define T_CHAR 554 -#define T_BOOL 555 -#define T_STRING 556 -#define T_COMPLEX 564 - -#define T_ENUM 557 -#define T_SUBRANGE 558 -#define T_LIST 559 -#define T_ARRAY 560 -#define T_RECORD 561 -#define T_ENUM_FIELD 562 -#define T_UNKNOWN 563 -#define T_VOID 565 /* New one for VPC */ -#define T_DESCRIPT 566 /* New one for VPC */ -#define T_FUNCTION 567 /* New one for VPC */ -#define T_POINTER 568 /* New one for VPC */ -#define T_UNION 569 /* New one for VPC */ -#define T_STRUCT 570 /* New one for VPC */ -#define T_CLASS 571 /* New one for VPC */ -#define T_DERIVED_CLASS 572 /* New one for VPC */ -#define T_DERIVED_TYPE 573 /* New one for VPC */ - - -#define LOCAL 600 /* variable type */ -#define INPUT 601 -#define OUTPUT 602 -#define IO 603 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/tag.h b/projects/dvm_svn/fdvm/trunk/Sage/h/tag.h deleted file mode 100644 index 02ff849..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/tag.h +++ /dev/null @@ -1,630 +0,0 @@ -/* don't modify this file directly, it is made by a clever 'sed' -script using "tag". Run make tag.h to regenerate this file */ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/******************* variant tags for bif nodes **********************/ - - tag [ GLOBAL ] = "GLOBAL"; - tag [ PROG_HEDR ] = "PROG_HEDR"; - tag [ PROC_HEDR ] = "PROC_HEDR"; - tag [ BASIC_BLOCK ] = "BASIC_BLOCK"; - tag [ CONTROL_END ] = "CONTROL_END"; - tag [ IF_NODE ] = "IF_NODE"; - tag [ LOOP_NODE ] = "LOOP_NODE"; - tag [ FOR_NODE ] = "FOR_NODE"; - tag [ FORALL_NODE ] = "FORALL_NODE"; - tag [ WHILE_NODE ] = "WHILE_NODE"; - tag [ EXIT_NODE ] = "EXIT_NODE"; - tag [ ASSIGN_STAT ] = "ASSIGN_STAT"; - tag [ M_ASSIGN_STAT ] = "M_ASSIGN_STAT"; - tag [ PROC_STAT ] = "PROC_STAT"; - tag [ SUM_ACC ] = "SUM_ACC"; - tag [ MULT_ACC ] = "MULT_ACC"; - tag [ MAX_ACC ] = "MAX_ACC"; - tag [ MIN_ACC ] = "MIN_ACC"; - tag [ CAT_ACC ] = "CAT_ACC"; - tag [ OR_ACC ] = "OR_ACC"; - tag [ AND_ACC ] = "AND_ACC"; - tag [ READ_STAT ] = "READ_STAT"; - tag [ WRITE_STAT ] = "WRITE_STAT"; - tag [ OTHERIO_STAT ] = "OTHERIO_STAT"; - tag [ CDOALL_NODE ] = "CDOALL_NODE"; - tag [ SDOALL_NODE ] = "SDOALL_NODE"; - tag [ DOACROSS_NODE ] = "DOACROSS_NODE"; - tag [ CDOACROSS_NODE ] = "CDOACROSS_NODE"; - tag [ DVM_INTERVAL_DIR ] = "DVM_INTERVAL_DIR"; - tag [ DVM_ENDINTERVAL_DIR ] = "DVM_ENDINTERVAL_DIR"; - tag [ FUNC_HEDR ] = "FUNC_HEDR"; - tag [ WHERE_NODE ] = "WHERE_NODE"; - tag [ ALLDO_NODE ] = "ALLDO_NODE"; - tag [ IDENTIFY ] = "IDENTIFY"; - tag [ FORMAT_STAT ] = "FORMAT_STAT"; - tag [ STOP_STAT ] = "STOP_STAT"; - tag [ RETURN_STAT ] = "RETURN_STAT"; - tag [ ELSEIF_NODE ] = "ELSEIF_NODE"; - tag [ ARITHIF_NODE ] = "ARITHIF_NODE"; - tag [ GOTO_NODE ] = "GOTO_NODE"; - tag [ ASSGOTO_NODE ] = "ASSGOTO_NODE"; - tag [ COMGOTO_NODE ] = "COMGOTO_NODE"; - tag [ PAUSE_NODE ] = "PAUSE_NODE"; - tag [ STOP_NODE ] = "STOP_NODE"; - tag [ ASSLAB_STAT ] = "ASSLAB_STAT"; - tag [ LOGIF_NODE ] = "LOGIF_NODE"; - tag [ DVM_DEBUG_DIR ] = "DVM_DEBUG_DIR"; - tag [ DVM_ENDDEBUG_DIR ] = "DVM_ENDDEBUG_DIR"; - tag [ DVM_TRACEON_DIR ] = "DVM_TRACEON_DIR"; - tag [ DVM_TRACEOFF_DIR ] = "DVM_TRACEOFF_DIR"; - tag [ BLOB ] = "BLOB"; - tag [ SIZES ] = "SIZES"; - tag [ COMMENT_STAT ] = "COMMENT_STAT"; - tag [ CONT_STAT ] = "CONT_STAT"; - tag [ VAR_DECL ] = "VAR_DECL"; - tag [ PARAM_DECL ] = "PARAM_DECL"; - tag [ COMM_STAT ] = "COMM_STAT"; - tag [ EQUI_STAT ] = "EQUI_STAT"; - tag [ IMPL_DECL ] = "IMPL_DECL"; - tag [ DATA_DECL ] = "DATA_DECL"; - tag [ SAVE_DECL ] = "SAVE_DECL"; - tag [ ENTRY_STAT ] = "ENTRY_STAT"; - tag [ STMTFN_STAT ] = "STMTFN_STAT"; - tag [ DIM_STAT ] = "DIM_STAT"; - tag [ BLOCK_DATA ] = "BLOCK_DATA"; - tag [ EXTERN_STAT ] = "EXTERN_STAT"; - tag [ INTRIN_STAT ] = "INTRIN_STAT"; - tag [ ENUM_DECL ] = "ENUM_DECL"; - tag [ CLASS_DECL ] = "CLASS_DECL"; - tag [ UNION_DECL ] = "UNION_DECL"; - tag [ STRUCT_DECL ] = "STRUCT_DECL"; - tag [ DERIVED_CLASS_DECL ] = "DERIVED_CLASS_DECL"; - tag [ EXPR_STMT_NODE ] = "EXPR_STMT_NODE"; - tag [ DO_WHILE_NODE ] = "DO_WHILE_NODE"; - tag [ SWITCH_NODE ] = "SWITCH_NODE"; - tag [ CASE_NODE ] = "CASE_NODE"; - tag [ DEFAULT_NODE ] = "DEFAULT_NODE"; - tag [ BREAK_NODE ] = "BREAK_NODE"; - tag [ CONTINUE_NODE ] = "CONTINUE_NODE"; - tag [ RETURN_NODE ] = "RETURN_NODE"; - tag [ ASM_NODE ] = "ASM_NODE"; - tag [ SPAWN_NODE ] = "SPAWN_NODE"; - tag [ PARFOR_NODE ] = "PARFOR_NODE"; - tag [ PAR_NODE ] = "PAR_NODE"; - tag [ LABEL_STAT ] = "LABEL_STAT"; - tag [ PROS_COMM ] = "PROS_COMM"; - tag [ ATTR_DECL ] = "ATTR_DECL"; - tag [ NAMELIST_STAT ] = "NAMELIST_STAT"; - tag [ FUTURE_STMT ] = "FUTURE_STMT"; - tag [ COLLECTION_DECL ] = "COLLECTION_DECL"; - tag [ TEMPLATE_DECL ] = "TEMPLATE_DECL"; - tag [ TEMPLATE_FUNDECL ] = "TEMPLATE_FUNDECL"; - tag [ TECLASS_DECL ] = "TECLASS_DECL"; - tag [ ELSEWH_NODE ] = "ELSEWH_NODE"; - tag [ STATIC_STMT ] = "STATIC_STMT"; - tag [ INCLUDE_LINE ] = "INCLUDE_LINE"; - tag [ PREPROCESSOR_DIR ] = "PREPROCESSOR_DIR"; - tag [ PRINT_STAT ] = "PRINT_STAT"; - tag [ BACKSPACE_STAT ] = "BACKSPACE_STAT"; - tag [ REWIND_STAT ] = "REWIND_STAT"; - tag [ ENDFILE_STAT ] = "ENDFILE_STAT"; - tag [ INQUIRE_STAT ] = "INQUIRE_STAT"; - tag [ OPEN_STAT ] = "OPEN_STAT"; - tag [ CLOSE_STAT ] = "CLOSE_STAT"; - tag [ EXTERN_C_STAT ] = "EXTERN_C_STAT"; - tag [ INCLUDE_STAT ] = "INCLUDE_STAT"; - tag [ TRY_STAT ] = "TRY_STAT"; - tag [ CATCH_STAT ] = "CATCH_STAT"; - tag [ DVM_PARALLEL_ON_DIR ] = "DVM_PARALLEL_ON_DIR"; - tag [ DVM_SHADOW_START_DIR ] = "DVM_SHADOW_START_DIR"; - tag [ DVM_SHADOW_GROUP_DIR ] = "DVM_SHADOW_GROUP_DIR"; - tag [ DVM_SHADOW_WAIT_DIR ] = "DVM_SHADOW_WAIT_DIR"; - tag [ DVM_REDUCTION_START_DIR ] = "DVM_REDUCTION_START_DIR"; - tag [ DVM_REDUCTION_GROUP_DIR ] = "DVM_REDUCTION_GROUP_DIR"; - tag [ DVM_REDUCTION_WAIT_DIR ] = "DVM_REDUCTION_WAIT_DIR"; - tag [ DVM_DYNAMIC_DIR ] = "DVM_DYNAMIC_DIR"; - tag [ DVM_ALIGN_DIR ] = "DVM_ALIGN_DIR"; - tag [ DVM_REALIGN_DIR ] = "DVM_REALIGN_DIR"; - tag [ DVM_REALIGN_NEW_DIR ] = "DVM_REALIGN_NEW_DIR"; - tag [ DVM_REMOTE_ACCESS_DIR ] = "DVM_REMOTE_ACCESS_DIR"; - tag [ HPF_INDEPENDENT_DIR ] = "HPF_INDEPENDENT_DIR"; - tag [ DVM_SHADOW_DIR ] = "DVM_SHADOW_DIR"; - tag [ PARDO_NODE ] = "PARDO_NODE"; - tag [ PARSECTIONS_NODE ] = "PARSECTIONS_NODE"; - tag [ SECTION_NODE ] = "SECTION_NODE"; - tag [ GUARDS_NODE ] = "GUARDS_NODE"; - tag [ LOCK_NODE ] = "LOCK_NODE"; - tag [ UNLOCK_NODE ] = "UNLOCK_NODE"; - tag [ CRITSECTION_NODE ] = "CRITSECTION_NODE"; - tag [ POST_NODE ] = "POST_NODE"; - tag [ WAIT_NODE ] = "WAIT_NODE"; - tag [ CLEAR_NODE ] = "CLEAR_NODE"; - tag [ POSTSEQ_NODE ] = "POSTSEQ_NODE"; - tag [ WAITSEQ_NODE ] = "WAITSEQ_NODE"; - tag [ SETSEQ_NODE ] = "SETSEQ_NODE"; - tag [ ASSIGN_NODE ] = "ASSIGN_NODE"; - tag [ RELEASE_NODE ] = "RELEASE_NODE"; - tag [ PRIVATE_NODE ] = "PRIVATE_NODE"; - tag [ SCOMMON_NODE ] = "SCOMMON_NODE"; - tag [ PARREGION_NODE ] = "PARREGION_NODE"; - tag [ PDO_NODE ] = "PDO_NODE"; - tag [ PSECTIONS_NODE ] = "PSECTIONS_NODE"; - tag [ SINGLEPROCESS_NODE ] = "SINGLEPROCESS_NODE"; - tag [ SKIPPASTEOF_NODE ] = "SKIPPASTEOF_NODE"; - tag [ DVM_NEW_VALUE_DIR ] = "DVM_NEW_VALUE_DIR"; - tag [ DVM_VAR_DECL ] = "DVM_VAR_DECL"; - tag [ DVM_POINTER_DIR ] = "DVM_POINTER_DIR"; - tag [ INTENT_STMT ] = "INTENT_STMT"; - tag [ OPTIONAL_STMT ] = "OPTIONAL_STMT"; - tag [ PUBLIC_STMT ] = "PUBLIC_STMT"; - tag [ PRIVATE_STMT ] = "PRIVATE_STMT"; - tag [ ALLOCATABLE_STMT ] = "ALLOCATABLE_STMT"; - tag [ POINTER_STMT ] = "POINTER_STMT"; - tag [ TARGET_STMT ] = "TARGET_STMT"; - tag [ ALLOCATE_STMT ] = "ALLOCATE_STMT"; - tag [ NULLIFY_STMT ] = "NULLIFY_STMT"; - tag [ DEALLOCATE_STMT ] = "DEALLOCATE_STMT"; - tag [ SEQUENCE_STMT ] = "SEQUENCE_STMT"; - tag [ CYCLE_STMT ] = "CYCLE_STMT"; - tag [ EXIT_STMT ] = "EXIT_STMT"; - tag [ CONTAINS_STMT ] = "CONTAINS_STMT"; - tag [ WHERE_BLOCK_STMT ] = "WHERE_BLOCK_STMT"; - tag [ MODULE_STMT ] = "MODULE_STMT"; - tag [ USE_STMT ] = "USE_STMT"; - tag [ INTERFACE_STMT ] = "INTERFACE_STMT"; - tag [ MODULE_PROC_STMT ] = "MODULE_PROC_STMT"; - tag [ OVERLOADED_ASSIGN_STAT ] = "OVERLOADED_ASSIGN_STAT"; - tag [ POINTER_ASSIGN_STAT ] = "POINTER_ASSIGN_STAT"; - tag [ OVERLOADED_PROC_STAT ] = "OVERLOADED_PROC_STAT"; - tag [ DECOMPOSITION_STMT ] = "DECOMPOSITION_STMT"; - tag [ ALIGN_STMT ] = "ALIGN_STMT"; - tag [ DVM_DISTRIBUTE_DIR ] = "DVM_DISTRIBUTE_DIR"; - tag [ REDUCE_STMT ] = "REDUCE_STMT"; - tag [ PROS_HEDR ] = "PROS_HEDR"; - tag [ PROS_STAT ] = "PROS_STAT"; - tag [ PROS_STAT_LCTN ] = "PROS_STAT_LCTN"; - tag [ PROS_STAT_SUBM ] = "PROS_STAT_SUBM"; - tag [ PROCESSES_STAT ] = "PROCESSES_STAT"; - tag [ PROCESSES_END ] = "PROCESSES_END"; - tag [ PROCESS_DO_STAT ] = "PROCESS_DO_STAT"; - tag [ PROCESSORS_STAT ] = "PROCESSORS_STAT"; - tag [ CHANNEL_STAT ] = "CHANNEL_STAT"; - tag [ MERGER_STAT ] = "MERGER_STAT"; - tag [ MOVE_PORT ] = "MOVE_PORT"; - tag [ SEND_STAT ] = "SEND_STAT"; - tag [ RECEIVE_STAT ] = "RECEIVE_STAT"; - tag [ ENDCHANNEL_STAT ] = "ENDCHANNEL_STAT"; - tag [ PROBE_STAT ] = "PROBE_STAT"; - tag [ INPORT_DECL ] = "INPORT_DECL"; - tag [ OUTPORT_DECL ] = "OUTPORT_DECL"; - tag [ HPF_TEMPLATE_STAT ] = "HPF_TEMPLATE_STAT"; - tag [ HPF_ALIGN_STAT ] = "HPF_ALIGN_STAT"; - tag [ HPF_PROCESSORS_STAT ] = "HPF_PROCESSORS_STAT"; - tag [ DVM_REDISTRIBUTE_DIR ] = "DVM_REDISTRIBUTE_DIR"; - tag [ DVM_TASK_REGION_DIR ] = "DVM_TASK_REGION_DIR"; - tag [ DVM_END_TASK_REGION_DIR ] = "DVM_END_TASK_REGION_DIR"; - tag [ DVM_ON_DIR ] = "DVM_ON_DIR"; - tag [ DVM_END_ON_DIR ] = "DVM_END_ON_DIR"; - tag [ DVM_TASK_DIR ] = "DVM_TASK_DIR"; - tag [ DVM_MAP_DIR ] = "DVM_MAP_DIR"; - tag [ DVM_PARALLEL_TASK_DIR ] = "DVM_PARALLEL_TASK_DIR"; - tag [ DVM_INHERIT_DIR ] = "DVM_INHERIT_DIR"; - tag [ DVM_INDIRECT_GROUP_DIR ] = "DVM_INDIRECT_GROUP_DIR"; - tag [ DVM_INDIRECT_ACCESS_DIR ] = "DVM_INDIRECT_ACCESS_DIR"; - tag [ DVM_REMOTE_GROUP_DIR ] = "DVM_REMOTE_GROUP_DIR"; - tag [ DVM_RESET_DIR ] = "DVM_RESET_DIR"; - tag [ DVM_PREFETCH_DIR ] = "DVM_PREFETCH_DIR"; - tag [ DVM_OWN_DIR ] = "DVM_OWN_DIR"; - tag [ DVM_HEAP_DIR ] = "DVM_HEAP_DIR"; - tag [ DVM_ASYNCID_DIR ] = "DVM_ASYNCID_DIR"; - tag [ DVM_ASYNCHRONOUS_DIR ] = "DVM_ASYNCHRONOUS_DIR"; - tag [ DVM_ENDASYNCHRONOUS_DIR ] = "DVM_ENDASYNCHRONOUS_DIR"; - tag [ DVM_ASYNCWAIT_DIR ] = "DVM_ASYNCWAIT_DIR"; - tag [ DVM_F90_DIR ] = "DVM_F90_DIR"; - tag [ DVM_BARRIER_DIR ] = "DVM_BARRIER_DIR"; - tag [ FORALL_STAT ] = "FORALL_STAT"; - tag [ DVM_CONSISTENT_GROUP_DIR ] = "DVM_CONSISTENT_GROUP_DIR"; - tag [ DVM_CONSISTENT_START_DIR ] = "DVM_CONSISTENT_START_DIR"; - tag [ DVM_CONSISTENT_WAIT_DIR ] = "DVM_CONSISTENT_WAIT_DIR"; - tag [ DVM_CONSISTENT_DIR ] = "DVM_CONSISTENT_DIR"; - tag [ DVM_CHECK_DIR ] = "DVM_CHECK_DIR"; - tag [ DVM_IO_MODE_DIR ] = "DVM_IO_MODE_DIR"; - tag [ DVM_LOCALIZE_DIR ] = "DVM_LOCALIZE_DIR"; - tag [ DVM_SHADOW_ADD_DIR ] = "DVM_SHADOW_ADD_DIR"; - tag [ DVM_CP_CREATE_DIR ] = "DVM_CP_CREATE_DIR"; - tag [ DVM_CP_LOAD_DIR ] = "DVM_CP_LOAD_DIR"; - tag [ DVM_CP_SAVE_DIR ] = "DVM_CP_SAVE_DIR"; - tag [ DVM_CP_WAIT_DIR ] = "DVM_CP_WAIT_DIR"; - tag [ DVM_EXIT_INTERVAL_DIR ] = "DVM_EXIT_INTERVAL_DIR"; - tag [ DVM_TEMPLATE_CREATE_DIR ] = "DVM_TEMPLATE_CREATE_DIR"; - tag [ DVM_TEMPLATE_DELETE_DIR ] = "DVM_TEMPLATE_DELETE_DIR"; - tag [ PRIVATE_AR_DECL ] = "PRIVATE_AR_DECL"; - -/***************** variant tags for low level nodes ********************/ - - tag [ INT_VAL ] = "INT_VAL"; - tag [ FLOAT_VAL ] = "FLOAT_VAL"; - tag [ DOUBLE_VAL ] = "DOUBLE_VAL"; - tag [ BOOL_VAL ] = "BOOL_VAL"; - tag [ CHAR_VAL ] = "CHAR_VAL"; - tag [ STRING_VAL ] = "STRING_VAL"; - tag [ CONST_REF ] = "CONST_REF"; - tag [ VAR_REF ] = "VAR_REF"; - tag [ ARRAY_REF ] = "ARRAY_REF"; - tag [ RECORD_REF ] = "RECORD_REF"; - tag [ ENUM_REF ] = "ENUM_REF"; - tag [ VAR_LIST ] = "VAR_LIST"; - tag [ EXPR_LIST ] = "EXPR_LIST"; - tag [ RANGE_LIST ] = "RANGE_LIST"; - tag [ CASE_CHOICE ] = "CASE_CHOICE"; - tag [ DEF_CHOICE ] = "DEF_CHOICE"; - tag [ VARIANT_CHOICE ] = "VARIANT_CHOICE"; - tag [ COMPLEX_VAL ] = "COMPLEX_VAL"; - tag [ LABEL_REF ] = "LABEL_REF"; - tag [ KEYWORD_VAL ] = "KEYWORD_VAL"; - tag [ DDOT ] = "DDOT"; - tag [ RANGE_OP ] = "RANGE_OP"; - tag [ UPPER_OP ] = "UPPER_OP"; - tag [ LOWER_OP ] = "LOWER_OP"; - tag [ EQ_OP ] = "EQ_OP"; - tag [ LT_OP ] = "LT_OP"; - tag [ GT_OP ] = "GT_OP"; - tag [ NOTEQL_OP ] = "NOTEQL_OP"; - tag [ LTEQL_OP ] = "LTEQL_OP"; - tag [ GTEQL_OP ] = "GTEQL_OP"; - tag [ ADD_OP ] = "ADD_OP"; - tag [ SUBT_OP ] = "SUBT_OP"; - tag [ OR_OP ] = "OR_OP"; - tag [ MULT_OP ] = "MULT_OP"; - tag [ DIV_OP ] = "DIV_OP"; - tag [ MOD_OP ] = "MOD_OP"; - tag [ AND_OP ] = "AND_OP"; - tag [ EXP_OP ] = "EXP_OP"; - tag [ ARRAY_MULT ] = "ARRAY_MULT"; - tag [ CONCAT_OP ] = "CONCAT_OP"; - tag [ XOR_OP ] = "XOR_OP"; - tag [ EQV_OP ] = "EQV_OP"; - tag [ NEQV_OP ] = "NEQV_OP"; - tag [ MINUS_OP ] = "MINUS_OP"; - tag [ NOT_OP ] = "NOT_OP"; - tag [ ASSGN_OP ] = "ASSGN_OP"; - tag [ DEREF_OP ] = "DEREF_OP"; - tag [ POINTST_OP ] = "POINTST_OP"; - tag [ FUNCTION_OP ] = "FUNCTION_OP"; - tag [ MINUSMINUS_OP ] = "MINUSMINUS_OP"; - tag [ PLUSPLUS_OP ] = "PLUSPLUS_OP"; - tag [ BITAND_OP ] = "BITAND_OP"; - tag [ BITOR_OP ] = "BITOR_OP"; - tag [ STAR_RANGE ] = "STAR_RANGE"; - tag [ PROC_CALL ] = "PROC_CALL"; - tag [ FUNC_CALL ] = "FUNC_CALL"; - tag [ CONSTRUCTOR_REF ] = "CONSTRUCTOR_REF"; - tag [ ACCESS_REF ] = "ACCESS_REF"; - tag [ CONS ] = "CONS"; - tag [ ACCESS ] = "ACCESS"; - tag [ IOACCESS ] = "IOACCESS"; - tag [ CONTROL_LIST ] = "CONTROL_LIST"; - tag [ SEQ ] = "SEQ"; - tag [ SPEC_PAIR ] = "SPEC_PAIR"; - tag [ COMM_LIST ] = "COMM_LIST"; - tag [ STMT_STR ] = "STMT_STR"; - tag [ EQUI_LIST ] = "EQUI_LIST"; - tag [ IMPL_TYPE ] = "IMPL_TYPE"; - tag [ STMTFN_DECL ] = "STMTFN_DECL"; - tag [ BIT_COMPLEMENT_OP ] = "BIT_COMPLEMENT_OP"; - tag [ EXPR_IF ] = "EXPR_IF"; - tag [ EXPR_IF_BODY ] = "EXPR_IF_BODY"; - tag [ FUNCTION_REF ] = "FUNCTION_REF"; - tag [ LSHIFT_OP ] = "LSHIFT_OP"; - tag [ RSHIFT_OP ] = "RSHIFT_OP"; - tag [ UNARY_ADD_OP ] = "UNARY_ADD_OP"; - tag [ SIZE_OP ] = "SIZE_OP"; - tag [ INTEGER_DIV_OP ] = "INTEGER_DIV_OP"; - tag [ SUB_OP ] = "SUB_OP"; - tag [ LE_OP ] = "LE_OP"; - tag [ GE_OP ] = "GE_OP"; - tag [ NE_OP ] = "NE_OP"; - tag [ CLASSINIT_OP ] = "CLASSINIT_OP"; - tag [ CAST_OP ] = "CAST_OP"; - tag [ ADDRESS_OP ] = "ADDRESS_OP"; - tag [ POINSTAT_OP ] = "POINSTAT_OP"; - tag [ COPY_NODE ] = "COPY_NODE"; - tag [ INIT_LIST ] = "INIT_LIST"; - tag [ VECTOR_CONST ] = "VECTOR_CONST"; - tag [ BIT_NUMBER ] = "BIT_NUMBER"; - tag [ ARITH_ASSGN_OP ] = "ARITH_ASSGN_OP"; - tag [ ARRAY_OP ] = "ARRAY_OP"; - tag [ NEW_OP ] = "NEW_OP"; - tag [ DELETE_OP ] = "DELETE_OP"; - tag [ NAMELIST_LIST ] = "NAMELIST_LIST"; - tag [ THIS_NODE ] = "THIS_NODE"; - tag [ SCOPE_OP ] = "SCOPE_OP"; - tag [ PLUS_ASSGN_OP ] = "PLUS_ASSGN_OP"; - tag [ MINUS_ASSGN_OP ] = "MINUS_ASSGN_OP"; - tag [ AND_ASSGN_OP ] = "AND_ASSGN_OP"; - tag [ IOR_ASSGN_OP ] = "IOR_ASSGN_OP"; - tag [ MULT_ASSGN_OP ] = "MULT_ASSGN_OP"; - tag [ DIV_ASSGN_OP ] = "DIV_ASSGN_OP"; - tag [ MOD_ASSGN_OP ] = "MOD_ASSGN_OP"; - tag [ XOR_ASSGN_OP ] = "XOR_ASSGN_OP"; - tag [ LSHIFT_ASSGN_OP ] = "LSHIFT_ASSGN_OP"; - tag [ RSHIFT_ASSGN_OP ] = "RSHIFT_ASSGN_OP"; - tag [ ORDERED_OP ] = "ORDERED_OP"; - tag [ EXTEND_OP ] = "EXTEND_OP"; - tag [ MAXPARALLEL_OP ] = "MAXPARALLEL_OP"; - tag [ SAMETYPE_OP ] = "SAMETYPE_OP"; - tag [ TYPE_REF ] = "TYPE_REF"; - tag [ STRUCTURE_CONSTRUCTOR ] = "STRUCTURE_CONSTRUCTOR"; - tag [ ARRAY_CONSTRUCTOR ] = "ARRAY_CONSTRUCTOR"; - tag [ SECTION_REF ] = "SECTION_REF"; - tag [ VECTOR_SUBSCRIPT ] = "VECTOR_SUBSCRIPT"; - tag [ SECTION_OPERANDS ] = "SECTION_OPERANDS"; - tag [ KEYWORD_ARG ] = "KEYWORD_ARG"; - tag [ OVERLOADED_CALL ] = "OVERLOADED_CALL"; - tag [ INTERFACE_REF ] = "INTERFACE_REF"; - tag [ RENAME_NODE ] = "RENAME_NODE"; - tag [ TYPE_NODE ] = "TYPE_NODE"; - tag [ PAREN_OP ] = "PAREN_OP"; - tag [ PARAMETER_OP ] = "PARAMETER_OP"; - tag [ PUBLIC_OP ] = "PUBLIC_OP"; - tag [ PRIVATE_OP ] = "PRIVATE_OP"; - tag [ ALLOCATABLE_OP ] = "ALLOCATABLE_OP"; - tag [ DIMENSION_OP ] = "DIMENSION_OP"; - tag [ EXTERNAL_OP ] = "EXTERNAL_OP"; - tag [ IN_OP ] = "IN_OP"; - tag [ OUT_OP ] = "OUT_OP"; - tag [ INOUT_OP ] = "INOUT_OP"; - tag [ INTRINSIC_OP ] = "INTRINSIC_OP"; - tag [ POINTER_OP ] = "POINTER_OP"; - tag [ OPTIONAL_OP ] = "OPTIONAL_OP"; - tag [ SAVE_OP ] = "SAVE_OP"; - tag [ TARGET_OP ] = "TARGET_OP"; - tag [ ONLY_NODE ] = "ONLY_NODE"; - tag [ LEN_OP ] = "LEN_OP"; - tag [ TYPE_OP ] = "TYPE_OP"; - tag [ DOTSTAR_OP ] = "DOTSTAR_OP"; - tag [ ARROWSTAR_OP ] = "ARROWSTAR_OP"; - tag [ FORDECL_OP ] = "FORDECL_OP"; - tag [ THROW_OP ] = "THROW_OP"; - tag [ PROCESSORS_REF ] = "PROCESSORS_REF"; - tag [ PORT_TYPE_OP ] = "PORT_TYPE_OP"; - tag [ INPORT_TYPE_OP ] = "INPORT_TYPE_OP"; - tag [ OUTPORT_TYPE_OP ] = "OUTPORT_TYPE_OP"; - tag [ INPORT_NAME ] = "INPORT_NAME"; - tag [ OUTPORT_NAME ] = "OUTPORT_NAME"; - tag [ FROMPORT_NAME ] = "FROMPORT_NAME"; - tag [ TOPORT_NAME ] = "TOPORT_NAME"; - tag [ IOSTAT_STORE ] = "IOSTAT_STORE"; - tag [ EMPTY_STORE ] = "EMPTY_STORE"; - tag [ ERR_LABEL ] = "ERR_LABEL"; - tag [ END_LABEL ] = "END_LABEL"; - tag [ PROS_CALL ] = "PROS_CALL"; - tag [ STATIC_OP ] = "STATIC_OP"; - tag [ LABEL_ARG ] = "LABEL_ARG"; - tag [ DATA_IMPL_DO ] = "DATA_IMPL_DO"; - tag [ DATA_ELT ] = "DATA_ELT"; - tag [ DATA_SUBS ] = "DATA_SUBS"; - tag [ DATA_RANGE ] = "DATA_RANGE"; - tag [ ICON_EXPR ] = "ICON_EXPR"; - tag [ BLOCK_OP ] = "BLOCK_OP"; - tag [ NEW_SPEC_OP ] = "NEW_SPEC_OP"; - tag [ REDUCTION_OP ] = "REDUCTION_OP"; - tag [ SHADOW_RENEW_OP ] = "SHADOW_RENEW_OP"; - tag [ SHADOW_START_OP ] = "SHADOW_START_OP"; - tag [ SHADOW_WAIT_OP ] = "SHADOW_WAIT_OP"; - tag [ DIAG_OP ] = "DIAG_OP"; - tag [ REMOTE_ACCESS_OP ] = "REMOTE_ACCESS_OP"; - tag [ TEMPLATE_OP ] = "TEMPLATE_OP"; - tag [ PROCESSORS_OP ] = "PROCESSORS_OP"; - tag [ DYNAMIC_OP ] = "DYNAMIC_OP"; - tag [ ALIGN_OP ] = "ALIGN_OP"; - tag [ DISTRIBUTE_OP ] = "DISTRIBUTE_OP"; - tag [ SHADOW_OP ] = "SHADOW_OP"; - tag [ INDIRECT_ACCESS_OP ] = "INDIRECT_ACCESS_OP"; - tag [ ACROSS_OP ] = "ACROSS_OP"; - tag [ NEW_VALUE_OP ] = "NEW_VALUE_OP"; - tag [ SHADOW_COMP_OP ] = "SHADOW_COMP_OP"; - tag [ STAGE_OP ] = "STAGE_OP"; - tag [ FORALL_OP ] = "FORALL_OP"; - tag [ CONSISTENT_OP ] = "CONSISTENT_OP"; - tag [ INTERFACE_OPERATOR ] = "INTERFACE_OPERATOR"; - tag [ INTERFACE_ASSIGNMENT ] = "INTERFACE_ASSIGNMENT"; - tag [ VAR_DECL_90 ] = "VAR_DECL_90"; - tag [ ASSIGNMENT_OP ] = "ASSIGNMENT_OP"; - tag [ OPERATOR_OP ] = "OPERATOR_OP"; - tag [ KIND_OP ] = "KIND_OP"; - tag [ LENGTH_OP ] = "LENGTH_OP"; - tag [ RECURSIVE_OP ] = "RECURSIVE_OP"; - tag [ ELEMENTAL_OP ] = "ELEMENTAL_OP"; - tag [ PURE_OP ] = "PURE_OP"; - tag [ DEFINED_OP ] = "DEFINED_OP"; - tag [ PARALLEL_OP ] = "PARALLEL_OP"; - tag [ INDIRECT_OP ] = "INDIRECT_OP"; - tag [ DERIVED_OP ] = "DERIVED_OP"; - tag [ DUMMY_REF ] = "DUMMY_REF"; - tag [ COMMON_OP ] = "COMMON_OP"; - tag [ SHADOW_NAMES_OP ] = "SHADOW_NAMES_OP"; - -/***************** variant tags for symbol table entries ********************/ - - tag [ CONST_NAME ] = "CONST_NAME"; - tag [ ENUM_NAME ] = "ENUM_NAME"; - tag [ FIELD_NAME ] = "FIELD_NAME"; - tag [ VARIABLE_NAME ] = "VARIABLE_NAME"; - tag [ TYPE_NAME ] = "TYPE_NAME"; - tag [ PROGRAM_NAME ] = "PROGRAM_NAME"; - tag [ PROCEDURE_NAME ] = "PROCEDURE_NAME"; - tag [ VAR_FIELD ] = "VAR_FIELD"; - tag [ LABEL_VAR ] = "LABEL_VAR"; - tag [ FUNCTION_NAME ] = "FUNCTION_NAME"; - tag [ MEMBER_FUNC ] = "MEMBER_FUNC"; - tag [ CLASS_NAME ] = "CLASS_NAME"; - tag [ UNION_NAME ] = "UNION_NAME"; - tag [ STRUCT_NAME ] = "STRUCT_NAME"; - tag [ LABEL_NAME ] = "LABEL_NAME"; - tag [ COLLECTION_NAME ] = "COLLECTION_NAME"; - tag [ ROUTINE_NAME ] = "ROUTINE_NAME"; - tag [ CONSTRUCT_NAME ] = "CONSTRUCT_NAME"; - tag [ INTERFACE_NAME ] = "INTERFACE_NAME"; - tag [ MODULE_NAME ] = "MODULE_NAME"; - tag [ TEMPLATE_CL_NAME ] = "TEMPLATE_CL_NAME"; - tag [ TEMPLATE_FN_NAME ] = "TEMPLATE_FN_NAME"; - tag [ TECLASS_NAME ] = "TECLASS_NAME"; - tag [ SHADOW_GROUP_NAME ] = "SHADOW_GROUP_NAME"; - tag [ REDUCTION_GROUP_NAME ] = "REDUCTION_GROUP_NAME"; - tag [ REF_GROUP_NAME ] = "REF_GROUP_NAME"; - tag [ ASYNC_ID ] = "ASYNC_ID"; - tag [ CONSISTENT_GROUP_NAME ] = "CONSISTENT_GROUP_NAME"; - tag [ NAMELIST_NAME ] = "NAMELIST_NAME"; - tag [ COMMON_NAME ] = "COMMON_NAME"; - - tag [ DEFAULT ] = "DEFAULT"; - tag [ T_INT ] = "T_INT"; - tag [ T_FLOAT ] = "T_FLOAT"; - tag [ T_DOUBLE ] = "T_DOUBLE"; - tag [ T_CHAR ] = "T_CHAR"; - tag [ T_BOOL ] = "T_BOOL"; - tag [ T_STRING ] = "T_STRING"; - tag [ T_ENUM ] = "T_ENUM"; - tag [ T_SUBRANGE ] = "T_SUBRANGE"; - tag [ T_LIST ] = "T_LIST"; - tag [ T_ARRAY ] = "T_ARRAY"; - tag [ T_RECORD ] = "T_RECORD"; - tag [ T_ENUM_FIELD ] = "T_ENUM_FIELD"; - tag [ T_UNKNOWN ] = "T_UNKNOWN"; - tag [ T_COMPLEX ] = "T_COMPLEX"; - tag [ T_VOID ] = "T_VOID"; - tag [ T_DESCRIPT ] = "T_DESCRIPT"; - tag [ T_FUNCTION ] = "T_FUNCTION"; - tag [ T_POINTER ] = "T_POINTER"; - tag [ T_UNION ] = "T_UNION"; - tag [ T_STRUCT ] = "T_STRUCT"; - tag [ T_CLASS ] = "T_CLASS"; - tag [ T_DERIVED_CLASS ] = "T_DERIVED_CLASS"; - tag [ T_DERIVED_TYPE ] = "T_DERIVED_TYPE"; - tag [ T_COLLECTION ] = "T_COLLECTION"; - tag [ T_DERIVED_COLLECTION ] = "T_DERIVED_COLLECTION"; - tag [ T_REFERENCE ] = "T_REFERENCE"; - tag [ T_DERIVED_TEMPLATE ] = "T_DERIVED_TEMPLATE"; - tag [ T_MEMBER_POINTER ] = "T_MEMBER_POINTER"; - tag [ T_TECLASS ] = "T_TECLASS"; - tag [ T_GATE ] = "T_GATE"; - tag [ T_EVENT ] = "T_EVENT"; - tag [ T_SEQUENCE ] = "T_SEQUENCE"; - tag [ T_DCOMPLEX ] = "T_DCOMPLEX"; - tag [ T_LONG ] = "T_LONG"; - tag [ BY_USE ] = "BY_USE"; - tag [ LOCAL ] = "LOCAL"; - tag [ INPUT ] = "INPUT"; - tag [ OUTPUT ] = "OUTPUT"; - tag [ IO ] = "IO"; - tag [ PROCESS_NAME ] = "PROCESS_NAME"; - - tag [ OMP_PRIVATE ] = "OMP_PRIVATE"; - tag [ OMP_SHARED ] = "OMP_SHARED"; - tag [ OMP_FIRSTPRIVATE ] = "OMP_FIRSTPRIVATE"; - tag [ OMP_LASTPRIVATE ] = "OMP_LASTPRIVATE"; - tag [ OMP_THREADPRIVATE ] = "OMP_THREADPRIVATE"; - tag [ OMP_COPYIN ] = "OMP_COPYIN"; - tag [ OMP_COPYPRIVATE ] = "OMP_COPYPRIVATE"; - tag [ OMP_DEFAULT ] = "OMP_DEFAULT"; - tag [ OMP_ORDERED ] = "OMP_ORDERED"; - tag [ OMP_SCHEDULE ] = "OMP_SCHEDULE"; - tag [ OMP_REDUCTION ] = "OMP_REDUCTION"; - tag [ OMP_IF ] = "OMP_IF"; - tag [ OMP_NUM_THREADS ] = "OMP_NUM_THREADS"; - tag [ OMP_NOWAIT ] = "OMP_NOWAIT"; - tag [ OMP_PARALLEL_DIR ] = "OMP_PARALLEL_DIR"; - tag [ OMP_END_PARALLEL_DIR ] = "OMP_END_PARALLEL_DIR"; - tag [ OMP_DO_DIR ] = "OMP_DO_DIR"; - tag [ OMP_END_DO_DIR ] = "OMP_END_DO_DIR"; - tag [ OMP_SECTIONS_DIR ] = "OMP_SECTIONS_DIR"; - tag [ OMP_END_SECTIONS_DIR ] = "OMP_END_SECTIONS_DIR"; - tag [ OMP_SECTION_DIR ] = "OMP_SECTION_DIR"; - tag [ OMP_SINGLE_DIR ] = "OMP_SINGLE_DIR"; - tag [ OMP_END_SINGLE_DIR ] = "OMP_END_SINGLE_DIR"; - tag [ OMP_WORKSHARE_DIR ] = "OMP_WORKSHARE_DIR"; - tag [ OMP_END_WORKSHARE_DIR ] = "OMP_END_WORKSHARE_DIR"; - tag [ OMP_PARALLEL_DO_DIR ] = "OMP_PARALLEL_DO_DIR"; - tag [ OMP_END_PARALLEL_DO_DIR ] = "OMP_END_PARALLEL_DO_DIR"; - tag [ OMP_PARALLEL_SECTIONS_DIR ] = "OMP_PARALLEL_SECTIONS_DIR"; - tag [ OMP_END_PARALLEL_SECTIONS_DIR ] = "OMP_END_PARALLEL_SECTIONS_DIR"; - tag [ OMP_PARALLEL_WORKSHARE_DIR ] = "OMP_PARALLEL_WORKSHARE_DIR"; - tag [ OMP_END_PARALLEL_WORKSHARE_DIR ] = "OMP_END_PARALLEL_WORKSHARE_DIR"; - tag [ OMP_MASTER_DIR ] = "OMP_MASTER_DIR"; - tag [ OMP_END_MASTER_DIR ] = "OMP_END_MASTER_DIR"; - tag [ OMP_CRITICAL_DIR ] = "OMP_CRITICAL_DIR"; - tag [ OMP_END_CRITICAL_DIR ] = "OMP_END_CRITICAL_DIR"; - tag [ OMP_BARRIER_DIR ] = "OMP_BARRIER_DIR"; - tag [ OMP_ATOMIC_DIR ] = "OMP_ATOMIC_DIR"; - tag [ OMP_FLUSH_DIR ] = "OMP_FLUSH_DIR"; - tag [ OMP_ORDERED_DIR ] = "OMP_ORDERED_DIR"; - tag [ OMP_END_ORDERED_DIR ] = "OMP_END_ORDERED_DIR"; - tag [ RECORD_DECL ] = "RECORD_DECL"; - tag [ FUNC_STAT ] = "FUNC_STAT"; - tag [ OMP_ONETHREAD_DIR ] = "OMP_ONETHREAD_DIR"; - tag [ OMP_THREADPRIVATE_DIR ] = "OMP_THREADPRIVATE_DIR"; - tag [ OMP_DEFAULT_SECTION_DIR ] = "OMP_DEFAULT_SECTION_DIR"; - tag [ OMP_COLLAPSE ] = "OMP_COLLAPSE"; - - tag [ ACC_REGION_DIR ] = "ACC_REGION_DIR"; - tag [ ACC_END_REGION_DIR ] = "ACC_END_REGION_DIR"; - tag [ ACC_CALL_STMT ] = "ACC_CALL_STMT"; - tag [ ACC_KERNEL_HEDR ] = "ACC_KERNEL_HEDR"; - tag [ ACC_GET_ACTUAL_DIR ] = "ACC_GET_ACTUAL_DIR"; - tag [ ACC_ACTUAL_DIR ] = "ACC_ACTUAL_DIR"; - tag [ ACC_CHECKSECTION_DIR ] = "ACC_CHECKSECTION_DIR"; - tag [ ACC_END_CHECKSECTION_DIR ] = "ACC_END_CHECKSECTION_DIR"; - tag [ ACC_ROUTINE_DIR ] = "ACC_ROUTINE_DIR"; - tag [ ACC_DECLARE_DIR ] = "ACC_DECLARE_DIR"; - - tag [ ACC_TIE_OP ] = "ACC_TIE_OP"; - tag [ ACC_INLOCAL_OP ] = "ACC_INLOCAL_OP"; - tag [ ACC_INOUT_OP ] = "ACC_INOUT_OP"; - tag [ ACC_IN_OP ] = "ACC_IN_OP"; - tag [ ACC_OUT_OP ] = "ACC_OUT_OP"; - tag [ ACC_LOCAL_OP ] = "ACC_LOCAL_OP"; - tag [ ACC_PRIVATE_OP ] = "ACC_PRIVATE_OP"; - tag [ ACC_DEVICE_OP ] = "ACC_DEVICE_OP"; - tag [ ACC_CUDA_OP ] = "ACC_CUDA_OP"; - tag [ ACC_HOST_OP ] = "ACC_HOST_OP"; - - tag [ ACC_GLOBAL_OP ] = "ACC_GLOBAL_OP"; - tag [ ACC_ATTRIBUTES_OP ] = "ACC_ATTRIBUTES_OP"; - tag [ ACC_VALUE_OP ] = "ACC_VALUE_OP"; - tag [ ACC_SHARED_OP ] = "ACC_SHARED_OP"; - tag [ ACC_CONSTANT_OP ] = "ACC_CONSTANT_OP"; - tag [ ACC_USES_OP ] = "ACC_USES_OP"; - tag [ ACC_CALL_OP ] = "ACC_CALL_OP"; - tag [ ACC_CUDA_BLOCK_OP ] = "ACC_CUDA_BLOCK_OP"; - - tag [ ACC_TARGETS_OP ] = "ACC_TARGETS_OP"; - tag [ ACC_ASYNC_OP ] = "ACC_ASYNC_OP"; - - tag [ SPF_ANALYSIS_DIR ] = "SPF_ANALYSIS_DIR"; - tag [ SPF_PARALLEL_DIR ] = "SPF_PARALLEL_DIR"; - tag [ SPF_TRANSFORM_DIR ] = "SPF_TRANSFORM_DIR"; - tag [ SPF_NOINLINE_OP ] = "SPF_NOINLINE_OP"; - tag [ SPF_PARALLEL_REG_DIR ] = "SPF_PARALLEL_REG_DIR"; - tag [ SPF_END_PARALLEL_REG_DIR ] = "SPF_END_PARALLEL_REG_DIR"; - tag [ SPF_REGION_NAME ] = "SPF_REGION_NAME"; - tag [ SPF_EXPAND_OP ] = "SPF_EXPAND_OP"; - tag [ SPF_FISSION_OP ] = "SPF_FISSION_OP"; - tag [ SPF_SHRINK_OP ] = "SPF_SHRINK_OP"; - tag [ SPF_CHECKPOINT_DIR ] = "SPF_CHECKPOINT_DIR"; - tag [ SPF_TYPE_OP ] = "SPF_TYPE_OP"; - tag [ SPF_VARLIST_OP ] = "SPF_VARLIST_OP"; - tag [ SPF_EXCEPT_OP ] = "SPF_EXCEPT_OP"; - tag [ SPF_FILES_COUNT_OP ] = "SPF_FILES_COUNT_OP"; - tag [ SPF_INTERVAL_OP ] = "SPF_INTERVAL_OP"; - tag [ SPF_TIME_OP ] = "SPF_TIME_OP"; - tag [ SPF_ITER_OP ] = "SPF_ITER_OP"; - tag [ SPF_FLEXIBLE_OP ] = "SPF_FLEXIBLE_OP"; - tag [ SPF_PARAMETER_OP ] = "SPF_PARAMETER_OP"; - tag [ SPF_CODE_COVERAGE_OP ] = "SPF_CODE_COVERAGE_OP"; - tag [ SPF_UNROLL_OP ] = "SPF_UNROLL_OP"; - tag [ SPF_COVER_OP ] = "SPF_COVER_OP"; - tag [ SPF_MERGE_OP ] = "SPF_MERGE_OP"; - tag [ SPF_PROCESS_PRIVATE_OP ] = "SPF_PROCESS_PRIVATE_OP"; - tag [ SPF_WEIGHT_OP ] = "SPF_WEIGHT_OP"; - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/tag_make b/projects/dvm_svn/fdvm/trunk/Sage/h/tag_make deleted file mode 100644 index 68b8d7d..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/tag_make +++ /dev/null @@ -1,7 +0,0 @@ -all: tag.h - -tag.h: head tag - ( cat head; \ - sed < tag \ - '/#defin/s/\([^ ]*\) \([^ ]*\)\(.*\)/ tag \[ \2 \] = \"\2\";/')\ - > tag.h diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/version.h b/projects/dvm_svn/fdvm/trunk/Sage/h/version.h deleted file mode 100644 index 6db35ab..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/version.h +++ /dev/null @@ -1,2 +0,0 @@ -#define VERSION_NUMBER "6.9" -#define VERSION_NUMBER_INT "69" diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/vextern.h b/projects/dvm_svn/fdvm/trunk/Sage/h/vextern.h deleted file mode 100644 index c2b08ce..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/vextern.h +++ /dev/null @@ -1,167 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - -/* Modified By Jenq-Kuen Lee Nov 20, 1987 */ - -extern int NoWarnings; /* Used by newer code pC++2dep (phb) */ -extern int nowarnflag; /* Used by older obsolete code c2dep, f2dep */ - -/* The following variable used by verrors.c */ -extern int yylineno; -extern char *infname; -extern int nwarn; -extern int errcnt; -extern int errline; -extern int wait_first_include_name; -extern char *first_line_name; - -/* leave it out */ -/* - -extern char yytext[]; - - -extern int yyleng; -extern int lineno; -extern int needkwd; -extern int inioctl; -extern int shiftcase; - -extern int parstate; -extern int blklevel; - -extern int procclass; -extern long procleng; -extern int nentry; -extern int blklevel; -extern int undeftype; -extern int dorange; -extern char intonly; -*/ - - - - - - - - -extern int num_bfnds; /* total # of bif nodes */ -extern int num_llnds; /* total # of low level nodes */ -extern int num_symbs; /* total # of symbol nodes */ -extern int num_types; /* total # of types nodes */ -extern int num_blobs; /* total # of blob nodes */ -extern int num_sets; /* total # of set nodes */ -extern int num_cmnt; -extern int num_def; /* total # of dependncy nodes */ -extern int num_dep; -extern int num_deflst; -extern int num_label; /* total # of label nodes */ -extern int num_files; - -extern int cur_level; /* current block level */ -extern int next_level; - -extern char *tag[610]; - -extern PTR_SYMB global_list; - -extern PTR_BFND head_bfnd, /* start of bfnd chain */ - cur_bfnd, /* poextern int to current bfnd */ - pred_bfnd, /* used in finding the predecessor */ - last_bfnd; - -extern PTR_LLND head_llnd, cur_llnd; - -extern PTR_SYMB head_symb, cur_symb; - -extern PTR_TYPE head_type, cur_type; - -extern PTR_LABEL head_label, cur_label, thislabel; - -extern PTR_FNAME head_file,cur_thread_file; - -extern PTR_BLOB head_blob, cur_blob; - -extern PTR_SETS head_sets, cur_sets; - -extern PTR_DEF head_def, cur_def; - -extern PTR_DEFLST head_deflst, cur_deflst; - -extern PTR_DEP head_dep, cur_dep, pre_dep; - -/*************************************************************************/ -/* DECLARE is defined to be null (nothing) so that the variable is declared, - or it is defined to be "extern". (phb) */ - -#ifndef DECLARE -#define DECLARE extern -#endif - -DECLARE PTR_CMNT head_cmnt, cur_cmnt; -DECLARE PTR_BLOB global_blob ; -DECLARE PTR_BFND global_bfnd; -DECLARE PTR_SYMB star_symb; -DECLARE PTR_TYPE vartype; -DECLARE PTR_CMNT comments; - -#undef DECLARE -/*************************************************************************/ - -extern PTR_CMNT cur_comment; -/* struct Ctlframe *ctlsp = (struct Ctlframe *)NULL; */ - -extern PTR_TYPE make_type(); -extern PTR_SYMB make_symb(); -extern PTR_BFND make_bfnd(); -extern PTR_BFND make_bfndnt(); /* non-threaded ver. (lib/oldsrc/make_nodes.c */ -extern PTR_BFND get_bfnd(); -extern PTR_BLOB make_blob(); -extern PTR_LLND make_llnd(); -extern void init_hash(); - -extern PTR_TYPE global_int, global_float, global_double, global_char, global_string,global_void; -extern PTR_TYPE global_bool, global_complex, global_default, global_string_2; - -extern char *ckalloc(); -extern char *copyn(), *copys(); - -#define ALLOC(x) (struct x *) ckalloc(sizeof(struct x)) - -#define INLOOP(x) ((LOOP_NODE <= x) && (x <= WHILE_NODE)) -/* Used By pC++2dep */ -extern int ExternLangDecl; /* PHB */ -extern int mod_offset ; -extern int old_line ; -extern int branch_flag; -extern int main_type_flag ; -extern int primary_flag; -extern int function_flag ; -extern int friend_flag ; -extern int cur_flag ; -extern int exception_flag ; -extern PTR_SYMB first_symbol,right_symbol ; -extern PTR_BFND passed_bfnd; -extern PTR_BFND new_cur_bfnd ; -extern PTR_LLND new_cur_llnd ; -extern PTR_TYPE new_cur_type ; -extern PTR_SYMB new_cur_symb; -extern char *new_cur_fname; -extern char *line_pos_fname; -extern PTR_HASH cur_id_entry ; -extern PTR_CMNT new_cur_comment; -extern int yydebug ; -extern int TRACEON ; -extern int declare_flag ; -extern int not_fetch_yet ; /* for comments */ -extern int recursive_yylex; /* for comments */ -extern int line_pos_1 ; -extern PTR_FILE fi; -PTR_TYPE get_type(); -PTR_LABEL get_label(); -extern PTR_SYMB elementtype_symb; diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/vparse.h b/projects/dvm_svn/fdvm/trunk/Sage/h/vparse.h deleted file mode 100644 index 8c3a172..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/vparse.h +++ /dev/null @@ -1,126 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* Modified By Jenq-Kuen Lee Sep 30, 1987 */ -/* Define constants for communication with parse.y. */ -/* Copyright (C) 1987 Free Software Foundation, Inc. */ - -#include -enum rid -{ - RID_UNUSED, - RID_INT, - RID_CHAR, - RID_FLOAT, - RID_DOUBLE, - RID_VOID, - RID_UNUSED1, - - RID_UNSIGNED, - RID_SHORT, - RID_LONG, - RID_AUTO, - RID_STATIC, - RID_EXTERN, - RID_REGISTER, - RID_TYPEDEF, - RID_SIGNED, - RID_CONST, - RID_VOLATILE, - RID_PRIVATE, - RID_FUTURE, - RID_VIRTUAL, - RID_INLINE, - RID_FRIEND, - RID_PUBLIC, - RID_PROTECTED, - RID_SYNC, - RID_GLOBL, - RID_ATOMIC, - RID_KSRPRIVATE, - RID_RESTRICT, - RID_MAX, - RID_CUDA_GLOBAL, - RID_CUDA_SHARED, - RID_CUDA_DEVICE, - - LONG_UNSIGNED_TYPE_CONST, /* For numerical constant */ - LONG_INTEGER_TYPE_CONST, - UNSIGNED_TYPE_CONST, - INTEGER_TYPE_CONST, - FLOAT_TYPE_CONST, - LONG_DOUBLE_TYPE_CONST, - DOUBLE_TYPE_CONST, - /* For char constant */ - UNSIGNED_CHAR_TYPE_CONST, - CHAR_TYPE_CONST, - CHAR_ARRAY_TYPE_CONST, - - PLUS_EXPR , /* Statement code */ - MINUS_EXPR, - BIT_AND_EXPR, - BIT_IOR_EXPR, - MULT_EXPR, - TRUNC_DIV_EXPR, - TRUNC_MOD_EXPR, - BIT_XOR_EXPR, - LSHIFT_EXPR , - RSHIFT_EXPR, - LT_EXPR, - GT_EXPR, - LE_EXPR, - GE_EXPR, - NE_EXPR, - EQ_EXPR -}; - -/* #define RID_FIRST_MODIFIER RID_UNSIGNED */ - -#define NEXT_FULL 10 /*for comments type, FULL, HALF, NEXT_FULL */ - -/* for access_flag */ -#define BIT_PROTECTED 1 /* note: also see PROTECTED_FIELD */ -#define BIT_PUBLIC 2 /* note: also see PUBLIC_FIELD */ -#define BIT_PRIVATE 4 /* note: also see PRIVATE_FIELD */ -#define BIT_FUTURE 8 -#define BIT_VIRTUAL 16 -#define BIT_INLINE 32 - -/*for signed_flag */ -#define BIT_UNSIGNED 64 -#define BIT_SIGNED 128 - -/* for long_short_flag */ -#define BIT_SHORT 256 -#define BIT_LONG 512 - -/* for mod_flag */ -#define BIT_VOLATILE 1024 -#define BIT_CONST 1024*2 -#define BIT_GLOBL 1024*128*2 -#define BIT_SYNC 1024*128*4 -#define BIT_ATOMIC 1024*128*8 -#define BIT_KSRPRIVATE 1024*128*16 -#define BIT_RESTRICT 1024*128*32 -/* for storage flag */ -#define BIT_TYPEDEF 1024*4 -#define BIT_EXTERN 1024*8 -#define BIT_AUTO 1024*128 /* swapped values for AUTO and FRIEND */ -#define BIT_STATIC 1024*32 -#define BIT_REGISTER 1024*64 -#define BIT_FRIEND 1024*16 /* so that friend would fit in u_short BW*/ - -#define MAX_BIT 1024*128*64 -#define STORAGE_FLAG 1024*(4+8+16+32+64+128) -#define BIT_OPENMP 1024*128*128 /* OpenMP Fortran */ -#define BIT_CUDA_GLOBAL 1024*128*256 /* Cuda */ -#define BIT_CUDA_SHARED 1024*128*512 /* Cuda */ -#define BIT_CUDA_DEVICE 1024*128*1024 /* Cuda */ - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/vpc.h b/projects/dvm_svn/fdvm/trunk/Sage/h/vpc.h deleted file mode 100644 index a5bdd96..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/vpc.h +++ /dev/null @@ -1,182 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* TAG : pC++2dep used Created by Jenq_kuen Lee Nov 28, 1987 */ -/* definitions of Some Key_echo */ -/* Define results of standard character escape sequences. */ -#define TARGET_BELL 007 -#define TARGET_BS 010 -#define TARGET_TAB 011 -#define TARGET_NEWLINE 012 -#define TARGET_VT 013 -#define TARGET_FF 014 -#define TARGET_CR 015 - - -#define BITS_PER_UNIT 8 -#define pedantic 1 - -/* Debugging flag */ - - -/* switch used for parser */ -#define UP_TO_CLASS 6 -#define UP_ONE_LEVEL 5 -#define UP_TO_NODECL 4 -#define UP_TO_FUNC_HEDR 3 -#define OTHER 2 -#define ON 1 -#define OFF 0 - -/* switch used for parser */ -#define ONE 1 -#define TWO 2 -#define THREE 3 - -#define DONOT_CARE 0 - -#define TYPE_CLEAN 0 -#define TYPE_ONE 1 -#define TYPE_TWO 2 -#define TYPE_THREE 3 -#define TYPE_FOUR 4 -#define TYPE_FIVE 5 - -#define BRANCH_OFF 0 -#define BRANCH_ON 1 - -/* flag for declarator rule */ -/* information kept in cur_flag */ -#define RULE_PARAM 1 -#define RULE_ID 2 -#define RULE_MULTIPLE_ID 4 -#define RULE_LR 8 -#define RULE_DEREF 16 -#define RULE_ARRAY 32 -#define RULE_ARRAY_E 64 -#define RULE_CLASSINIT 128 -#define RULE_ERROR 256 -#define LAZY_INSTALL 512 -#define CLEAN 0 - -/* flag for primary_flag */ -#define ID_ONLY 1 -#define RANGE_APPEAR 2 -#define EXCEPTION_ON 4 -#define EXPR_LR 8 -#define VECTOR_CONST_APPEAR 16 -#define ARRAY_OP_NEED 32 - -/* flag for access_class for parameter_flag */ -#define XDECL 4096 - -/* automata state for comments.c */ -#define ZERO 0 -#define STATE_1 1 -#define STATE_2 2 -#define STATE_3 3 -#define STATE_4 4 -#define STATE_5 5 -#define STATE_6 6 -#define STATE_7 7 -#define STATE_8 8 -#define STATE_9 9 -#define STATE_10 10 -#define STATE_11 11 -#define STATE_12 12 -#define STATE_13 13 -#define STATE_14 14 -#define STATE_15 15 -#define STATE_16 16 -#define STATE_17 17 -#define STATE_18 18 -#define STATE_19 19 -#define STATE_20 20 -#define IF_STATE 30 -#define IF_STATE_2 32 -#define IF_STATE_3 33 -#define IF_STATE_4 34 -#define ELSE_EXPECTED_STATE 35 -#define BLOCK_STATE 40 -#define BLOCK_STATE_2 42 -#define WHILE_STATE 50 -#define WHILE_STATE_2 52 -#define FOR_STATE 55 -#define FOR_STATE_2 56 -#define CASE_STATE 57 -#define COEXEC_STATE 58 -#define COEXEC_STATE_2 59 -#define COLOOP_STATE 60 -#define COLOOP_STATE_2 61 -#define DO_STATE 62 -#define DO_STATE_1 63 -#define DO_STATE_2 64 -#define DO_STATE_3 65 -#define DO_STATE_4 66 -#define DO_STATE_5 67 -#define DO_STATE_6 68 -#define RETURN_STATE 70 -#define RETURN_STATE_2 71 -#define RETURN_STATE_3 72 -#define GOTO_STATE 75 -#define GOTO_STATE_2 76 -#define SWITCH_STATE 80 -#define SWITCH_STATE_2 81 -#define STATE_ARG 82 -#define BLOCK_STATE_WAITSEMI 83 -#define TEMPLATE_STATE 84 -#define TEMPLATE_STATE_2 85 -#define CONSTR_STATE 86 -/* for comments.c */ -#define MAX_NESTED_SIZE 800 - - - -/* parameter for function body and struct declaration body */ -#define NOT_SEEN 1 -#define BEEN_SEEN 0 -#define FUNCTION_BODY_APPEAR 700 - -/* parameter for find_type_symbol */ -#define TYPE_ONLY 1 /* TYPE_NAME */ -#define STRUCT_ONLY 2 -#define VAR_ONLY 4 -#define FIELD_ONLY 8 -#define FUNCTION_NAME_ONLY 16 -#define MEMBER_FUNC_ONLY 32 - - -/*flag for the error message of lazy_install */ -/* No More symbol, Alliant C compiler's symbol table is full */ -/* #define NOW 1 */ -/* #define DELAY 2 */ -/* For symbptr->attr */ -#define ATT_CLUSTER 0 -#define ATT_GLOBAL 1 -#define PURE 8 -#define PRIVATE_FIELD 16 -#define PROTECTED_FIELD 32 -#define PUBLIC_FIELD 64 -#define ELEMENT_FIELD 128 -#define COLLECTION_FIELD 256 -#define CONSTRUCTOR 512 -#define DESTRUCTOR 1024 -#define PCPLUSPLUS_DOSUBSET 2048 -#define INVALID 4096 -#define SUBCOLLECTION 4096*2 -/* #define OVOPERATOR 4096*4 (defined in macro.h) (phb) */ -#define VIRTUAL_DESTRUCTOR 4096*8 /* added by BW */ - -/* For find_type_symbol() */ -/* for check_field_decl_3 */ -#define ALL_FIELDS 1 -#define CLASS_ONLY 2 -#define COLLECTION_ONLY 3 -#define ELEMENT_ONLY 4 -#define FUNCTION_ONLY 5 - -/* for collection nested dimension */ -#define MAX_NESTED_DIM 5 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/h/window.h b/projects/dvm_svn/fdvm/trunk/Sage/h/window.h deleted file mode 100644 index ddc1adb..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/h/window.h +++ /dev/null @@ -1,71 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - -#define MAX_WINDOW 256 -#define MAX_ARRAYREF 256 -#define MAX_STEP 10000 -#define NO_STEP 10000 -struct WINDOW -{ - int dimension; - int Array_Id[MAX_ARRAYREF]; - int level; - int level_update; - char name[64]; - char gain[128]; - int coeff[MAXTILE][MAXTILE]; - int inf[MAXTILE]; - int sup[MAXTILE]; - int nb_ref; - PTR_SYMB symb; - PTR_SYMB array_symbol; - PTR_SYMB pt; - int lambda[MAXTILE]; - int delta[MAXTILE]; - int size[MAXTILE]; - int cst[MAXTILE]; -}; - -struct WINDOWS -{ - int nb_windows; - int nb_loop; - int tile_order[MAXTILE]; - int tile_sup[MAXTILE]; - int tile_inf[MAXTILE]; - int tile_bounds[MAXTILE]; - struct WINDOW thewindow[MAX_WINDOW]; - PTR_SYMB index[MAXTILE]; -}; - - -#define WINDS_NB(NODE) ((NODE).nb_windows) -#define WINDS_INDEX(NODE) ((NODE).index) -#define WINDS_NB_LOOP(NODE) ((NODE).nb_loop) -#define WINDS_TILE_INF(NODE) ((NODE).tile_inf) -#define WINDS_TILE_SUP(NODE) ((NODE).tile_sup) -#define WINDS_TILE_ORDER(NODE) ((NODE).tile_order) -#define WINDS_TILE_BOUNDS(NODE) ((NODE).tile_bounds) -#define WINDS_WINDOWS(NODE,NUM) (&((NODE).thewindow[NUM])) - -#define WIND_DIM(NODE) ((NODE)->dimension) -#define WIND_ARRAY(NODE) ((NODE)->Array_Id) -#define WIND_LEVEL(NODE) ((NODE)->level) -#define WIND_LEVEL_UPDATE(NODE) ((NODE)->level_update) -#define WIND_NB_REF(NODE) ((NODE)->nb_ref) -#define WIND_SYMBOL(NODE) ((NODE)->symb) -#define WIND_POINTER(NODE) ((NODE)->pt) -#define WIND_NAME(NODE) ((NODE)->name) -#define WIND_GAIN(NODE) ((NODE)->gain) -#define WIND_COEFF(NODE) ((NODE)->coeff) -#define WIND_INF(NODE) ((NODE)->inf) -#define WIND_SUP(NODE) ((NODE)->sup) -#define WIND_LAMBDA(NODE) ((NODE)->lambda) -#define WIND_DELTA(NODE) ((NODE)->delta) -#define WIND_SIZE_DIM(NODE) ((NODE)->size) -#define WIND_DIM_CST(NODE) ((NODE)->cst) -#define WIND_ARRAY_SYMBOL(NODE) ((NODE)->array_symbol) diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/Sage/lib/CMakeLists.txt deleted file mode 100644 index 169f04a..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/CMakeLists.txt +++ /dev/null @@ -1,6 +0,0 @@ -set(DVM_SAGE_INCLUDE_DIRS ${DVM_SAGE_INCLUDE_DIRS} - ${CMAKE_CURRENT_SOURCE_DIR}/include) -set(DVM_SAGE_INCLUDE_DIRS ${DVM_SAGE_INCLUDE_DIRS} PARENT_SCOPE) - -add_subdirectory(newsrc) -add_subdirectory(oldsrc) \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/Makefile b/projects/dvm_svn/fdvm/trunk/Sage/lib/Makefile deleted file mode 100644 index e109575..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/Makefile +++ /dev/null @@ -1,55 +0,0 @@ -####################################################################### -## pC++/Sage++ Copyright (C) 1993 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - - -# sage/lib/Makefile (phb) - -SHELL = /bin/sh -INSTALL = /bin/cp - -# Flags passed down to Makefiles in subdirectories -MFLAGS = - -CC = gcc -#CC=cc#ENDIF##USE_CC# - -CXX = g++ -CXX = /usr/WorkShop/usr/bin/DCC -LINKER = $(CC) - -NOP = echo -#C90#EXTRAOBJ=alloca-c90.o#ENDIF# -#C90#NOP = @/bin/rm -f alloca-c90.o#ENDIF# - -SUBDIR1 = oldsrc newsrc -# Subdirectories to make resursively -SUBDIR = ${SUBDIR1} - -all: ${SUBDIR} $(EXTRAOBJ) - -clean: - $(NOP) - for i in ${SUBDIR1}; do (cd $$i; $(MAKE) "MAKE=$(MAKE)" clean); done - -install: FRC $(EXTRAOBJ) - @for i in ${SUBDIR1}; do (cd $$i; \ - echo " *** COMPILING $$i DIRECTORY";\ - $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" install); done - -# If you are on a C90, you will need the gnu alloca() -alloca-c90.o: alloca-c90.c - $(CC) -c alloca-c90.c - if [ -d c90 ] ; then true; \ - else mkdir c90 ;fi - $(INSTALL) alloca-c90.o c90 - -.RECURSIVE: ${SUBDIR} - -${SUBDIR}: FRC - @echo " *** COMPILING $@ DIRECTORY"; cd $@; \ - $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -FRC: - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/attributes.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/attributes.h deleted file mode 100644 index b9effe1..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/attributes.h +++ /dev/null @@ -1,95 +0,0 @@ -//////////////////////////////////////////////////////////////////////////////////////////////////////// -// -// Defines the data structure for attributes in sage -// attributes can be used to store any information for any statement, expression, symbol or types nodes -// F. Bodin Indiana July 94. -// -// -//////////////////////////////////////////////////////////////////////////////////////////////////////// - -class SgAttribute{ - private: - // the attribute data; - int type; // a label; - void *data; // the data; - int dataSize; // the size of the data in bytes to allow data to be copied; - SgAttribute *next; // to the next attribute of a statements (do that way or not??); - // link to sage node, allow to go from an attribute to sage stuffs; - typenode typeNode; // indicates if SgStatement, SgExpression, ... ptToSage is pointed to; - void *ptToSage; // pointer to SgStatement, SgExpression, ... ; - int fileNumber; // the file methods; -// the methods to access the structure of an attributes; - public: - SgAttribute(int t, void *pt, int size, SgStatement &st, int filenum); - SgAttribute(int t, void *pt, int size, SgSymbol &st, int filenum); - SgAttribute(int t, void *pt, int size, SgExpression &st, int filenum); - SgAttribute(int t, void *pt, int size, SgType &st, int filenum); - SgAttribute(int t, void *pt, int size, SgLabel &st, int filenum); //Kataev 21.03.2013 - SgAttribute(int t, void *pt, int size, SgFile &st, int filenum); //Kataev 15.07.2013 - SgAttribute(const SgAttribute& copy) - { - type = copy.type; - data = copy.data; - dataSize = copy.dataSize; - next = NULL; - typeNode = copy.typeNode; - ptToSage = copy.ptToSage; - fileNumber = copy.fileNumber; - } - - ~SgAttribute(); - int getAttributeType(); - void setAttributeType(int t); - void *getAttributeData(); - void *setAttributeData(void *d); - int getAttributeSize(); - void setAttributeSize(int s); - typenode getTypeNode(); - void *getPtToSage(); - void setPtToSage(void *sa); - void resetPtToSage(); - void setPtToSage(SgStatement &st); - void setPtToSage(SgSymbol &st); - void setPtToSage(SgExpression &st); - void setPtToSage(SgType &st); - void setPtToSage(SgLabel &st); //Kataev 21.03.2013 - void setPtToSage(SgFile &st); //Kataev 15.07.2013 - SgStatement *getStatement(); - SgExpression *getExpression(); - SgSymbol *getSgSymbol(); - SgType *getType(); - SgLabel *getLabel(); //Kataev 21.03.2013 - SgFile *getFile(); //Kataev 15.07.2013 - int getfileNumber(); - SgAttribute *copy(); - SgAttribute *getNext(); - void setNext(SgAttribute *s); - int listLenght(); - SgAttribute *getInlist(int num); - void save(FILE *file); - void save(FILE *file, void (*savefunction)(void *dat,FILE *f)); - -}; - - - -/////////////////////////////////////////////////////////////////////////////////////// -// The ATTRIBUTE TYPE ALREADY USED -/////////////////////////////////////////////////////////////////////////////////////// - -#define DEPENDENCE_ATTRIBUTE -1001 -#define INDUCTION_ATTRIBUTE -1002 -#define ACCESS_ATTRIBUTE -1003 -#define DEPGRAPH_ATTRIBUTE -1004 -#define USEDLIST_ATTRIBUTE -1005 -#define DEFINEDLIST_ATTRIBUTE -1006 - -#define NOGARBAGE_ATTRIBUTE -1007 -#define GARBAGE_ATTRIBUTE -1008 - -// store the annotation expression; it is then visible from the -// garbage collection -#define ANNOTATION_EXPR_ATTRIBUTE -1009 - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/baseClasses.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/baseClasses.h deleted file mode 100644 index 0201354..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/baseClasses.h +++ /dev/null @@ -1,124 +0,0 @@ -// ---------------------------------- -// Darryl Brown -// University of Oregon pC++/Sage++ -// -// baseClasses.h - module for basic classes used by -// breakpoint modules. -// -// -// ---------------------------------- - -//if already included, skip this file... -#ifdef BASE_CL_ALREADY_INCLUDED -// do nothing; -#else -#define BASE_CL_ALREADY_INCLUDED 1 - - -// -------------------------------------------------------------; -// this class is the base pointer type of all elements ; -// stored in linked lists; -class brk_basePtr { - public: - - virtual void print(); - // this function should be overridden by later classes.; - virtual void print(int); - // this function should be overridden by later classes.; - virtual void printToBuf(int, char *); - // this function should be overridden by later classes.; - virtual void print(int t, FILE *fptr); - // this function should be overridden by later classes.; - virtual void printAll(); - // this function should be overridden by later classes.; - virtual void printAll(int); - // this function should be overridden by later classes.; -#if 0 - virtual void printAll(int, FILE *); - // this function should be overridden by later classes.; - virtual void printAll(FILE *); - // this function should be overridden by later classes.; -#endif - int (* userCompare)(brk_basePtr *, brk_basePtr *); - // this function should be overridden by later classes.; - virtual int compare(brk_basePtr *); - // this function should be overridden by later classes.; - brk_basePtr(); -}; - - -// ------------------------------------------------------------- -// the nodes of the linked lists kept for children and parents of each class; -class brk_ptrNode : public brk_basePtr { - public: - brk_ptrNode *next; // next node; - brk_ptrNode *prev; // previous node; - brk_basePtr *node; // the ptr to the hierarchy at this node; - - // constructors; - brk_ptrNode (void); - brk_ptrNode (brk_basePtr *h); - virtual int compare(brk_basePtr *); - // compares this heirarchy with another alphabetically using className; - -}; - -// ------------------------------------------------------------- -// the class implementing the linked list for -class brk_linkedList : public brk_basePtr { - - public: - - brk_ptrNode *end; // end of list; - brk_ptrNode *start; // start of list; - brk_ptrNode *current; // pointer to current element in list, - // used for traversal of list.; - int length; // length of list; - - // constructor; - brk_linkedList(); - - // access functions; - void push (brk_basePtr *h); // push hierarchy h onto front of list; - void pushLast (brk_basePtr *h); // push hierarchy h onto back of list; - brk_basePtr *pop (); // remove and return the first element in list; - brk_basePtr *popLast (); // remove and return the last element in list; - brk_basePtr *searchList (); // begin traversal of list; - brk_basePtr *nextItem(); // give the next item in list during traversal; - brk_basePtr *remove (int i); // remove & return the i-th element of list; - brk_basePtr *getIth (int i); // return the i-th element of list; - brk_basePtr *insert(int i, brk_basePtr * p); - // insert *p at point i in list; - brk_ptrNode *findMember (brk_basePtr *); // look for this element and - // return the brk_ptrNode that points to it; - int memberNum(brk_ptrNode *); // what order does this element fall in list; - - virtual void print(int); // print all elements; - virtual void print(int, FILE *ftpr); // print all elements; - virtual void print(); // print all elements; - virtual void printIth(int i); // print i-th element of list; - virtual void printToBuf(int, char *); - // this function should be overridden by later classes.; - void sort (); // sorts the list, elements must have compare function.,; - void sort(int (* compareFunc) (brk_basePtr *, brk_basePtr *)); - virtual void swap(brk_ptrNode *l, brk_ptrNode *r); - // swaps these two basic elements -}; - - -// --------------------------------------------------- -// external declarations. -// --------------------------------------------------- - -extern char * brk_stringSave(char * str); -extern int brk_strsame(char * str, char * str1); -extern void brk_printtabs(int tabs); -extern void brk_printtabs(int tabs, FILE *fptr); -// here is the endif - -#endif - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/bif_node.def b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/bif_node.def deleted file mode 100644 index bf4065f..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/bif_node.def +++ /dev/null @@ -1,594 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* format description - '_' stands for no. - 'e' stands for control end statement - 'd' declaration statement // what is not executable - DEFNODECODE(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) - f1 : variant of the node - f2 : string that gives the name (not used yet) - f3 : kind of node (stmt, declaration); not used yet - f4 : number of child (2 if blob list2, 1 if cp, 0 if leaf) - f5 : type of the node BIFNODE... - -------- particular info --------------- - f6 : is a declaration node 'd' or executable 'e' ,'c' controlend - f7 : is a declarator node if bif node 's' (for structure, union , enum) - for low lewe node c indicate constant expression - f8 : has a symbol associated 's' valid for bif and llnode - f9 : is a control parent 'p' or a control end 'c' - f10: not used yet -*/ - -DEFNODECODE(GLOBAL,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PROG_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PROC_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PROS_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(BASIC_BLOCK,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(CONTROL_END,"nodetext",'s',0,BIFNODE, 'c','_','_','_','_') -DEFNODECODE(IF_NODE,"nodetext",'s',2,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(WHERE_BLOCK_STMT,"nodetext",'s',2,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(ARITHIF_NODE,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(LOGIF_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(FORALL_STAT,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(LOOP_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(FOR_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(PROCESS_DO_STAT,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(TRY_STAT,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(CATCH_STAT,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(FORALL_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(WHILE_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(CDOALL_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SDOALL_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(DOACROSS_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(CDOACROSS_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(EXIT_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(GOTO_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ASSGOTO_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(COMGOTO_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PAUSE_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(STOP_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - -DEFNODECODE(ALLOCATE_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(DEALLOCATE_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(NULLIFY_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(POINTER_ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(M_ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - -DEFNODECODE(PROC_STAT,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PROS_STAT,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PROS_STAT_LCTN,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PROS_STAT_SUBM,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ASSLAB_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SUM_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(MULT_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(MAX_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(MIN_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(CAT_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(OR_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(AND_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - -DEFNODECODE(READ_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(WRITE_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(OTHERIO_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - -DEFNODECODE(BLOB,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SIZES,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - - -DEFNODECODE(FUNC_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(MODULE_STMT,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(USE_STMT,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(WHERE_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ALLDO_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(IDENTIFY,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(FORMAT_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(STOP_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(RETURN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ELSEIF_NODE,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ELSEWH_NODE,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') -DEFNODECODE(INCLUDE_LINE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PREPROCESSOR_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - -/*NO_OPnodes*/ -DEFNODECODE(COMMENT_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(CONT_STAT,"nodetext",'s',0,BIFNODE, 'c','_','_','_','_') -DEFNODECODE(VAR_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(VAR_DECL_90,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PARAM_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(COMM_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(EQUI_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(IMPL_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(DATA_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(SAVE_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(ENTRY_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(STMTFN_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(DIM_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PROCESSORS_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(BLOCK_DATA,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(EXTERN_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(INTRIN_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') - -DEFNODECODE(ENUM_DECL,"nodetext",'d',1,BIFNODE, 'd','e','_','_','_') -DEFNODECODE(CLASS_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') -DEFNODECODE(TECLASS_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') -DEFNODECODE(COLLECTION_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') -DEFNODECODE(TEMPLATE_FUNDECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') -DEFNODECODE(TEMPLATE_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') -DEFNODECODE(UNION_DECL,"nodetext",'d',1,BIFNODE, 'd','u','_','_','_') -DEFNODECODE(STRUCT_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') -DEFNODECODE(DERIVED_CLASS_DECL,"nodetext",'d',1,BIFNODE,'d','_','_','_','_') -DEFNODECODE(EXPR_STMT_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(DO_WHILE_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SWITCH_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(CASE_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(DEFAULT_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(BREAK_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(CONTINUE_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(RETURN_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ASM_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SPAWN_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PARFOR_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PAR_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(LABEL_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PROS_COMM,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(ATTR_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(NAMELIST_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') - -DEFNODECODE(PROCESSES_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(PROCESSES_END,"nodetext",'s',0,BIFNODE, 'c','_','_','_','_') -DEFNODECODE(INPORT_DECL,"nodetext",'d',2,BIFNODE, 'd','-','_','_','_') -DEFNODECODE(OUTPORT_DECL,"nodetext",'d',2,BIFNODE, 'd','-','_','_','_') -DEFNODECODE(CHANNEL_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(MERGER_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(MOVE_PORT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(SEND_STAT,"nodetext",'s',2,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(RECEIVE_STAT,"nodetext",'s',2,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(ENDCHANNEL_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(PROBE_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') -DEFNODECODE(INTENT_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PRIVATE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(PUBLIC_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(OPTIONAL_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(ALLOCATABLE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(POINTER_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(TARGET_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(STATIC_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(MODULE_PROC_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(INTERFACE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(INTERFACE_OPERATOR,"nodetext",'s',0,BIFNODE,'d','_','_','_','_') -DEFNODECODE(INTERFACE_ASSIGNMENT,"nodetext",'s',0,BIFNODE,'d','_','_','_','_') -DEFNODECODE(SEQUENCE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') - -/*****************variant tags for low level nodes********************/ - -DEFNODECODE(INT_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(FLOAT_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(DOUBLE_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(BOOL_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(CHAR_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(STRING_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(KEYWORD_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') -DEFNODECODE(COMPLEX_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') - -DEFNODECODE(CONST_REF,"nodetext",'r',0,LLNODE, '_','_','s','_','_') -DEFNODECODE(VAR_REF,"nodetext",'r',0,LLNODE, '_','_','s','_','_') -DEFNODECODE(ARRAY_REF,"nodetext",'r',1,LLNODE, '_','_','s','_','_') -DEFNODECODE(PROCESSORS_REF,"nodetext",'r',1,LLNODE, '_','_','s','_','_') -DEFNODECODE(RECORD_REF,"nodetext",'r',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(STRUCTURE_CONSTRUCTOR,"nodetext",'r',1,LLNODE, '_','_','s','_','_') -DEFNODECODE(CONSTRUCTOR_REF,"nodetext",'r',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ENUM_REF,"nodetext",'r',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LABEL_REF,"nodetext",'r',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(PORT_TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(INPORT_TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(OUTPORT_TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(TYPE_REF,"nodetext",'e',0,LLNODE, '_','_','s','_','_') - -DEFNODECODE(VAR_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EXPR_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RANGE_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CASE_CHOICE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DEF_CHOICE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(VARIANT_CHOICE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(DDOT,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(KEYWORD_ARG,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RANGE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FORALL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(UPPER_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LOWER_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EQ_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(GT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(NOTEQL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LTEQL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(GTEQL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(ADD_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SUBT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(OR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(MULT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DIV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MOD_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(AND_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(EXP_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ARRAY_MULT,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CONCAT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(XOR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EQV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(NEQV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MINUS_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(NOT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DEREF_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(RENAME_NODE,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ONLY_NODE,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(POINTST_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FUNCTION_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MINUSMINUS_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(PLUSPLUS_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BITAND_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BITOR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DIMENSION_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ALLOCATABLE_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(PARAMETER_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(TARGET_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(STATIC_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SAVE_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(POINTER_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(INTRINSIC_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OPTIONAL_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(EXTERNAL_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(PRIVATE_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(PUBLIC_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(IN_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OUT_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(INOUT_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(LABEL_ARG,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(STAR_RANGE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(PROC_CALL,"nodetext",'e',2,LLNODE, '_','_','s','_','_') -DEFNODECODE(PROS_CALL,"nodetext",'e',2,LLNODE, '_','_','s','_','_') -DEFNODECODE(FUNC_CALL,"nodetext",'e',1,LLNODE, '_','_','s','_','_') -DEFNODECODE(OVERLOADED_CALL,"nodetext",'e',1,LLNODE, '_','_','s','_','_') -DEFNODECODE(THROW_OP,"nodetext",'e',1,LLNODE, '_','_','s','_','_') -DEFNODECODE(DEFINED_OP,"nodetext",'e',2,LLNODE, '_','_','s','_','_') - -DEFNODECODE(ACCESS_REF,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CONS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACCESS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(IOACCESS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CONTROL_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SEQ,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPEC_PAIR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(COMM_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(STMT_STR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EQUI_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(IMPL_TYPE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(STMTFN_DECL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIT_COMPLEMENT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EXPR_IF,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EXPR_IF_BODY,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FUNCTION_REF,"nodetext",'e',2,LLNODE, '_','_','s','_','_') -DEFNODECODE(LSHIFT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RSHIFT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(UNARY_ADD_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SIZE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(INTEGER_DIV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SUB_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(GE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(NE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(CLASSINIT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CAST_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ADDRESS_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(POINSTAT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(COPY_NODE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(INIT_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(VECTOR_CONST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIT_NUMBER,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ARITH_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ARRAY_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(NEW_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DELETE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(NAMELIST_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(INPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(OUTPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(FROMPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(TOPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(IOSTAT_STORE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(EMPTY_STORE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(ERR_LABEL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(END_LABEL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') - -DEFNODECODE(DATA_IMPL_DO,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DATA_ELT,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DATA_SUBS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DATA_RANGE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ICON_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -/* new tag for some expression */ - -DEFNODECODE(CEIL_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MAX_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIF_SAVE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MIN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIF_ADDR_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIF_NOP_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIF_RTL_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUNC_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUNC_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FLOOR_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FLOOR_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CEIL_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ROUND_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ROUND_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RDIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(EXACT_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(CONVERT_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(CONST_DECL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ABS_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUTH_ANDIF_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUTH_AND_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUTH_NOT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUTH_ORIF_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(PREINCREMENT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(PREDECREMENT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(COMPOUND_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FLOAT_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIT_IOR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIT_XOR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(BIT_ANDTC_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(TRUTH_OR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FIX_TRUNC_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(RROTATE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LROTATE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RANGE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(POSTDECREMENT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(REFERENCE_TYPE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FIX_FLOOR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FIX_ROUND_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FIX_CEIL_EXPR ,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FUNCTION_DECL ,"nodetext",'d',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MODIFY_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(REFERENCE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RESULT_DECL,"nodetext",'d',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(PARM_DECL,"nodetext",'d',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LEN_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(THIS_NODE,"nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SCOPE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(PLUS_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MINUS_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(AND_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(IOR_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MULT_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DIV_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(MOD_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(XOR_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(LSHIFT_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(RSHIFT_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(ARROWSTAR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DOTSTAR_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(FORDECL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(OPERATOR_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ASSIGNMENT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(KIND_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(LENGTH_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(RECURSIVE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ELEMENTAL_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(PURE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') - -/* DVM tags */ -DEFNODECODE(BLOCK_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(INDIRECT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(DERIVED_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(NEW_SPEC_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(REDUCTION_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SHADOW_RENEW_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SHADOW_START_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SHADOW_WAIT_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(DIAG_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(REMOTE_ACCESS_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(TEMPLATE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(PROCESSORS_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(DYNAMIC_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ALIGN_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(DISTRIBUTE_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SHADOW_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SHADOW_COMP_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(INDIRECT_ACCESS_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACROSS_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(NEW_VALUE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(CONSISTENT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(STAGE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(COMMON_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_CALL_OP,"nodetext",'e',2,LLNODE, '_','_','s','_','_') -DEFNODECODE(ACC_DEVICE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_SHARED_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_CONSTANT_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_VALUE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_HOST_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_GLOBAL_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_ATTRIBUTES_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_PRIVATE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_CUDA_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_CUDA_BLOCK_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_PRIVATE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_INOUT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_IN_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_OUT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_LOCAL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_INLOCAL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_TARGETS_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_ASYNC_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SHADOW_NAMES_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(ACC_TIE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(DUMMY_REF, "nodetext",'r',0,LLNODE, '_','_','s','_','_') - -DEFNODECODE(ACC_CALL_STMT,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') -DEFNODECODE(DVM_NEW_VALUE_DIR,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ACC_ROUTINE_DIR,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') -DEFNODECODE(ACC_DECLARE_DIR,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') - -/* SAPFOR */ -DEFNODECODE(SPF_NOINLINE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_FISSION_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_EXPAND_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_SHRINK_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_TYPE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_VARLIST_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_EXCEPT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_FILES_COUNT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_INTERVAL_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_TIME_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_ITER_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_FLEXIBLE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_PARAMETER_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_CODE_COVERAGE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_UNROLL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_COVER_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_MERGE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_PROCESS_PRIVATE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') -DEFNODECODE(SPF_WEIGHT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') - -DEFNODECODE(SPF_ANALYSIS_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SPF_PARALLEL_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SPF_TRANSFORM_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SPF_PARALLEL_REG_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SPF_END_PARALLEL_REG_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(SPF_CHECKPOINT_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') - -/* OpenMP Fortran tags */ -DEFNODECODE(OMP_NOWAIT, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_NUM_THREADS, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_IF, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_ORDERED, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_DEFAULT, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_SCHEDULE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_PRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_REDUCTION, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_FIRSTPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_LASTPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_SHARED, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_COPYIN, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_COPYPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_COLLAPSE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') -DEFNODECODE(OMP_THREADPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') - -DEFNODECODE(OMP_PARALLEL_DIR,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_PARALLEL_DIR,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_SECTION_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_SINGLE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_SINGLE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_PARALLEL_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_PARALLEL_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_PARALLEL_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_PARALLEL_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_PARALLEL_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_PARALLEL_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_MASTER_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_MASTER_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_CRITICAL_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_CRITICAL_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_BARRIER_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_ATOMIC_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_FLUSH_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_ORDERED_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_END_ORDERED_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') -DEFNODECODE(OMP_THREADPRIVATE_DIR, "nodetext",'d',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(RECORD_DECL,"nodetext",'d',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(FUNC_STAT,"nodetext",'d',0,BIFNODE, 'd','_','_','_','_') -DEFNODECODE(POINTER_ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(CYCLE_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') -DEFNODECODE(OMP_ONETHREAD_DIR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') -/*****************variant tags for symbol table entries********************/ - -DEFNODECODE(BIF_PARM_DECL,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(CONST_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(ENUM_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(FIELD_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(VARIABLE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(TYPE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(PROGRAM_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(PROCEDURE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(PROCESS_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(VAR_FIELD,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(LABEL_VAR,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(FUNCTION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(MEMBER_FUNC,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(CLASS_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(TECLASS_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(UNION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(STRUCT_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(LABEL_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(COLLECTION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(ROUTINE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(CONSTRUCT_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(INTERFACE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(MODULE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(COMMON_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') -DEFNODECODE(SPF_REGION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') - -DEFNODECODE(DEFAULT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_INT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_FLOAT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DOUBLE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_CHAR,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_BOOL,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_STRING,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_COMPLEX,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DCOMPLEX,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_LONG,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') - -DEFNODECODE(T_ENUM,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_SUBRANGE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_LIST,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_ARRAY,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_RECORD,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_ENUM_FIELD,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_UNKNOWN,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_VOID,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DESCRIPT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_FUNCTION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_POINTER,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_UNION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_STRUCT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_CLASS,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_TECLASS,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DERIVED_CLASS,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DERIVED_TYPE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_COLLECTION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DERIVED_COLLECTION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_MEMBER_POINTER,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_GATE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_EVENT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_SEQUENCE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_DERIVED_TEMPLATE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(T_REFERENCE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') - -DEFNODECODE(LOCAL,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(INPUT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(OUTPUT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') -DEFNODECODE(IO,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/dependence.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/dependence.h deleted file mode 100644 index f80b60c..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/dependence.h +++ /dev/null @@ -1,117 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - -/* declaration for the dependencies computation and use in the toolbox */ - -/* on declare de macro d'acces aux dependence de donnee */ - -#define BIF_DEP_STRUCT1(NODE) ((NODE)->entry.Template.dep_ptr1) -#define BIF_DEP_STRUCT2(NODE) ((NODE)->entry.Template.dep_ptr2) - -#define FIRST_DEP_IN_PROJ(X) ((X)->head_dep) -/* decription d'une dependance */ - -#define DEP_ID(DEP) ((DEP)->id) -#define DEP_NEXT(DEP) ((DEP)->thread) -#define DEP_TYPE(DEP) ((DEP)->type) -#define DEP_DIRECTION(DEP) ((DEP)->direct) -#define DEP_SYMB(DEP) ((DEP)->symbol) -#define DEP_FROM_BIF(DEP) (((DEP)->from).stmt) -#define DEP_FROM_LL(DEP) (((DEP)->from).refer) -#define DEP_TO_BIF(DEP) (((DEP)->to).stmt) -#define DEP_TO_LL(DEP) (((DEP)->to).refer) -#define DEP_FROM_FWD(DEP) ((DEP)->from_fwd) -#define DEP_FROM_BACK(DEP) ((DEP)->from_back) -#define DEP_TO_FWD(DEP) ((DEP)->to_fwd) -#define DEP_TO_BACK(DEP) ((DEP)->to_back) - - -/* la forme normale de dependence de donnee est le vecteur de direction */ - -/* on rappel temporairement la forme des dep (sets.h) -struct dep { data dependencies - - int id; identification for reading/writing - PTR_DEP thread; - - char type; flow-, output-, or anti-dependence - char direct[MAX_DEP]; direction/distance vector - - PTR_SYMB symbol; symbol table entry - struct ref from; tail of dependence - struct ref to; head of dependence - - PTR_DEP from_fwd, from_back; list of dependencies going to tail - PTR_DEP to_fwd, to_back; list of dependencies going to head - - } ; - -*/ - - - -/* pour la gestion memoire */ -struct chaining -{ - char *zone; - struct chaining *list; -}; - -typedef struct chaining *ptchaining; - - -struct stack_chaining -{ - ptchaining first; - ptchaining last; - struct stack_chaining *prev; - struct stack_chaining *next; - int level; -}; - -typedef struct stack_chaining *ptstack_chaining; - -/* structure pour les graphes de dependence */ -#define MAXSUC 100 - -struct graph -{ - int id; /* identificateur */ - int linenum; - int mark; - int order; - PTR_BFND stmt; - PTR_LLND expr; - PTR_LLND from_expr[MAXSUC]; - PTR_LLND to_expr[MAXSUC]; - PTR_DEP dep_struct[MAXSUC]; - char *dep_vect[MAXSUC]; - char type[MAXSUC]; - struct graph *suc[MAXSUC]; /* next */ - struct graph *pred[MAXSUC]; /* next */ - struct graph *list; /* chaine les noeuds d'un graphe */ -}; - -typedef struct graph *PTR_GRAPH; - -#define CHAIN_LIST(NODE) ((NODE)->list) -#define GRAPH_ID(NODE) ((NODE)->id) -#define GRAPH_ORDER(NODE) ((NODE)->order) -#define GRAPH_MARK(NODE) ((NODE)->mark) -#define GRAPH_LINE(NODE) ((NODE)->linenum) -#define GRAPH_BIF(NODE) ((NODE)->stmt) -#define GRAPH_LL(NODE) ((NODE)->expr) -#define GRAPH_DEP(NODE) (((NODE)->dep_struct)) -#define GRAPH_VECT(NODE) (((NODE)->dep_vect)) -#define GRAPH_TYPE(NODE) ((NODE)->type) -#define GRAPH_SUC(NODE) (((NODE)->suc)) -#define GRAPH_PRED(NODE) (((NODE)->pred)) -#define GRAPH_LL_FROM(NODE) (((NODE)->from_expr)) -#define GRAPH_LL_TO(NODE) (((NODE)->to_expr)) - - -#define NOT_ORDERED -1 diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_ann.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_ann.h deleted file mode 100644 index 54ad539..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_ann.h +++ /dev/null @@ -1,56 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -extern char *Unparse_Annotation(); -extern PTR_LLND Parse_Annotation(); -extern Is_Annotation(); -extern Is_Annotation_Cont(); -extern char * Get_Annotation_String(); -extern char * Get_to_Next_Annotation_String(); -extern Init_Annotation(); -extern PTR_LLND Get_Define_Field(); -extern char * Get_Define_Label_Field(); -extern char * Get_Label_Field(); -extern PTR_LLND Get_ApplyTo_Field(); -extern PTR_LLND Get_ApplyToIf_Field(); -extern PTR_LLND Get_LocalVar_Field(); -extern PTR_LLND Get_Annotation_Field(); -extern char * Get_Annotation_Field_Label(); -extern char * Does_Annotation_Defines(); -extern int Set_The_Define_Field(); -extern int Get_Annotation_With_Label(); -extern Get_Scope_Of_Annotation(); -extern Propagate_defined_value(); -extern PTR_LLND Does_Annotation_Apply(); -extern PTR_LLND Get_Annotation_Field_List_For_Stmt(); -extern PTR_LLND Get_Annotation_List_For_Stmt(); -extern Get_Number_of_Annotation(); -extern PTR_BFND Get_Annotation_Bif(); -extern PTR_LLND Get_Annotation_Expr(); -extern char * Get_String_of_Annotation(); -extern PTR_CMNT Get_Annotation_Comment(); -extern int Is_Annotation_Defined(); -extern char * Annotation_Defines_string(); -extern int Annotation_Defines_string_Value(); -extern PTR_LLND Annotation_LLND[]; -extern PTR_TYPE global_int_annotation; - - - - - - - - - - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_high.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_high.h deleted file mode 100644 index ebb4cf0..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_high.h +++ /dev/null @@ -1,29 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -extern int tiling_p ();/*non implante, mais ne plante pas*/ -extern void tiling (); -extern void strip_mining (); - -extern PTR_BLOB Distribute_Loop (); -extern PTR_BLOB Distribute_Loop_SCC (); -extern Loop_Fusion (); -extern Unroll_Loop (); -extern Interchange_Loops (); - -extern Compute_With_Maple (); -extern Unimodular (); - -extern Expand_Scalar (); -extern PTR_BFND Scalar_Forward_Substitution (); - -extern int Normalized (); -extern Normalize_Loop (); - -extern int Vectorize (); -extern int Vectorize_Nest (); - -extern Print_Property_For_Loop (); diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_lib.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_lib.h deleted file mode 100644 index a87a5ea..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_lib.h +++ /dev/null @@ -1,24 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - -extern PTR_FILE cur_file; -extern char *main_input_filename; /*not find in lib*/ -extern PTR_PROJ cur_proj; /* pointer to the project header */ -extern char *cunparse_bfnd(); -extern char *cunparse_llnd(); -extern char *funparse_bfnd(); -extern char *funparse_llnd(); -extern char *cunparse_blck(); -extern char *funparse_blck(); -extern PTR_SYMB Current_Proc_Graph_Symb; /*not find in lib*/ - -/*extern FILE *finput; -extern FILE *outfile;*/ - -extern char node_code_type[]; -extern int node_code_length[]; -extern enum typenode node_code_kind[]; diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_low.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_low.h deleted file mode 100644 index 73a474b..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_low.h +++ /dev/null @@ -1,269 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* DO NOT EDIT THIS FILE! */ -/* This file was automatically created by /u/sage/bin/mkCextern */ -/* Source file: /u/sage/project/sage/lib/newsrc/low_level.c */ -/* Created on Mon Jul 11 13:40:50 EST 1994 (phb) */ -extern POINTER newNode(); -extern PTR_BFND FindNearBifNode(); -extern PTR_BFND Get_Last_Node_Of_Project(); -extern PTR_BFND Get_bif_with_id(); -extern PTR_BFND GetcountInStmtNode1(); -extern PTR_BFND LibGetScopeForDeclare(); -extern PTR_BFND LibWhereIsSymbDeclare(); -extern PTR_BFND LibcreateCollectionWithType(); -extern PTR_BFND LibdeleteStmt(); -extern PTR_BFND LibextractStmt(); -extern PTR_BFND LibextractStmtBody(); -extern PTR_BFND LibfirstElementMethod(); -extern PTR_BFND LibgetInnermostLoop(); -extern PTR_BFND LibgetNextNestedLoop(); -extern PTR_BFND LibgetPreviousNestedLoop(); -extern PTR_BFND LiblastDeclaration(); -extern PTR_BFND LocalRedoBifNextChain(); -extern PTR_BFND Redo_Bif_Next_Chain_Internal(); -extern PTR_BFND childfInBlobList(); -extern PTR_BFND computeControlParent(); -extern PTR_BFND deleteBfnd(); -extern PTR_BFND deleteBfndFromBlobAndLabel(); -extern PTR_BFND duplicateOneStmt(); -extern PTR_BFND duplicateStmts(); -extern PTR_BFND duplicateStmtsBlock(); -extern PTR_BFND duplicateStmtsNoExtract(); -extern PTR_BFND extractBifSectionBetween(); -extern PTR_BFND getBodyOfSymb(); -extern PTR_BFND getFirstStmt(); -extern PTR_BFND getFuncScope(); -extern PTR_BFND getFunctionHeader(); -extern PTR_BFND getFunctionHeaderAllFile(); -extern PTR_BFND getFunctionNumHeader(); -extern PTR_BFND getGlobalFunctionHeader(); -extern PTR_BFND getLastNodeList(); -extern PTR_BFND getLastNodeOfStmt(); -extern PTR_BFND getLastNodeOfStmtNoControlEnd(); -extern PTR_BFND getMainProgram(); -extern PTR_BFND getNodeBefore(); -extern PTR_BFND getObjectStmt(); -extern PTR_BFND getScopeForLabel(); -extern PTR_BFND getStatementNumber(); -extern PTR_BFND getStructNumHeader(); -extern PTR_BFND getWhereToInsertInBfnd(); -extern PTR_BFND lastBifInBlobList(); -extern PTR_BFND lastBifInBlobList1(); -extern PTR_BFND lastBifInBlobList2(); -extern PTR_BFND makeDeclStmt(); -extern PTR_BFND makeDeclStmtWPar(); -extern PTR_BFND rec_num_near_search(); -extern PTR_BLOB appendBlob(); -extern PTR_BLOB deleteBfndFrom(); -extern PTR_BLOB getLabelUDChain(); -extern PTR_BLOB lastBlobInBlobList(); -extern PTR_BLOB lastBlobInBlobList1(); -extern PTR_BLOB lastBlobInBlobList2(); -extern PTR_BLOB lookForBifInBlobList(); -extern PTR_CMNT Get_cmnt_with_id(); -extern PTR_FILE GetFileWithNum(); -extern PTR_FILE GetPointerOnFile(); -extern PTR_LABEL Get_label_with_id(); -extern PTR_LABEL getLastLabel(); -extern PTR_LLND Follow_Llnd(); -extern PTR_LLND Follow_Llnd0(); -extern PTR_LLND Get_First_Parameter_For_Call(); -extern PTR_LLND Get_Second_Parameter_For_Call(); -extern PTR_LLND Get_Th_Parameter_For_Call(); -extern PTR_LLND Get_ll_with_id(); -extern PTR_LLND LibIsSymbolInExpression(); -extern PTR_LLND LibarrayRefs(); -extern PTR_LLND LibsymbRefs(); -extern PTR_LLND Make_Function_Call(); -extern PTR_LLND addLabelRefToExprList(); -extern PTR_LLND addSymbRefToExprList(); -extern PTR_LLND addToExprList(); -extern PTR_LLND addToList(); -extern PTR_LLND copyLlNode(); -extern PTR_LLND deleteNodeInExprList(); -extern PTR_LLND deleteNodeWithItemInExprList(); -extern PTR_LLND findPtrRefExp(); -extern PTR_LLND getPositionInExprList(); -extern PTR_LLND getPositionInList(); -extern PTR_LLND giveLlSymbInDeclList(); -extern PTR_LLND makeDeclExp(); -extern PTR_LLND makeDeclExpWPar(); -extern PTR_LLND makeInt(); -extern PTR_LLND newExpr(); -extern PTR_SYMB GetThOfFieldList(); -extern PTR_SYMB GetThOfFieldListForType(); -extern PTR_SYMB GetThParam(); -extern PTR_SYMB Get_Symb_with_id(); -extern PTR_SYMB doesClassInherit(); -extern PTR_SYMB duplicateParamList(); -extern PTR_SYMB duplicateSymbol(); -extern PTR_SYMB duplicateSymbolAcrossFiles(); -extern PTR_SYMB duplicateSymbolLevel1(); -extern PTR_SYMB duplicateSymbolLevel2(); -extern PTR_SYMB getClassNextFieldOrMember(); -extern PTR_SYMB getFieldOfStructWithName(); -extern PTR_SYMB getFirstFieldOfStruct(); -extern PTR_SYMB getSymbolWithName(); -extern PTR_SYMB getSymbolWithNameInScope(); -extern PTR_SYMB lookForNameInParamList(); -extern PTR_SYMB newSymbol(); -extern PTR_TYPE FollowTypeBaseAndDerived(); -extern PTR_TYPE GetAtomicType(); -extern PTR_TYPE Get_type_with_id(); -extern PTR_TYPE addToBaseTypeList(); -extern PTR_TYPE createDerivedCollectionType(); -extern PTR_TYPE duplicateType(); -extern PTR_TYPE duplicateTypeAcrossFiles(); -extern PTR_TYPE getDerivedTypeWithName(); -extern PTR_TYPE lookForInternalBasetype(); -extern PTR_TYPE lookForTypeDescript(); -extern char *allocateFreeListNodeExpression(); -extern char* Get_Function_Name_For_Call(); -extern char* Remove_Carriage_Return(); -extern char* UnparseTypeBuffer(); -extern char* filter(); -extern char* mymalloc(); -extern char* xmalloc(); -extern int Apply_To_Bif(); -extern int Check_Lang_C(); -extern int Check_Lang_Fortran(); -extern int GetFileNum(); -extern int GetFileNumWithPt(); -extern int Init_Tool_Box(); -extern int IsRefToSymb(); -extern int Is_String_Val_With_Val(); -extern int LibClanguage(); -extern int LibFortranlanguage(); -extern int LibIsSymbolInScope(); -extern int LibIsSymbolReferenced(); -extern int LibisEnddoLoop(); -extern int LibisMethodOfElement(); -extern int LibnumberOfFiles(); -extern int LibperfectlyNested(); -extern void Message(); -extern int Replace_String_In_Expression(); -extern int appendBfndListToList1(); -extern int appendBfndListToList2(); -extern int appendBfndToList(); -extern int appendBfndToList1(); -extern int appendBfndToList2(); -extern int arraySymbol(); -extern int blobListLength(); -extern int buildLinearRep(); -extern int buildLinearRepSign(); -extern int convertToEnddoLoop(); -extern int countInStmtNode1(); -extern int countInStmtNode2(); -extern int exprListLength(); -extern int findBif(); -extern int findBifInList1(); -extern int findBifInList2(); -extern int firstBfndInList1(); -extern int firstBfndInList2(); -extern int firstInBfndList2(); -extern int getElementEvaluate(); -extern int getLastLabelId(); -extern int getNumberOfFunction(); -extern int getNumberOfStruct(); -extern int getTypeNumDimension(); -extern int hasNodeASymb(); -extern int hasTypeBaseType(); -extern int hasTypeSymbol(); -extern int inScope(); -extern int insertBfndInList1(); -extern int insertBfndInList2(); -extern int insertBfndListIn(); -extern int insertBfndListInList1(); -extern int isABifNode(); -extern int isAControlEnd(); -extern int isADeclBif(); -extern int isAEnumDeclBif(); -extern int isALoNode(); -extern int isAStructDeclBif(); -extern int isASymbNode(); -extern int isATypeNode(); -extern int isAUnionDeclBif(); -extern int isAtomicType(); -extern int isElementType(); -extern int isEnumType(); -extern int isInStmt(); -extern int isIntegerType(); -extern int isItInSection(); -extern int isNodeAConst(); -extern int isPointerType(); -extern int isStructType(); -extern int isTypeEquivalent(); -extern int isUnionType(); -extern int lenghtOfFieldList(); -extern int lenghtOfFieldListForType(); -extern int lenghtOfParamList(); -extern int localToFunction(); -extern int lookForTypeInType(); -extern int makeLinearExpr(); -extern int makeLinearExpr_Sign(); -extern int numberOfBifsInBlobList(); -extern int open_proj_toolbox(); -extern int open_proj_files_toolbox(); -extern int patternMatchExpression(); -extern int pointerType(); -extern int replaceTypeInType(); -extern int sameName(); -extern int* evaluateExpression(); -extern void Count_Bif_Next_Chain(); -extern void LibAddComment(); -extern void LibSetAllComments(); -extern void LibconvertLogicIf(); -extern void LibreplaceSymbByExp(); -extern void LibreplaceSymbByExpInStmts(); -extern void LibreplaceWithStmt(); -extern void LibsaveDepFile(); -extern void Redo_Bif_Next_Chain(); -extern void Reset_Bif_Next(); -extern void Reset_Bif_Next_Chain(); -extern void Reset_Tool_Box(); -extern void SetCurrentFileTo(); -extern void UnparseBif(); -extern void UnparseLLND(); -extern void UnparseProgram(); -extern void addControlEndToList2(); -extern void addControlEndToStmt(); -extern void addElementEvaluate(); -extern void addSymbToFieldList(); -extern void allocateValueEvaluate(); -extern void appendSymbToArgList(); -extern void declareAVar(); -extern void declareAVarWPar(); -extern void duplicateAllSymbolDeclaredInStmt(); -extern void insertBfndBeforeIn(); -extern void insertSymbInArgList(); -extern void libFreeExpression(); -extern void make_a_malloc_stack(); -extern void myfree(); -extern void replaceSymbInExpression(); -extern void replaceSymbInExpressionSameName(); -extern void replaceSymbInStmts(); -extern void replaceSymbInStmtsSameName(); -extern void replaceTypeForSymb(); -extern void replaceTypeInExpression(); -extern void replaceTypeInStmts(); -extern void replaceTypeUsedInStmt(); -extern void resetDoVarForSymb(); -extern void resetFreeListForExpressionNode(); -extern void resetPresetEvaluate(); -extern void setFreeListForExpressionNode(); -extern void updateControlParent(); -extern void updateTypesAndSymbolsInBody(); -extern void writeDepFileInDebugdep(); -extern void updateTypeAndSymbolInStmts(); -extern void updateTypesAndSymbolsInBodyOfRoutine(); -extern PTR_SYMB duplicateSymbolOfRoutine(); -extern char* UnparseBif_Char(); -char *UnparseLLnode_Char(); -extern void UnparseProgram_ThroughAllocBuffer(); - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_mid.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_mid.h deleted file mode 100644 index 3c15364..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/ext_mid.h +++ /dev/null @@ -1,64 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -extern PTR_BFND Make_For_Loop (); -extern PTR_LLND Loop_Set_Borne_Inf (); -extern PTR_LLND Loop_Set_Borne_Sup (); -extern PTR_LLND Loop_Set_Step (); -extern PTR_SYMB Loop_Set_Index (); -extern PTR_LLND Loop_Get_Borne_Inf (); -extern PTR_LLND Loop_Get_Borne_Sup (); -extern PTR_LLND Loop_Get_Step (); -extern PTR_SYMB Loop_Get_Index (); - -extern PTR_BFND Get_Scope_For_Declare (); -extern PTR_BFND Get_Scope_For_Label (); - -extern PTR_LLND Make_Array_Ref (); -extern PTR_LLND Make_Array_Ref_With_Tab (); -extern PTR_BFND Declare_Array (); - -extern PTR_BFND Make_Procedure (); -extern PTR_LLND Make_Function_Call (); -extern PTR_LLND Make_Function_Call_bis (); -extern PTR_BFND Make_Procedure_Call (); - -extern PTR_LLND Make_Linear_Expression (); -extern PTR_LLND Make_Linear_Expression_From_Int (); -extern PTR_LLND Make_Linear_Expression_From_Int_List (); - -extern PTR_BFND Make_Assign (); -extern PTR_BFND Make_If_Then_Else (); -extern int Declare_Scalar (); -extern int Perfectly_Nested (); -extern int Is_Good_Loop (); - -extern PTR_BFND Extract_Loop_Body (); -extern PTR_BFND Get_Next_Nested_Loop (); -extern PTR_BFND Get_Internal_Loop (); -extern PTR_BFND Get_Previous_Nested_Loop (); - -extern PTR_BLOB Get_Label_UD_chain (); - -extern int Convert_Loop (); -extern int Loop_Conversion (); - -extern PTR_SYMB Generate_Variable_Name (); -extern PTR_SYMB Install_Variable (); - -extern int Verif_No_Func (); -extern int Verif_Assign (); -extern int Verif_Assign_If (); - -extern int Generate_Alternative_Code (); -extern void Localize_Array_Section (); - -extern int Check_Index (); -extern int Check_Right_Assign (); -extern int Check_Left_Assign (); -extern int No_Dependent_Index (); -extern int No_Basic_Induction (); -extern int No_Def_Of_Induction (); diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/extcxx_low.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/extcxx_low.h deleted file mode 100644 index 9750dca..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/extcxx_low.h +++ /dev/null @@ -1,272 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* DO NOT EDIT THIS FILE! */ -/* This file was automatically created by /u/sage/bin/mkC++extern */ -/* Source file: /u/sage/project/sage/lib/newsrc/low_level.c */ -/* Created on Tue Jul 12 12:46:22 EST 1994 (phb) */ -extern "C" { - POINTER newNode(...); - PTR_BFND FindNearBifNode(...); - PTR_BFND Get_Last_Node_Of_Project(...); - PTR_BFND Get_bif_with_id(...); - PTR_BFND GetcountInStmtNode1(...); - PTR_BFND LibGetScopeForDeclare(...); - PTR_BFND LibWhereIsSymbDeclare(...); - PTR_BFND LibcreateCollectionWithType(...); - PTR_BFND LibdeleteStmt(...); - PTR_BFND LibextractStmt(...); - PTR_BFND LibextractStmtBody(...); - PTR_BFND LibfirstElementMethod(...); - PTR_BFND LibgetInnermostLoop(...); - PTR_BFND LibgetNextNestedLoop(...); - PTR_BFND LibgetPreviousNestedLoop(...); - PTR_BFND LiblastDeclaration(...); - PTR_BFND LocalRedoBifNextChain(...); - PTR_BFND Redo_Bif_Next_Chain_Internal(...); - PTR_BFND childfInBlobList(...); - PTR_BFND computeControlParent(...); - PTR_BFND deleteBfnd(...); - PTR_BFND deleteBfndFromBlobAndLabel(...); - PTR_BFND duplicateOneStmt(...); - PTR_BFND duplicateStmts(...); - PTR_BFND duplicateStmtsBlock(...); - PTR_BFND duplicateStmtsNoExtract(...); - PTR_BFND extractBifSectionBetween(...); - PTR_BFND getBodyOfSymb(...); - PTR_BFND getFirstStmt(...); - PTR_BFND getFuncScope(...); - PTR_BFND getFunctionHeader(...); - PTR_BFND getFunctionHeaderAllFile(...); - PTR_BFND getFunctionNumHeader(...); - PTR_BFND getGlobalFunctionHeader(...); - PTR_BFND getLastNodeList(...); - PTR_BFND getLastNodeOfStmt(...); - PTR_BFND getLastNodeOfStmtNoControlEnd(...); - PTR_BFND getMainProgram(...); - PTR_BFND getNodeBefore(...); - PTR_BFND getObjectStmt(...); - PTR_BFND getScopeForLabel(...); - PTR_BFND getStatementNumber(...); - PTR_BFND getStructNumHeader(...); - PTR_BFND getWhereToInsertInBfnd(...); - PTR_BFND lastBifInBlobList(...); - PTR_BFND lastBifInBlobList1(...); - PTR_BFND lastBifInBlobList2(...); - PTR_BFND makeDeclStmt(...); - PTR_BFND makeDeclStmtWPar(...); - PTR_BFND rec_num_near_search(...); - PTR_BLOB appendBlob(...); - PTR_BLOB deleteBfndFrom(...); - PTR_BLOB getLabelUDChain(...); - PTR_BLOB lastBlobInBlobList(...); - PTR_BLOB lastBlobInBlobList1(...); - PTR_BLOB lastBlobInBlobList2(...); - PTR_BLOB lookForBifInBlobList(...); - PTR_CMNT Get_cmnt_with_id(...); - PTR_FILE GetFileWithNum(...); - PTR_FILE GetPointerOnFile(...); - PTR_LABEL Get_label_with_id(...); - PTR_LABEL getLastLabel(...); - PTR_LLND Follow_Llnd(...); - PTR_LLND Follow_Llnd0(...); - PTR_LLND Get_First_Parameter_For_Call(...); - PTR_LLND Get_Second_Parameter_For_Call(...); - PTR_LLND Get_Th_Parameter_For_Call(...); - PTR_LLND Get_ll_with_id(...); - PTR_LLND LibIsSymbolInExpression(...); - PTR_LLND LibarrayRefs(...); - PTR_LLND LibsymbRefs(...); - PTR_LLND Make_Function_Call(...); - PTR_LLND addLabelRefToExprList(...); - PTR_LLND addSymbRefToExprList(...); - PTR_LLND addToExprList(...); - PTR_LLND addToList(...); - PTR_LLND copyLlNode(...); - PTR_LLND deleteNodeInExprList(...); - PTR_LLND deleteNodeWithItemInExprList(...); - PTR_LLND findPtrRefExp(...); - PTR_LLND getPositionInExprList(...); - PTR_LLND getPositionInList(...); - PTR_LLND giveLlSymbInDeclList(...); - PTR_LLND makeDeclExp(...); - PTR_LLND makeDeclExpWPar(...); - PTR_LLND makeInt(...); - PTR_LLND newExpr(...); - PTR_SYMB GetThOfFieldList(...); - PTR_SYMB GetThOfFieldListForType(...); - PTR_SYMB GetThParam(...); - PTR_SYMB Get_Symb_with_id(...); - PTR_SYMB doesClassInherit(...); - PTR_SYMB duplicateParamList(...); - PTR_SYMB duplicateSymbol(...); - PTR_SYMB duplicateSymbolAcrossFiles(...); - PTR_SYMB duplicateSymbolLevel1(...); - PTR_SYMB duplicateSymbolLevel2(...); - PTR_SYMB getClassNextFieldOrMember(...); - PTR_SYMB getFieldOfStructWithName(...); - PTR_SYMB getFirstFieldOfStruct(...); - PTR_SYMB getSymbolWithName(...); - PTR_SYMB getSymbolWithNameInScope(...); - PTR_SYMB lookForNameInParamList(...); - PTR_SYMB newSymbol(...); - PTR_SYMB duplicateSymbolOfRoutine(...); - PTR_TYPE FollowTypeBaseAndDerived(...); - PTR_TYPE GetAtomicType(...); - PTR_TYPE Get_type_with_id(...); - PTR_TYPE addToBaseTypeList(...); - PTR_TYPE createDerivedCollectionType(...); - PTR_TYPE duplicateType(...); - PTR_TYPE duplicateTypeAcrossFiles(...); - PTR_TYPE getDerivedTypeWithName(...); - PTR_TYPE lookForInternalBasetype(...); - PTR_TYPE lookForTypeDescript(...); - char *allocateFreeListNodeExpression(...); - char* Get_Function_Name_For_Call(...); - char* Remove_Carriage_Return(...); - char* UnparseTypeBuffer(...); - char* filter(...); - char* mymalloc(...); - char* xmalloc(...); - int Apply_To_Bif(...); - int Check_Lang_C(...); - int Check_Lang_Fortran(...); - int GetFileNum(...); - int GetFileNumWithPt(...); - int Init_Tool_Box(...); - int IsRefToSymb(...); - int Is_String_Val_With_Val(...); - int LibClanguage(...); - int LibFortranlanguage(...); - int LibIsSymbolInScope(...); - int LibIsSymbolReferenced(...); - int LibisEnddoLoop(...); - int LibisMethodOfElement(...); - int LibnumberOfFiles(...); - int LibperfectlyNested(...); - int Message(...); - int Replace_String_In_Expression(...); - int appendBfndListToList1(...); - int appendBfndListToList2(...); - int appendBfndToList(...); - int appendBfndToList1(...); - int appendBfndToList2(...); - int arraySymbol(...); - int blobListLength(...); - int buildLinearRep(...); - int buildLinearRepSign(...); - int convertToEnddoLoop(...); - int countInStmtNode1(...); - int countInStmtNode2(...); - int exprListLength(...); - int findBif(...); - int findBifInList1(...); - int findBifInList2(...); - int firstBfndInList1(...); - int firstBfndInList2(...); - int firstInBfndList2(...); - int getElementEvaluate(...); - int getLastLabelId(...); - int getNumberOfFunction(...); - int getNumberOfStruct(...); - int getTypeNumDimension(...); - int hasNodeASymb(...); - int hasTypeBaseType(...); - int hasTypeSymbol(...); - int inScope(...); - int insertBfndInList1(...); - int insertBfndInList2(...); - int insertBfndListIn(...); - int insertBfndListInList1(...); - int isABifNode(...); - int isAControlEnd(...); - int isADeclBif(...); - int isAEnumDeclBif(...); - int isALoNode(...); - int isAStructDeclBif(...); - int isASymbNode(...); - int isATypeNode(...); - int isAUnionDeclBif(...); - int isAtomicType(...); - int isElementType(...); - int isEnumType(...); - int isInStmt(...); - int isIntegerType(...); - int isItInSection(...); - int isNodeAConst(...); - int isPointerType(...); - int isStructType(...); - int isTypeEquivalent(...); - int isUnionType(...); - int lenghtOfFieldList(...); - int lenghtOfFieldListForType(...); - int lenghtOfParamList(...); - int localToFunction(...); - int lookForTypeInType(...); - int makeLinearExpr(...); - int makeLinearExpr_Sign(...); - int numberOfBifsInBlobList(...); - int open_proj_toolbox(...); - int open_proj_files_toolbox(...); - int patternMatchExpression(...); - int pointerType(...); - int replaceTypeInType(...); - int sameName(...); - int* evaluateExpression(...); - void Count_Bif_Next_Chain(...); - void LibAddComment(...); - void LibSetAllComments(...); - //Kolganov 15.11.2017 - void LibDelAllComments(...); - void LibconvertLogicIf(...); - void LibreplaceSymbByExp(...); - void LibreplaceSymbByExpInStmts(...); - void LibreplaceWithStmt(...); - void LibsaveDepFile(...); - void Redo_Bif_Next_Chain(...); - void Reset_Bif_Next(...); - void Reset_Bif_Next_Chain(...); - void Reset_Tool_Box(...); - void SetCurrentFileTo(...); - void UnparseBif(...); - void UnparseLLND(...); - void UnparseProgram(...); - void addControlEndToList2(...); - void addControlEndToStmt(...); - void addElementEvaluate(...); - void addSymbToFieldList(...); - void allocateValueEvaluate(...); - void appendSymbToArgList(...); - void declareAVar(...); - void declareAVarWPar(...); - void duplicateAllSymbolDeclaredInStmt(...); - void insertBfndBeforeIn(...); - void insertSymbInArgList(...); - void libFreeExpression(...); - void make_a_malloc_stack(...); - void myfree(...); - void replaceSymbInExpression(...); - void replaceSymbInExpressionSameName(...); - void replaceSymbInStmts(...); - void replaceSymbInStmtsSameName(...); - void replaceTypeForSymb(...); - void replaceTypeInExpression(...); - void replaceTypeInStmts(...); - void replaceTypeUsedInStmt(...); - void resetDoVarForSymb(...); - void resetFreeListForExpressionNode(...); - void resetPresetEvaluate(...); - void setFreeListForExpressionNode(...); - void updateControlParent(...); - void updateTypesAndSymbolsInBody(...); - void writeDepFileInDebugdep(...); - void updateTypeAndSymbolInStmts(...); - void updateTypesAndSymbolsInBodyOfRoutine(...); - char* UnparseBif_Char(...); - char *UnparseLLND_Char(...); - char *UnparseLLnode_Char(...); - void UnparseProgram_ThroughAllocBuffer(...); -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/libSage++.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/libSage++.h deleted file mode 100644 index a41beb6..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/libSage++.h +++ /dev/null @@ -1,9921 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -#ifndef LIBSAGEXX_H -#define LIBSAGEXX_H 1 - -#include -#include -#include -#include - -/* includes the attributes data structure */ - -#include "attributes.h" - -/************************************************************** -File: libSage++.h -Included in: sage++user.h and libSage++.C - -Purpose:It contains all the class definitions and the inline -definitions in Sage++. The start of each class and the start of inlines -in each class are easily identifiable. For example the SgProject class -definition starts with class SgProject (note the 2 spaces between -class and SgProject) and the comment line preceding the inline -declarations of SgProject is something like // SgProject--inlines. -Sections of the include file are within a #ifdef USER #endif. Those sections -are included only in sage++user.h and not in libSage++.C. Sections of -the include file are within a #if 0 #endif. These refer to the unimplemented -portions of Sage++ library. -***************************************************************/ - -#if __SPF -extern "C" void removeFromCollection(void *pointer); -extern void addToGlobalBufferAndPrint(const std::string& toPrint); -#endif - -class SgProject { - public: - inline SgProject(SgProject &); - SgProject(const char *proj_file_name); - SgProject(const char *proj_file_name, char **files_list, int no); - inline ~SgProject(); - inline int numberOfFiles(); - SgFile &file(int i); - inline char *fileName(int i); - inline int Fortranlanguage(); - inline int Clanguage(); - void addFile(char * dep_file_name); - void deleteFile(SgFile * file); -}; - -class SgFile { -private: - static std::map > files; - -public: - PTR_FILE filept; - SgFile(char* file_name); // the file must exist. - SgFile(int Language, const char* file_name); // for new empty file objects. - ~SgFile(); - SgFile(SgFile &); - inline int languageType(); - inline void saveDepFile(const char *dep_file); - inline void unparse(FILE *filedisc); - inline void unparsestdout(); - inline void unparseS(FILE *filedisc, int size); - const char* filename(); - - inline SgStatement *mainProgram(); - SgStatement *functions(int i); - inline int numberOfFunctions(); - SgStatement *getStruct(int i); - inline int numberOfStructs(); - - inline SgStatement *firstStatement(); - inline SgSymbol *firstSymbol(); - inline SgType *firstType(); - inline SgExpression *firstExpression(); - - inline SgExpression *SgExpressionWithId(int i); - inline SgStatement *SgStatementWithId(int id); - inline SgStatement *SgStatementAtLine(int lineno); - inline SgSymbol *SgSymbolWithId(int id); - inline SgType *SgTypeWithId(int id); - // for attributes; - void saveAttributes(char *file); - void saveAttributes(char *file, void(*savefunction)(void *dat, FILE *f)); - void readAttributes(char *file); - void readAttributes(char *file, void * (*readfunction)(FILE *f)); - int numberOfAttributes(); - SgAttribute *attribute(int i); - - /***** Kataev 15.07.2013 *****/ - int numberOfFileAttributes(); - int numberOfAttributes(int type); // of a specified type; - void *attributeValue(int i); - int attributeType(int i); - void *attributeValue(int i, int type); // only considering one type attribute - void *deleteAttribute(int i); - void addAttribute(int type, void *a, int size); // void * can be NULL; - void addAttribute(int type); //void * is NULL; - void addAttribute(void *a, int size); //no type specifed; - void addAttribute(SgAttribute *att); - SgAttribute *getAttribute(int i); - SgAttribute *getAttribute(int i, int type); - /*****************************/ - - int expressionGarbageCollection(int deleteExpressionNode, int verbose); - //int SgFile::expressionGarbageCollection(int deleteExpressionNode, int verbose); - - static int switchToFile(const std::string &name); - static void addFile(const std::pair &toAdd); -}; - - -extern SgFile *current_file; //current file -extern int current_file_id; //number of current file - -// Discuss about control parent, BIF structure etc -class SgStatement -{ -private: - int fileID; - SgProject *project; - bool unparseIgnore; - - static bool sapfor_regime; - static std::string currProcessFile; - static int currProcessLine; - static bool deprecatedCheck; - static bool consistentCheckIsActivated; - // fileID -> [ map, SgSt*] - static std::map, SgStatement*> > statsByLine; - static void updateStatsByLine(std::map, SgStatement*> &toUpdate); - static std::map parentStatsForExpression; - static void updateStatsByExpression(); - static void updateStatsByExpression(SgStatement *where, SgExpression *what); - - void checkConsistence(); - void checkDepracated(); - void checkCommentPosition(const char* com); - -public: - PTR_BFND thebif; - SgStatement(int variant); - SgStatement(PTR_BFND bif); - SgStatement(int code, SgLabel *lab, SgSymbol *symb, SgExpression *e1 = NULL, SgExpression *e2 = NULL, SgExpression *e3 = NULL); - SgStatement(SgStatement &); - // info about statement - inline int lineNumber(); // source text line number - inline int localLineNumber(); - inline int id(); // unique id; - inline int variant(); // the type of the statement - SgExpression *expr(int i); // i = 0,1,2 returns the i-th expression. - - inline int hasSymbol(); // returns TRUE if tmt has symbol, FALSE otherwise - // returns the symbol field. Used by loop headers to point to the - // loop variable symbol; Used by function and subroutine headers to - // point to the function or subroutine name. - SgSymbol *symbol(); // returns the symbol field. - inline char *fileName(); - inline void setFileName(char *newFile); - - inline int hasLabel(); // returns 1 if there is a label on the stmt. - SgLabel *label(); // the label - - // modifying the info. - inline void setlineNumber(const int n); // change the line number info - inline void setLocalLineNumber(const int n); - inline void setId(int n); // cannot change the id info - inline void setVariant(int n); // change the type of the statement - void setExpression(int i, SgExpression &e); // change the i-th expression - void setExpression(int i, SgExpression *e); // change the i-th expression - inline void setLabel(SgLabel &l); // change the label - inline void deleteLabel(bool saveLabel = false); // delete label - inline void setSymbol(SgSymbol &s); // change the symbol - - // Control structure - inline SgStatement *lexNext(); // the next statement in lexical order. - inline SgStatement *lexPrev(); // the previous stmt in lexical order. - inline SgStatement *controlParent(); // the enclosing control statement - - inline void setLexNext(SgStatement &s); // change the lexical ordering - inline void setLexNext(SgStatement* s); - - // change the control parent. - inline void setControlParent(SgStatement& s) // DEPRECATED IN SAPFOR!! - { - checkDepracated(); - BIF_CP(thebif) = s.thebif; - } - - inline void setControlParent(SgStatement* s) // DEPRECATED IN SAPFOR!! - { - checkDepracated(); - if (s != 0) - BIF_CP(thebif) = s->thebif; - else - BIF_CP(thebif) = 0; - } - - // Access statement using the tree structure - // Describe BLOB lists here? - - inline int numberOfChildrenList1(); - inline int numberOfChildrenList2(); - inline SgStatement *childList1(int i); - inline SgStatement *childList2(int i); - SgStatement *nextInChildList(); - - inline SgStatement *lastDeclaration(); - inline SgStatement *lastExecutable(); - inline SgStatement *lastNodeOfStmt(); - inline SgStatement *nodeBefore(); - inline void insertStmtBefore(SgStatement &s, SgStatement &cp); - void insertStmtAfter(SgStatement &s, SgStatement &cp); - - inline void insertStmtBefore(SgStatement& s) // DEPRECATED IN SAPFOR!! - { - checkDepracated(); - insertBfndBeforeIn(s.thebif, thebif, NULL); - } - inline void insertStmtAfter(SgStatement& s) // DEPRECATED IN SAPFOR!! - { - checkDepracated(); - insertBfndListIn(s.thebif, thebif, NULL); - } - - inline SgStatement *extractStmt(); - inline SgStatement *extractStmtBody(); - inline void replaceWithStmt(SgStatement &s); - inline void deleteStmt(); - inline SgStatement ©(void); - inline SgStatement *copyPtr(void); - inline SgStatement ©One(void); - inline SgStatement *copyOnePtr(void); - inline SgStatement ©Block(void); - inline SgStatement *copyBlockPtr(void); - inline SgStatement *copyBlockPtr(int saveLabelId); - inline int isIncludedInStmt(SgStatement &s); - inline void replaceSymbByExp(SgSymbol &symb, SgExpression &exp); - inline void replaceSymbBySymb(SgSymbol &symb, SgSymbol &newsymb); - inline void replaceSymbBySymbSameName(SgSymbol &symb, SgSymbol &newsymb); - inline void replaceTypeInStmt(SgType &old, SgType &newtype); - char* unparse(int lang = 0); // FORTRAN_LANG - inline void unparsestdout(); - std::string sunparse(int lang = 0); // FORTRAN_LANG - inline char *comments(); //preceding comment lines. - void addComment(const char *com); - void addComment(char *com); - /* ajm: setComments: set ALL of the node's comments */ - inline void setComments(char *comments); - inline void setComments(const char *comments); - inline void delComments(); - int numberOfComments(); //number of preceeding comments. CAREFUL! - - int hasAnnotations(); //1 if there are annotations; 0 otherwise - ~SgStatement(); - // These function must be removed. Doesn't make sense here. - int IsSymbolInScope(SgSymbol &symb); // TRUE if symbol is in scope - int IsSymbolReferenced(SgSymbol &symb); - inline SgStatement *getScopeForDeclare(); // return where a variable can be declared; - - /////////////// FOR ATTRIBUTES ////////////////////////// - - int numberOfAttributes(); - int numberOfAttributes(int type); // of a specified type; - void *attributeValue(int i); - int attributeType(int i); - void *attributeValue(int i, int type); // only considering one type attribute - void *deleteAttribute(int i); - void addAttribute(int type, void *a, int size); // void * can be NULL; - void addAttribute(int type); //void * is NULL; - void addAttribute(void *a, int size); //no type specifed; - void addAttribute(SgAttribute *att); - void addAttributeTree(SgAttribute *firstAtt); - SgAttribute *getAttribute(int i); - SgAttribute *getAttribute(int i, int type); - - //////////// FOR DECL_SPECS (friend, inline, extern, static) //////////// - - inline void addDeclSpec(int type); //type should be one of BIT_EXTERN, - //BIT_INLINE, BIT_FRIEND, BIT_STATIC - inline void clearDeclSpec(); //resets the decl_specs field to zero - inline int isFriend(); //returns non-zero if friend modifier set - //returns zero otherwise - inline int isInline(); - inline int isExtern(); - inline int isStatic(); - - // new opportunities were added by Kolganov A.S. 16.04.2018 - inline int getFileId() const { return fileID; } - inline void setFileId(const int newFileId) { fileID = newFileId; } - - inline SgProject* getProject() const { return project; } - inline void setProject(SgProject *newProj) { project = newProj; } - - inline bool switchToFile() - { - if (fileID == -1 || project == NULL) - return false; - - if (current_file_id != fileID) - { - SgFile* file = &(project->file(fileID)); - currProcessFile = file->filename(); - currProcessLine = 0; - } - return true; - } - - inline SgFile* getFile() const - { - if (fileID == -1 || project == NULL) - return NULL; - else - return &(project->file(fileID)); - } - - inline void setUnparseIgnore(bool flag) { unparseIgnore = flag; } - inline bool getUnparseIgnore() const { return unparseIgnore; } - - static SgStatement* getStatementByFileAndLine(const std::string &fName, const int lineNum); - static void cleanStatsByLine() { statsByLine.clear(); } - - static SgStatement* getStatmentByExpression(SgExpression*); - static void cleanParentStatsForExprs() { parentStatsForExpression.clear(); } - static void activeConsistentchecker() { consistentCheckIsActivated = true; } - static void deactiveConsistentchecker() { consistentCheckIsActivated = false; } - static void activeDeprecatedchecker() { deprecatedCheck = true; } - static void deactiveDeprecatedchecker() { deprecatedCheck = false; } - - static void setCurrProcessFile(const std::string& name) { currProcessFile = name; } - static void setCurrProcessLine(const int line) { currProcessLine = line; } - static std::string getCurrProcessFile() { return currProcessFile; } - static int getCurrProcessLine() { return currProcessLine; } - - static void setSapforRegime() { sapfor_regime = true; } - static bool isSapforRegime() { return sapfor_regime; } -}; - -class SgExpression -{ -public: - PTR_LLND thellnd; - // generic expression class. - SgExpression(int variant, SgExpression &lhs, SgExpression &rhs, SgSymbol &s, SgType &type); - SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s, SgType *type); - SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s); - SgExpression(int variant, SgExpression *lhs, SgExpression *rhs); - SgExpression(int variant, SgExpression* lhs); - - // for some node in fortran - SgExpression(int variant,char *str); - - SgExpression(int variant); - SgExpression(PTR_LLND ll); - SgExpression(SgExpression &); - ~SgExpression(); - - inline SgExpression *lhs(); - inline SgExpression *rhs(); - SgExpression *operand(int i); - inline int variant(); - inline SgType *type(); - SgSymbol *symbol(); - inline int id(); - inline SgExpression *nextInExprTable(); - - inline void setLhs(SgExpression &e); - inline void setLhs(SgExpression *e); - inline void setRhs(SgExpression &e); - inline void setRhs(SgExpression *e); - inline void setSymbol(SgSymbol &s); - inline void setSymbol(SgSymbol *s); - inline void setType(SgType &t); - inline void setType(SgType *t); - inline void setVariant(int v); - - inline SgExpression ©(); - inline SgExpression *copyPtr(); - char *unparse(); - inline char *unparse(int lang); //0 - Fortran, 1 - C - std::string sunparse(); - inline void unparsestdout(); - inline SgExpression *IsSymbolInExpression(SgSymbol &symbol); - inline void replaceSymbolByExpression(SgSymbol &symbol, SgExpression &expr); - inline SgExpression *symbRefs(); - inline SgExpression *arrayRefs(); - int linearRepresentation(int *coeff, SgSymbol **symb,int *cst, int size); - SgExpression *normalForm(int n, SgSymbol *s); - SgExpression *coefficient(SgSymbol &s); - int isInteger(); - int valueInteger(); - -friend SgExpression &operator + ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator - ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator * ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator / ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator % ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator <<( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator >>( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator < ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator > ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator <= ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator >= ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator & ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator | ( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator &&( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator ||( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator +=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator &=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator *=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator /=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator %=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator ^=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator <<=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator >>=( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator ==(SgExpression &lhs, SgExpression &rhs); -friend SgExpression &operator !=(SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgAssignOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgEqOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgNeqOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgExprListOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgRecRefOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgPointStOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgScopeOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgDDotOp( SgExpression &lhs, SgExpression &rhs); -friend SgExpression &SgBitNumbOp( SgExpression &lhs, SgExpression &rhs); - - /////////////// FOR ATTRIBUTES ////////////////////////// - - int numberOfAttributes(); - int numberOfAttributes(int type); // of a specified type; - void *attributeValue(int i); - int attributeType(int i); - void *attributeValue(int i,int type); // only considering one type attribute - void *deleteAttribute(int i); - void addAttribute(int type, void *a, int size); // void * can be NULL; - void addAttribute(int type); //void * is NULL; - void addAttribute(void *a, int size); //no type specifed; - void addAttribute(SgAttribute *att); - SgAttribute *getAttribute(int i); - SgAttribute *getAttribute(int i,int type); - void addAttributeTree(SgAttribute* firstAtt); -}; - -class SgSymbol{ -private: - // copyed by Yashin 08.09.2018 - int fileID; - SgProject *project; - // - -public: - // basic class contains - PTR_SYMB thesymb; - SgSymbol(int variant, const char *identifier, SgType &t, SgStatement &scope); - SgSymbol(int variant, const char *identifier, SgType *t, SgStatement *scope); - SgSymbol(int variant, const char *identifier, SgStatement &scope); - SgSymbol(int variant, const char *identifier, SgStatement *scope); - SgSymbol(int variant, const char *identifier, SgType *type, SgStatement *scope, SgSymbol *structsymb, SgSymbol *nextfield ); - - SgSymbol(int variant, const char *name); - SgSymbol(int variant); - SgSymbol(PTR_SYMB symb); -#if __SPF - SgSymbol(const SgSymbol &); -#endif - ~SgSymbol(); - inline int variant() const; - inline int id() const; // unique identifier - inline char *identifier() const; // the text name for the symbol. - inline SgType *type(); // the type of the symbol - inline void setType(SgType &t); // the type of the symbol - inline void setType(SgType *t); // the type of the symbol - inline SgStatement *scope(); // the SgControlStatement where defined. - inline SgSymbol *next(); // next symbol reference. - SgStatement *declaredInStmt(); // the declaration statement - inline SgSymbol ©(); - inline SgSymbol* copyPtr(); - inline SgSymbol ©Level1(); // copy also parameters - inline SgSymbol ©Level2(); // copy parameters, body also - inline SgSymbol ©AcrossFiles(SgStatement &where); // special copy to move things from a file. - inline SgSymbol ©Subprogram(SgStatement &where); // special copy for inline expansion 07.06.06 - int attributes(); // the Fortran 90 attributes - void setAttribute(int attribute); - void removeAttribute(int attribute); - void declareTheSymbol(SgStatement &st); - inline void declareTheSymbolWithParamList - (SgStatement &st, SgExpression &parlist); - SgExpression *makeDeclExpr(); - inline SgExpression *makeDeclExprWithParamList - (SgExpression &parlist); - SgVarDeclStmt *makeVarDeclStmt(); - SgVarDeclStmt *makeVarDeclStmtWithParamList - (SgExpression &parlist); - - SgStatement *body(); // the body of the symbol if has one (like, function call, class,...) - inline SgSymbol *moduleSymbol(); // module symbol reference "by use" - - // new opportunities were added by Kolganov A.S. 16.04.2018 and copyed by Yashin 08.09.2018 - inline int getFileId() const { return fileID; } - inline void setFileId(const int newFileId) { fileID = newFileId; } - void changeName(const char *); // set new name for the symbol - - inline SgProject* getProject() const { return project; } - inline void setProject(SgProject *newProj) { project = newProj; } - - inline bool switchToFile() - { - if (fileID == -1 || project == NULL) - return false; - - if (current_file_id != fileID) - SgFile *file = &(project->file(fileID)); - return true; - } - - inline SgFile* getFile() const - { - if (fileID == -1 || project == NULL) - return NULL; - else - return &(project->file(fileID)); - } - // - - /////////////// FOR ATTRIBUTES ////////////////////////// - - int numberOfAttributes(); - int numberOfAttributes(int type); // of a specified type; - void *attributeValue(int i); - int attributeType(int i); - void *attributeValue(int i,int type); // only considering one type attribute - void *deleteAttribute(int i); - void addAttribute(int type, void *a, int size); // void * can be NULL; - void addAttribute(int type); //void * is NULL; - void addAttribute(void *a, int size); //no type specifed; - void addAttribute(SgAttribute *att); - SgAttribute *getAttribute(int i); - SgAttribute *getAttribute(int i,int type); -}; - - -/* This code by Andrew Mauer (ajm) */ -/* These constants are used by SgType::maskDescriptors() and - SgType::getTrueType(). */ - -const int MASK_NO_DESCRIPTORS = ~0; /* all ones = keep everything */ -const int MASK_MOST_DESCRIPTORS = ( BIT_SIGNED | BIT_UNSIGNED - | BIT_LONG | BIT_SHORT - | BIT_CONST | BIT_VOLATILE ); - -const int MASK_ALL_DESCRIPTORS = 0; /* keep nothing */ - - -class SgType{ -public: - PTR_TYPE thetype; - SgType(int variant); - SgType(int var, SgExpression *len,SgType *base); - SgType(int var, SgSymbol *symb); - SgType(int var, SgSymbol *firstfield, SgStatement *structstmt); - SgType(int var, SgSymbol *symb, SgExpression *len, SgType *base); - SgType(PTR_TYPE type); - SgType(SgType &); - ~SgType(); - inline int variant(); - inline int id(); - inline SgSymbol *symbol(); - inline SgType ©(); - inline SgType *copyPtr(); - inline SgType *next(); - inline int isTheElementType(); - inline int equivalentToType(SgType &type); - inline int equivalentToType(SgType *type); - inline SgType *internalBaseType(); - inline int hasBaseType(); - inline SgType *baseType(); - inline SgExpression *length(); // update Kataev N.A. 30.08.2013 - inline void setLength(SgExpression* newLen); - inline SgExpression *selector(); // update Kataev N.A. 30.08.2013 - inline void setSelector(SgExpression* newSelector); - inline void deleteSelector(); - -/* This code by Andrew Mauer (ajm) */ -/* - maskDescriptors: - - This routine strips many descriptive type traits which you are probably - not interested in cloning for variable declarations, etc. - - Returns the getTrueType of the base type being described IF there - are no descriptors which are not masked out. The following masks - can be specified as an optional second argument: - MASK_NO_DESCRIPTORS: Do not mask out anything. - MASK_MOST_DESCRIPTORS: Only leave in: signed, unsigned, short, long, - const, volatile. - MASK_ALL_DESCRIPTORS: Mask out everything. - - If you build your own mask, you should make sure that the traits - you want to set out have their bits UN-set, and the rest should have - their bits set. The complementation (~) operator is a good one to use. - - See libSage++.h, where the MASK_*_DESCRIPTORS variables are defined. -*/ - - SgType *maskDescriptors (int mask); - - -/* This code by Andrew Mauer (ajm) */ -/* - getTrueType: - - Since Sage stores dereferenced pointers as PTR(-1) -> PTR(1) -> BASE_TYPE, - we may need to follow the chain of dereferencing to find the type - which we expect. - - This code currently assumes that: - o If you follow the dereferencing pointer (PTR(-1)), you find another - pointer type or an array type. - - We do NOT assume that the following situation cannot occur: - PTR(-1) -> PTR(-1) -> PTR(1) -> PTR(1) -> PTR(-1) -> PTR(1) - - This means there may be more pointers to follow after we come to - an initial "equilibrium". - - ALGORITHM: - - T_POINTER: - [WARNING: No consideration is given to pointers with attributes - (ls_flags) set. For instance, a const pointer is treated the same - as any other pointer.] - - 1. Return the same type we got if it is not a pointer type or - the pointer is not a dereferencing pointer type. - - 2. Repeat { get next pointer , add its indirection to current total } - until the current total is 0. We have reached an equilibrium, so - the next type will not necessarily be a pointer type. - - 3. Check the next type for further indirection with another call - to getTrueType. - - T_DESCRIPT: - Returns the result of maskDescriptors called with the given type and mask. - - T_ARRAY: - If the array has zero dimensions, we pass over it. This type arose - for me in the following situation: - double x[2]; - x[1] = 0; - - T_DERIVED_TYPE: - If we have been told to follow typedefs, get the type of the - symbol from which this type is derived from, and continue digging. - Otherwise return this type. - - - HITCHES: - Some programs may dereference a T_ARRAY as a pointer, so we need - to be prepared to deal with that. - */ - - SgType *getTrueType (int mask = MASK_MOST_DESCRIPTORS, - int follow_typedefs = 0); - - int numberOfAttributes(); - int numberOfAttributes(int type); // of a specified type; - void *attributeValue(int i); - int attributeType(int i); - void *attributeValue(int i,int type); // only considering one type attribute - void *deleteAttribute(int i); - void addAttribute(int type, void *a, int size); // void * can be NULL; - void addAttribute(int type); //void * is NULL; - void addAttribute(void *a, int size); //no type specifed; - void addAttribute(SgAttribute *att); - SgAttribute *getAttribute(int i); - SgAttribute *getAttribute(int i,int type); -}; - -// SgMakeDeclExp can be called by the user to generate declaration -// expressions from type strings. it handles all C types. -SgExpression *SgMakeDeclExp(SgSymbol *sym, SgType *t); - - -class SgLabel{ -public: - PTR_LABEL thelabel; - SgLabel(PTR_LABEL lab); - SgLabel(SgLabel &); - SgLabel(int i); - inline int getLabNumber() { return (int)(thelabel->stateno); } - inline int id(); - inline int getLastLabelVal(); - ~SgLabel(); - - /***** Kataev 21.03.2013 *****/ - int numberOfAttributes(); - int numberOfAttributes(int type); // of a specified type; - void *attributeValue(int i); - int attributeType(int i); - void *attributeValue(int i,int type); // only considering one type attribute - void *deleteAttribute(int i); - void addAttribute(int type, void *a, int size); // void * can be NULL; - void addAttribute(int type); //void * is NULL; - void addAttribute(void *a, int size); //no type specifed; - void addAttribute(SgAttribute *att); - SgAttribute *getAttribute(int i); - SgAttribute *getAttribute(int i,int type); - /*****************************/ -}; - -class SgValueExp: public SgExpression{ - // a value of one of the base types - // variants: INT_VAL, CHAR_VAL, FLOAT_VAL, - // DOUBLE_VAL, STRING_VAL, COMPLEX_VAL, KEYWORD_VAL -public: - inline SgValueExp(bool value); // add for bool value (Kolganov, 26.11.2019) - inline SgValueExp(int value); - inline SgValueExp(char char_val); - inline SgValueExp(float float_val); - inline SgValueExp(double double_val); - inline SgValueExp(float float_val, char*); - inline SgValueExp(double double_val, char*); - inline SgValueExp(char *string_val); - inline SgValueExp(const char *string_val); - inline SgValueExp(double real, double imaginary); - inline SgValueExp(SgValueExp &real, SgValueExp &imaginary); - inline void setValue(int int_val); - inline void setValue(char char_val); - inline void setValue(float float_val); - inline void setValue(double double_val); - inline void setValue(char *string_val); - inline void setValue(double real, double im); - inline bool boolValue(); // add for bool value (Kataev, 16.03.2013) - inline void setValue(SgValueExp &real, SgValueExp & im); - inline int intValue(); - inline char* floatValue(); - inline char charValue(); - inline char* doubleValue(); - inline char * stringValue(); - inline SgExpression *realValue(); - inline SgExpression *imaginaryValue(); -}; - -class SgKeywordValExp: public SgExpression{ -public: - inline SgKeywordValExp(char *name); - inline SgKeywordValExp(const char *name); - inline char *value(); -}; - - -class SgUnaryExp: public SgExpression{ -public: - inline SgUnaryExp(PTR_LLND ll); - inline SgUnaryExp(int variant, SgExpression & e); - inline SgUnaryExp(int variant, int post, SgExpression & e); - inline int post(); - SgExpression &operand(); -}; - -class SgCastExp: public SgExpression{ -public: - inline SgCastExp(PTR_LLND ll); - inline SgCastExp(SgType &t, SgExpression &e); - inline SgCastExp(SgType &t); - inline ~SgCastExp(); -}; - -// delete [size] expr -// variant == DELETE_OP -class SgDeleteExp: public SgExpression{ -public: - inline SgDeleteExp(PTR_LLND ll); - inline SgDeleteExp(SgExpression &size, SgExpression &expr); - inline SgDeleteExp(SgExpression &expr); - inline ~SgDeleteExp(); -}; - -// new typename -// new typename (expr) -// variant == NEW_OP -class SgNewExp: public SgExpression{ -public: - inline SgNewExp(PTR_LLND ll); - inline SgNewExp(SgType &t); - inline SgNewExp(SgType &t, SgExpression &e); -#if 0 - SgExpression &numberOfArgs(); - SgExpression &argument(int i); -#endif - ~SgNewExp(); -}; - -// functions here can use LlndMapping perhaps. -class SgExprIfExp: public SgExpression{ - // (expr1)? expr2 : expr3 - // variant == EXPR_IF -public: - inline SgExprIfExp(PTR_LLND ll); - inline SgExprIfExp(SgExpression &exp1,SgExpression &exp2, SgExpression &exp3); - SgExpression &conditional(); - SgExpression &trueExp(); - SgExpression &falseExp(); - inline void setConditional(SgExpression &c); - void setTrueExp(SgExpression &t); - void setFalseExp(SgExpression &f); - ~SgExprIfExp(); -}; - -class SgFunctionRefExp: public SgExpression{ - // function_name(formal args) - for function headers and protytpes. - // variant = FUNCTION_REF -public: - inline SgFunctionRefExp(PTR_LLND ll); - inline SgFunctionRefExp(SgSymbol &fun); - inline ~SgFunctionRefExp(); - inline SgSymbol *funName(); - inline SgExpression *args(); - inline int numberOfArgs(); - inline SgExpression *arg(int i); - SgExpression * AddArg(char *, SgType &); -}; - -class SgFunctionCallExp: public SgExpression{ - // function_name(expr1, expr2, ....) - // variant == FUNC_CALL -public: - inline SgFunctionCallExp(PTR_LLND ll); - inline SgFunctionCallExp(SgSymbol &fun, SgExpression ¶mList); - inline SgFunctionCallExp(SgSymbol &fun); - inline ~SgFunctionCallExp(); - inline SgSymbol *funName(); - inline SgExpression *args(); - inline int numberOfArgs(); - inline SgExpression *arg(int i); - inline void addArg(SgExpression &arg); -}; - -class SgFuncPntrExp: public SgExpression{ - // (functionpointer)(expr1,expr2,expr3) - // variant == FUNCTION_OP -public: - inline SgFuncPntrExp(PTR_LLND ll); - inline SgFuncPntrExp(SgExpression &ptr); - inline ~SgFuncPntrExp(); - inline SgExpression *funExp(); - inline void setFunExp(SgExpression &s); - inline int numberOfArgs(); - inline SgExpression *arg(int i); - inline void addArg(SgExpression &arg); // add an argument. - SgExpression* AddArg(SgSymbol *thefunc, char *name, SgType &); - // add a formal parameter - // to a pointer to a function prototype or parameter. - // this returns the expression -}; - -class SgExprListExp: public SgExpression{ - // variant == EXPR_LIST -public: - inline SgExprListExp(PTR_LLND ll); - inline SgExprListExp(); - inline SgExprListExp(SgExpression &ptr); - - // create new constructor for every variant, - // added by Kolganov A.S. 31.10.2013 - inline SgExprListExp(int variant); - - inline ~SgExprListExp(); - inline int length(); - inline SgExpression *elem(int i); - inline SgExprListExp *next(); - inline SgExpression *value(); - inline void setValue(SgExpression &ptr); - inline void append(SgExpression &arg); - void linkToEnd(SgExpression &arg); -}; - -class SgRefExp: public SgExpression{ - // Fortran name references - // variant == CONST_REF, TYPE_REF, INTERFACE_REF -public: - inline SgRefExp(PTR_LLND ll); - inline SgRefExp(int variant, SgSymbol &s); - inline ~SgRefExp(); -}; - -class SgTypeRefExp: public SgExpression{ - // a reference to a type in a c++ template argument - public: - inline SgTypeRefExp(SgType &t); - inline ~SgTypeRefExp(); - inline SgType *getType(); -}; - -class SgVarRefExp: public SgExpression{ - // scalar variable reference or non-indexed array reference - // variant == VAR_REF -public: - inline SgVarRefExp (PTR_LLND ll); - inline SgVarRefExp(SgSymbol &s); - inline SgVarRefExp(SgSymbol *s); - SgExpression *progatedValue(); // if scalar propogation worked - inline ~SgVarRefExp(); -}; - - -class SgThisExp: public SgExpression{ - // variant == THIS_NODE -public: - inline SgThisExp (PTR_LLND ll); - inline SgThisExp(SgType &t); - inline ~SgThisExp(); -}; - -class SgArrayRefExp: public SgExpression{ - // an array reference - // variant == ARRAY_REF -public: - inline SgArrayRefExp(PTR_LLND ll); - inline SgArrayRefExp(SgSymbol &s); - inline SgArrayRefExp(SgSymbol &s, SgExpression &subscripts); - inline SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2); - - inline SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3); - - inline SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3,SgExpression &sub4); - inline ~SgArrayRefExp(); - inline int numberOfSubscripts(); // the number of subscripts in reference - inline SgExpression *subscripts(); - inline SgExpression *subscript(int i); - inline void addSubscript(SgExpression &e); - inline void replaceSubscripts(SgExpression& e); - inline void setSymbol(SgSymbol &s); -}; - -// set NODE _TYPE. -class SgPntrArrRefExp: public SgExpression{ -public: - inline SgPntrArrRefExp(PTR_LLND ll); - inline SgPntrArrRefExp(SgExpression &p); - inline SgPntrArrRefExp(SgExpression &p, SgExpression &subscripts); - inline SgPntrArrRefExp(SgExpression &p, int n, SgExpression &sub1, SgExpression &sub2); - inline SgPntrArrRefExp(SgExpression &p, int n, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3); - inline SgPntrArrRefExp(SgExpression &p, int n, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3, SgExpression &sub4); - inline ~SgPntrArrRefExp(); - inline int dimension(); // the number of subscripts in reference - inline SgExpression *subscript(int i); - inline void addSubscript(SgExpression &e); - inline void setPointer(SgExpression &p); -}; - -class SgPointerDerefExp: public SgExpression{ - // pointer dereferencing - // variant == DEREF_OP -public: - inline SgPointerDerefExp(PTR_LLND ll); - inline SgPointerDerefExp(SgExpression &pointerExp); - inline ~SgPointerDerefExp(); - inline SgExpression *pointerExp(); -}; - -class SgRecordRefExp: public SgExpression{ - // a field reference of a structure - // variant == RECORD_REF -public: - inline SgRecordRefExp(PTR_LLND ll); - inline SgRecordRefExp(SgSymbol &recordName, char *fieldName); - inline SgRecordRefExp(SgExpression &recordExp, char *fieldName); - inline SgRecordRefExp(SgSymbol &recordName, const char *fieldName); - inline SgRecordRefExp(SgExpression &recordExp, const char *fieldName); - inline ~SgRecordRefExp(); - inline SgSymbol *fieldName(); - inline SgSymbol *recordName(); - inline SgExpression *record(); - inline SgExpression* field(); -}; - - -class SgStructConstExp: public SgExpression{ - // Fortran 90 structure constructor - // variant == STRUCTURE_CONSTRUCTOR -public: - inline SgStructConstExp(PTR_LLND ll); - // further checks on values need to be done. - inline SgStructConstExp(SgSymbol &structName, SgExpression &values); - inline SgStructConstExp(SgExpression &typeRef, SgExpression &values); - inline ~SgStructConstExp(); - inline int numberOfArgs(); - inline SgExpression *arg(int i); -}; - -class SgConstExp: public SgExpression{ -public: - inline SgConstExp(PTR_LLND ll); - inline SgConstExp(SgExpression &values); - inline ~SgConstExp(); - inline int numberOfArgs(); - inline SgExpression *arg(int i); -}; - -class SgVecConstExp: public SgExpression{ - // a vector constant of the form: [ expr1, expr2, expr3] - // variant == VECTOR_CONST -public: - inline SgVecConstExp(PTR_LLND ll); - inline SgVecConstExp(SgExpression &expr_list); - inline SgVecConstExp(int n, SgExpression *components); - inline ~SgVecConstExp(); - - inline SgExpression *arg(int i); // the i-th term - inline int numberOfArgs(); - inline void setArg(int i, SgExpression &e); -}; - -class SgInitListExp: public SgExpression{ - // used for initializations. form: { expr1,expr2,expr3} - // variant == INIT_LIST -public: - inline SgInitListExp(PTR_LLND ll); - inline SgInitListExp(SgExpression &expr_list); - inline SgInitListExp(int n, SgExpression *components); - inline ~SgInitListExp(); - - inline SgExpression *arg(int i); // the i-th term - inline int numberOfArgs(); - inline void setArg(int i, SgExpression &e); -}; - -class SgObjectListExp: public SgExpression{ - // used for EQUIVALENCE, NAMELIST and COMMON statements - // variant == EQUI_LIST, NAMELIST_LIST, COMM_LIST -public: - inline SgObjectListExp(PTR_LLND ll); - inline SgObjectListExp(int variant, SgSymbol &object, SgExpression &list); - inline SgObjectListExp(int variant,SgExpression &objectRef, SgExpression &list); - inline ~SgObjectListExp(); - inline SgSymbol *object(); //fix Kataev N.A. 20.03.2014 - inline SgObjectListExp * next( ); //add Kataev N.A. 20.03.2014 - inline SgExpression * body( ); //rename from objectRef( ) Kataev N.A. 20.03.2014 - inline int listLength(); // fix Kataev N.A. 20.03.2014 - inline SgExpression object( int i); //add Kataev N.A. 20.03.2014 - inline SgSymbol *symbol(int i); // fix Kataev N.A. 20.03.2014 - inline SgExpression *body(int i); // rename from objectRef( int) and fix Kataev N.A. 20.03.2014 -}; - - -class SgAttributeExp: public SgExpression{ - // Fortran 90 attributes - // variant == PARAMETER_OP, PUBLIC_OP, PRIVATE_OP, ALLOCATABLE_OP, - // DIMENSION_OP, EXTERNAL_OP, IN_OP, OUT_OP, INOUT_OP, INTRINSIC_OP, - // POINTER_OP, OPTIONAL_OP, SAVE_OP, TARGET_OP -public: - inline SgAttributeExp(PTR_LLND ll); - inline SgAttributeExp(int variant); - inline ~SgAttributeExp(); -}; - -class SgKeywordArgExp: public SgExpression{ - // Fortran 90 keyword argument - // variant == KEYWORD_ARG -public: - inline SgKeywordArgExp(PTR_LLND ll); - inline SgKeywordArgExp(char *argName, SgExpression &exp); - inline SgKeywordArgExp(const char *argName, SgExpression &exp); - inline ~SgKeywordArgExp(); - //inline SgSymbol *arg(); does not work, always return NULL - inline SgExpression *arg(); //! now return SgKeywordValueExp (Kataev N.A. 30.05.2013) - inline SgExpression *value(); -}; - -class SgSubscriptExp: public SgExpression{ - // Fortran 90 vector subscript expression - // variant == DDOT -public: - inline SgSubscriptExp(PTR_LLND ll); - inline SgSubscriptExp(SgExpression &lbound, SgExpression &ubound, SgExpression &step); - inline SgSubscriptExp(SgExpression &lbound, SgExpression &ubound); - inline ~SgSubscriptExp(); - // perhaps this function can use LlndMapping - SgExpression *lbound(); - SgExpression *ubound(); - SgExpression *step(); -}; - -class SgUseOnlyExp: public SgExpression{ - // Fortran 90 USE statement ONLY attribute - // variant == ONLY_NODE -public: - inline SgUseOnlyExp(PTR_LLND ll); - inline SgUseOnlyExp(SgExpression &onlyList); - inline ~SgUseOnlyExp(); - inline SgExpression *onlyList(); -}; - -class SgUseRenameExp: public SgExpression{ - // Fortran 90 USE statement renaming - // variant == RENAME_NODE -public: - inline SgUseRenameExp(PTR_LLND ll); - inline SgUseRenameExp(SgSymbol &newName, SgSymbol &oldName); - inline ~SgUseRenameExp(); - inline SgSymbol *newName(); - inline SgSymbol *oldName(); - inline SgExpression *newNameExp(); - inline SgExpression *oldNameExp(); -}; - - -class SgSpecPairExp: public SgExpression{ - // Fortran default control arguments to Input/Output statements - // variant == SPEC_PAIR -public: - inline SgSpecPairExp(PTR_LLND ll); - inline SgSpecPairExp(SgExpression &arg, SgExpression &value); - inline SgSpecPairExp(SgExpression &arg); - inline SgSpecPairExp(char *arg, char *value); - inline ~SgSpecPairExp(); - inline SgExpression *arg(); - inline SgExpression *value(); -}; - - -//used for do-loop range representation also. -// this form needs to be standardized. -class SgIOAccessExp: public SgExpression{ - // Fortran index variable bound instantiation - // variant == IOACCESS -public: - inline SgIOAccessExp(PTR_LLND ll); - // type-checking on bounds needs to be done. - // Float values are legal in some cases. check manual. - inline SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound, SgExpression step); - inline SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound); - inline ~SgIOAccessExp(); -}; - -class SgImplicitTypeExp: public SgExpression{ - // Fortran index variable bound instantiation - // variant == IMPL_TYPE -public: - inline SgImplicitTypeExp(PTR_LLND ll); - inline SgImplicitTypeExp(SgType &type, SgExpression &rangeList); - inline ~SgImplicitTypeExp(); - inline SgType *type(); - inline SgExpression *rangeList(); - inline char *alphabeticRange(); -}; - -class SgTypeExp: public SgExpression{ - // Fortran type expression - // variant == TYPE_OP -public: - inline SgTypeExp(PTR_LLND ll); - inline SgTypeExp(SgType &type); - inline ~SgTypeExp(); - inline SgType *type(); -}; - -class SgSeqExp: public SgExpression{ - // Fortran index variable bound instantiation - // variant == SEQ -public: - inline SgSeqExp(PTR_LLND ll); - inline SgSeqExp(SgExpression &exp1, SgExpression &exp2); - inline ~SgSeqExp(); - inline SgExpression *front(); - inline SgExpression *rear(); -}; - -class SgStringLengthExp: public SgExpression{ - // Fortran index variable bound instantiation - // variant == LEN_OP -public: - inline SgStringLengthExp(PTR_LLND ll); - inline SgStringLengthExp(SgExpression &length); - inline ~SgStringLengthExp(); - inline SgExpression *length(); -}; - -class SgDefaultExp: public SgExpression { - // Fortran default node - // variant == DEFAULT -public: - SgDefaultExp(PTR_LLND ll); - SgDefaultExp(); - ~SgDefaultExp(); -}; - -class SgLabelRefExp: public SgExpression{ - // Fortran label reference - // variant == LABEL_REF -public: - inline SgLabelRefExp(PTR_LLND ll); - inline SgLabelRefExp(SgLabel &label); - inline ~SgLabelRefExp(); - inline SgLabel *label(); -}; - - -class SgProgHedrStmt: public SgStatement{ - // fortran Program block - // variant == PROG_HEDR -public: - inline SgProgHedrStmt(PTR_BFND bif); - inline SgProgHedrStmt(int variant); - inline SgProgHedrStmt(SgSymbol &name, SgStatement &Body); - inline SgProgHedrStmt(SgSymbol &name); - inline SgProgHedrStmt(char *name); - inline SgSymbol &name(); - // added 15.08.2018 by A.S. Kolganov. .funcName - inline std::string nameWithContains() - { - std::string containsName = ""; - SgStatement *st_cp = this->controlParent(); - if (st_cp->variant() == PROC_HEDR || st_cp->variant() == PROG_HEDR || st_cp->variant() == FUNC_HEDR) - containsName = st_cp->symbol()->identifier() + std::string("."); - - return containsName + this->symbol()->identifier(); - } - - inline void setName(SgSymbol &symbol); // set program name - - inline int numberOfFunctionsCalled(); // the number of functions called - inline SgSymbol *calledFunction(int i);// the i-th called function - inline int numberOfStmtFunctions(); // the number of statement funcions; - inline SgStatement *statementFunc(int i); // the i-th statement function; - inline int numberOfEntryPoints(); // the number of entry points; - inline SgStatement *entryPoint(int i); // the i-th entry point; - inline int numberOfParameters(); // the number of parameters; - inline SgSymbol *parameter(int i); // the i-th parameter - inline int numberOfSpecificationStmts(); - inline SgStatement *specificationStmt(int i); - inline int numberOfExecutionStmts(); - inline SgStatement *executionStmt(int i); - inline int numberOfInternalFunctionsDefined(); - inline SgStatement *internalFunction(int i); - inline int numberOfInternalSubroutinesDefined(); - inline SgStatement *internalSubroutine(int i); - inline int numberOfInternalSubProgramsDefined(); - inline SgStatement *internalSubProgram(int i); - -#if 0 - SgSymbol &addVariable(SgType &T, char *name); - //add a declaration for new variable - - SgStatement &addCommonBlock(char *blockname, int noOfVars, - SgSymbol *Vars); // add a new common block -#endif - inline int isSymbolInScope(SgSymbol &symbol); - inline int isSymbolDeclaredHere(SgSymbol &symbol); - - // global analysis data - - inline int numberOfVarsUsed(); // list of used variable access sections - inline SgExpression *varsUsed(int i); // i-th var used section descriptor - inline int numberofVarsMod(); // list of modifed variable access sections - inline SgExpression *varsMod(int i); // i-th var mod section descriptor - inline ~SgProgHedrStmt(); -}; - -class SgProcHedrStmt: public SgProgHedrStmt{ - // Fortran subroutine - // variant == PROC_HEDR -public: - inline SgProcHedrStmt(int variant); - inline SgProcHedrStmt(SgSymbol &name, SgStatement &Body); - inline SgProcHedrStmt(SgSymbol &name); - inline SgProcHedrStmt(const char *name); - inline void AddArg(SgExpression &arg); - SgExpression * AddArg(char *name, SgType &t); // returns decl expr created. - SgExpression * AddArg(char *name, SgType &t, SgExpression &initializer); - inline int isRecursive(); // 1 if recursive.; - inline int numberOfEntryPoints(); // the number of entry points - // other than the main, 0 for C funcs. - inline SgStatement *entryPoint(int i); // the i-th entry point - // this is incorrect. Takes only subroutines calls into account. - // Should be modified to take function calls into account too. - inline int numberOfCalls(); // number of calls to this proc. - inline SgStatement *call(int i); // position of the i-th call. - inline ~SgProcHedrStmt(); -}; - - -class SgProsHedrStmt: public SgProgHedrStmt{ - // Fortran M process - // variant == PROS_HEDR -public: - inline SgProsHedrStmt(); - inline SgProsHedrStmt(SgSymbol &name, SgStatement &Body); - inline SgProsHedrStmt(SgSymbol &name); - inline SgProsHedrStmt(char *name); - inline void AddArg(SgExpression &arg); - inline int numberOfCalls(); // number of calls to this proc. - inline SgStatement *call(int i); // position of the i-th call. - inline ~SgProsHedrStmt(); -}; - - -class SgFuncHedrStmt: public SgProcHedrStmt{ - // Fortran and C function. - // variant == FUNC_HEDR -public: - inline SgFuncHedrStmt(SgSymbol &name, SgStatement &Body); - inline SgFuncHedrStmt(SgSymbol &name, SgType &type, SgStatement &Body); - inline SgFuncHedrStmt(SgSymbol &name, SgSymbol &resultName, SgType &type, SgStatement &Body); - inline SgFuncHedrStmt(SgSymbol &name); - inline SgFuncHedrStmt(SgSymbol &name, SgExpression *exp); - inline SgFuncHedrStmt(char *name); - inline ~SgFuncHedrStmt(); - - inline SgSymbol *resultName(); // name of result variable.; - int setResultName(SgSymbol &symbol); // set name of result variable.; - - inline SgType *returnedType(); // type of returned value - inline void setReturnedType(SgType &type); // set type of returned value -}; - -class SgClassStmt; - -class SgTemplateStmt: public SgStatement{ - // This is a function template or class template - // in both cases the variant is TEMPLATE_FUNDECL -public: - SgTemplateStmt(SgExpression *arglist); - SgExpression * AddArg(char *name, SgType &t); // returns decl expr created. - // if name == NULL then this is a type reference. - SgExpression * AddArg(char *name, SgType &t, SgExpression &initializer); - int numberOfArgs(); - SgExpression *arg(int i); - SgExpression *argList(); - void addFunction(SgFuncHedrStmt &theTemplateFunc); - void addClass(SgClassStmt &theTemplateClass); - SgFuncHedrStmt *isFunction(); - SgClassStmt *isClass(); -}; - -#if 0 -class SgModuleStmt: public SgStatement{ - // Fortran 90 Module statement - // variant == MODULE_STMT -public: - SgModuleStmt(SgSymbol &moduleName, SgStatement &body); - SgModuleStmt(SgSymbol &moduleName); - ~SgModuleStmt(); - - SgSymbol *moduleName(); // module name - void setName(SgSymbol &symbol); // set module name - - int numberOfSpecificationStmts(); - int numberOfRoutinesDefined(); - int numberOfFunctionsDefined(); - int numberOfSubroutinesDefined(); - - SgStatement *specificationStmt(int i); - SgStatement *routine(int i); - SgStatement *function(int i); - SgStatement *subroutine(int i); - - int isSymbolInScope(SgSymbol &symbol); - int isSymbolDeclaredHere(SgSymbol &symbol); - - SgSymbol &addVariable(SgType &T, char *name); - //add a declaration for new variable - - SgStatement *addCommonBlock(char *blockname, int noOfVars, - SgSymbol *Vars); // add a new common block -}; - -class SgInterfaceStmt: public SgStatement{ - // Fortran 90 Operator Interface Statement - // variant == INTERFACE_STMT -public: - SgInterfaceStmt(SgSymbol &name, SgStatement &body, SgStatement &scope); - ~SgInterfaceStmt(); - - SgSymbol *interfaceName(); // interface name if given - int setName(SgSymbol &symbol); // set interface name - - int numberOfSpecificationStmts(); - - SgStatement *specificationStmt(int i); - - int isSymbolInScope(SgSymbol &symbol); - int isSymbolDeclaredHere(SgSymbol &symbol); -}; - -class SgBlockDataStmt: public SgStatement{ - // Fortran Block Data statement - // variant == BLOCK_DATA -public: - SgBlockDataStmt(SgSymbol &name, SgStatement &body); - ~SgBlockDataStmt(); - - SgSymbol *name(); // block data name if given; - int setName(SgSymbol &symbol); // set block data name - - int isSymbolInScope(SgSymbol &symbol); - int isSymbolDeclaredHere(SgSymbol &symbol); -}; - -#endif - - -class SgClassStmt: public SgStatement{ - // C++ class statement - // class name : superclass_list ElementTypeOf collection_name { - // body - // } variables_list; - // variant == CLASS_DECL -public: - inline SgClassStmt(int variant); - inline SgClassStmt(SgSymbol &name); - inline ~SgClassStmt(); - inline int numberOfSuperClasses(); - inline SgSymbol *name(); - inline SgSymbol *superClass(int i); - inline void setSuperClass(int i, SgSymbol &symb); -#if 0 - int numberOfVars(); // variables in variables_list - SgExpression variable(int i); // i-th variable in variable_list - SgExpression collectionName(); // if an ElementType class. - - // body manipulation functions. - int numberOfPublicVars(); - int numberOfPrivateVars(); - int numberOfProtectedVars(); - SgSymbol *publicVar(int i); - SgSymbol *protectedVar(int i); - SgSymbol *privateVar(int i); - void addPublicVar(SgSymbol &s); - void addPrivateVar(SgSymbol &s); - void addProtectedVar(SgSymbol &s); - int numberOfPublicFuns(); - int numberOfPrivateFuns(); - int numberOfProtectedFuns(); - SgStatement *publicFun(int i); - SgStatement *protectedFun(int i); - SgStatement *privateFun(int i); - void addPublicFun(SgStatement &s); - void addPrivateFun(SgStatement &s); - void addProtectedFun(SgStatement &s); -#endif -}; - -class SgStructStmt: public SgClassStmt{ - // basic C++ structure - // struct name ; - // body - // } variables_list; - // variant == STRUCT_DECL -public: - // consider like a class. - inline SgStructStmt(); - inline SgStructStmt(SgSymbol &name); - inline ~SgStructStmt(); - -}; - - -class SgUnionStmt: public SgClassStmt{ - // basic C++ structure - // union name { - // body - // } variables_list; - // variant == UNION_DECL -public: - // consider like a class. - inline SgUnionStmt(); - inline SgUnionStmt(SgSymbol &name); - inline ~SgUnionStmt(); -}; - -class SgEnumStmt: public SgClassStmt{ - // basic C++ structure - // enum name { - // body - // } variables_list; - // variant == ENUM_DECL -public: - // consider like a class. - inline SgEnumStmt(); - inline SgEnumStmt(SgSymbol &name); - inline ~SgEnumStmt(); -}; - -class SgCollectionStmt: public SgClassStmt{ - // basic C++ structure - // collection name ; - // body - // } variables_list; - // variant == COLLECTION_DECL -public: - inline SgCollectionStmt(); - inline SgCollectionStmt(SgSymbol &name); - inline ~SgCollectionStmt(); -#if 0 - int numberOfElemMethods(); - SgStatement *elementMethod(int i); - void addElementMethod(SgStatement &s); -#endif - inline SgStatement *firstElementMethod(); -}; - -class SgBasicBlockStmt: public SgStatement{ - // in C we have: { body; } - // variant == BASIC_BLOCK -public: - inline SgBasicBlockStmt(); - inline ~SgBasicBlockStmt(); -}; - -// ********************* traditional control Structures ************ -class SgForStmt: public SgStatement{ - // for Fortran Do and C for(); - // variant = FOR_NODE -public: - inline SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end, - SgExpression &step, SgStatement &body); - inline SgForStmt(SgSymbol *do_var, SgExpression *start, SgExpression *end, - SgExpression *step, SgStatement *body); - inline SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end, - SgStatement &body); - inline SgForStmt(SgExpression &start, SgExpression &end, SgExpression &step, - SgStatement &body); - - inline SgForStmt(SgExpression *start, SgExpression *end, SgExpression *step, SgStatement *body); -#if __SPF - inline SgSymbol* doName(); -#else - inline SgSymbol doName(); -#endif // the name of the loop (for F90.) - inline void setDoName(SgSymbol &doName);// sets the name of the loop(for F90) - - inline SgSymbol* constructName() - { - if (BIF_LL3(thebif)) - return SymbMapping(NODE_SYMB(BIF_LL3(thebif))); - return NULL; - } - - inline void setConstructName(SgSymbol* s) - { - BIF_LL3(thebif) = (new SgVarRefExp(s))->thellnd; - } - - inline SgExpression *start(); - inline void setStart(SgExpression &lbound); - - inline SgExpression *end(); - inline void setEnd(SgExpression &ubound); - - inline SgExpression *step(); - inline void setStep(SgExpression &step); - inline void interchangeNestedLoops(SgForStmt* loop); - inline void swapStartEnd() - { - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - std::swap(NODE_OPERAND0(BIF_LL1(thebif)), NODE_OPERAND1(BIF_LL1(thebif))); - else - SORRY; - } - else - SORRY; - } - inline SgLabel *endOfLoop(); - -//SgExpression &bounds(); // bounds are returned as a triplet lb:ub; -//void setBounds(SgTripletOp &bounds); // bounds are passed as a triplet lb:ub; - - // body is returned with control end statement - // still attached. - inline SgStatement *body(); - // s is assumed to terminate with a - // control end statement. - inline void set_body(SgStatement &s); -#if 0 - int replaceBody(SgStatement &s); // new body = s and lex successors. - - - int numberOfInductVars(); // 1 if an induction variable can be found. - SgSymbol *inductionVar(int i); // i-th induction variable - SgExpression *indVarRange(int i); // range of i-th ind. var. -#endif - inline int isPerfectLoopNest(); - inline SgStatement *getNextLoop(); - inline SgStatement *getPreviousLoop(); // returns outer nested loop - inline SgStatement *getInnermostLoop(); // returns innermost nested loop -#if 0 - int isLinearLoopNest(); // TRUE if the bound and step of the loops - // in the loop nest are linear expressions - // and use the index variables of the previous - // loops of the nest. -#endif - inline int isEnddoLoop(); // TRUE if the loop ends with an Enddo - inline int convertLoop(); // Convert the loop into a Good loop. -#if 0 - int isAssignLoop(); // TRUE if the body consists only of assignments - int isAssignIfLoop(); // TRUE if the body consists only of assigments - // and conditional statements. - //high level program transformations. - // Most are from SIGMA Toolbox by F.Bodin et al. - // Semantics can be found in the above reference. - int tiling_p(int i); - int tiling(int i, int tab[]); - int stripMining(int i); - SgStatement distributeLoop(int i); - SgStatement distributeLoopSCC(); - SgStatement loopFusion(SgForStmt &loop); - SgStatement unrollLoop(int i); - int interchangeLoops(SgForStmt &loop); - int interchangeWithLoop(int i); - int normalized(); - int NormalizeLoop(); - int vectorize(); - int vectorizeNest(); - int ExpandScalar(SgSymbol &symbol, int i); - int ScalarForwardSubstitution(SgSymbol &symbol); - int pullStatementToFront(SgStatement &s); - int pullStatementToEnd(SgStatement &s); -#endif - inline ~SgForStmt(); -}; - - -class SgProcessDoStmt: public SgStatement{ - // for Fortran M ProcessDo statement; - // variant = PROCESS_DO_STAT -public: - inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgExpression &step, - SgLabel &endofloop, SgStatement &body); - inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgLabel &endofloop, - SgStatement &body); - inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgExpression &step, - SgStatement &body); - inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgStatement &body); - //inline SgSymbol doName(); - inline void setDoName(SgSymbol &doName); - inline SgExpression *start(); - inline SgExpression *end(); - inline SgExpression *step(); - inline SgLabel *endOfLoop(); - // body is returned with control end statement - // still attached. - inline SgStatement *body(); - // s is assumed to terminate with a - // control end statement. - inline void set_body(SgStatement &s); - -#if 0 - int replaceBody(SgStatement &s); // new body = s and lex successors. - - - int numberOfInductVars(); // 1 if an induction variable can be found. - SgSymbol *inductionVar(int i); // i-th induction variable - SgExpression *indVarRange(int i); // range of i-th ind. var. -#endif - - inline int isPerfectLoopNest(); - inline SgStatement *getNextLoop(); - inline SgStatement *getPreviousLoop(); // returns outer nested loop - inline SgStatement *getInnermostLoop(); // returns innermost nested loop -#if 0 - int isLinearLoopNest(); // TRUE if the bound and step of the loops - // in the loop nest are linear expressions - // and use the index variables of the previous - // loops of the nest. -#endif - inline int isEnddoLoop(); // TRUE if the loop ends with an Enddo - inline int convertLoop(); // Convert the loop into a Good loop. -#if 0 - int isAssignLoop(); // TRUE if the body consists only of assignments - int isAssignIfLoop(); // TRUE if the body consists only of assignments - // and conditional statements. - //high level program transformations. - // Most are from SIGMA Toolbox by F.Bodin et al. - // Semantics can be found in the above reference. - int tiling_p(int i); - int tiling(int i, int tab[]); - int stripMining(int i); - SgStatement distributeLoop(int i); - SgStatement distributeLoopSCC(); - SgStatement loopFusion(SgForStmt &loop); - SgStatement unrollLoop(int i); - int interchangeLoops(SgForStmt &loop); - int interchangeWithLoop(int i); - int normalized(); - int NormalizeLoop(); - int vectorize(); - int vectorizeNest(); - int ExpandScalar(SgSymbol &symbol, int i); - int ScalarForwardSubstitution(SgSymbol &symbol); - int pullStatementToFront(SgStatement &s); - int pullStatementToEnd(SgStatement &s); -#endif - inline ~SgProcessDoStmt(); -}; - - -class SgWhileStmt: public SgStatement{ - // for C while() - // variant = WHILE_NODE -public: - inline SgWhileStmt(int variant); - inline SgWhileStmt(SgExpression &cond, SgStatement &body); - - // added by A.S.Kolganov 8.04.2015 - inline SgWhileStmt(SgExpression *cond, SgStatement *body); - inline SgExpression *conditional(); // the while test -#if 0 - int numberOfInductVars(); // 1 if an induction variable can be found. - SgSymbol *inductionVar(int i); // i-th induction variable - SgExpression *indVarRange(int i); // range of i-th ind. var. -#endif - inline void replaceBody(SgStatement &s); // new body = s and lex successors. - inline ~SgWhileStmt(); - - // added by A.V.Rakov 16.03.2015 - inline SgStatement *body(); - - inline SgLabel* endOfLoop( ); //label for end statement in Fortran 'do while' and 'do' loops (16.03.2013, Kataev) -}; - -class SgDoWhileStmt: public SgWhileStmt{ - // For Fortran dowhile().. and C do{....) while(); - // variant = DO_WHILE_NODE -public: - inline SgDoWhileStmt(SgExpression &cond, SgStatement &body); - inline ~SgDoWhileStmt(); -}; - -// forward reference; -class SgIfStmt; - -class SgLogIfStmt: public SgStatement{ - // For Fortran logical if - only one body statement allowed - // variant == LOGIF_NODE -public: - inline SgLogIfStmt(int variant); - inline SgLogIfStmt(SgExpression &cond, SgStatement &s); - inline SgStatement *body(); // returns reference to first stmt in the body - inline SgExpression *conditional(); // the while test - // check if the statement s is a single statement. - inline void setBody(SgStatement &s); // new body = s - // this code won't work, since after the addition false - // clause, it should become SgIfThenElse statement. - inline void addFalseClause(SgStatement &s); // make it into if-then-else - inline SgIfStmt *convertLogicIf(); - inline ~SgLogIfStmt(); -}; - -class SgIfStmt: public SgStatement{ - // For Fortran if then else and C if() - // variant == IF_NODE -public: - inline SgIfStmt(int variant); - inline SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody, - SgSymbol &construct_name); - inline SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody); - inline SgIfStmt(SgExpression &cond, SgStatement &trueBody); - - // added by A.S. Kolganov 02.07.2014, updated 21.12.2014 - inline SgIfStmt(SgExpression &cond, SgStatement &body, int t); - inline SgIfStmt(SgExpression &cond); - inline SgIfStmt(SgExpression* cond); - - // added by A.S. Kolganov 27.07.2018, - inline void setBodies(SgStatement *trueBody, SgStatement *falseBody); - inline SgStatement *trueBody(); // the first stmt in the True clause - // SgBlock is needed? - inline SgStatement *trueBody(int i); // i-th stmt in True clause - inline SgStatement *falseBody(); // the first stmt in the False - inline SgStatement *falseBody(int i);// i-th statement of the body. - inline SgExpression *conditional(); // the while test - inline SgSymbol *construct_name(); - inline void replaceTrueBody(SgStatement &s);// new body=s and lex successors. - inline void replaceFalseBody(SgStatement &s);//new body=s and lex successors. -// added by A.S. Kolganov 12.12.2024 - inline void setConditional(SgExpression* cond) { BIF_LL1(thebif) = cond->thellnd; } - inline ~SgIfStmt(); -}; - -#if 0 -class SgIfElseIfStmt: public SgIfStmt { - // For Fortran if then elseif .. elseif ... case - // variant == ELSEIF_NODE -public: - SgIfElseIfStmt(SgExpression &condList, SgStatement &blockList, SgSymbol &constructName); - SgIfElseIfStmt(SgExpression &condList, SgStatement &blockList); - int numberOfConditionals(); // the number of conditionals - SgStatement *body(int b); // block b - void setBody(int b); // sets block - SgExpression *conditional(int i); // the i-th conditional - void setConditional(int i); // sets the i-th conditional - void addClause(SgExpression &cond, SgStatement &block); - void removeClause(int b); // removes block b and it's conditional - ~SgIfElseIfStmt(); -}; - -inline SgIfElseIfStmt::~SgIfElseIfStmt() { RemoveFromTableBfnd((void *) this); } -#endif - - -class SgArithIfStmt: public SgStatement{ - // For Fortran Arithementic if - // variant == ARITHIF_NODE -public: - inline SgArithIfStmt(int variant); - inline SgArithIfStmt(SgExpression &cond, SgLabel &llabel, SgLabel &elabel, SgLabel &glabel); - inline SgExpression *conditional(); - inline void set_conditional(SgExpression &cond); - inline SgExpression *label(int i); // the <, ==, and > goto labels. in order 0->2. - inline void setLabel(SgLabel &label); - inline ~SgArithIfStmt(); -}; - -class SgWhereStmt: public SgLogIfStmt{ - // fortran Where stmt - // variant == WHERE_NODE -public: - inline SgWhereStmt(SgExpression &cond, SgStatement &body); - inline ~SgWhereStmt(); -}; - -class SgWhereBlockStmt: public SgIfStmt{ - // fortran Where - Elsewhere stmt - // variant == WHERE_BLOCK_STMT -public: - SgWhereBlockStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody); - ~SgWhereBlockStmt(); -}; - - -class SgSwitchStmt: public SgStatement{ - // Fortran Case and C switch(); - // variant == SWITCH_NODE -public: - inline SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList, SgSymbol &constructName); - // added by A.V.Rakov 16.03.2015 - inline SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList); - inline SgSwitchStmt(SgExpression &selector); - inline ~SgSwitchStmt(); - inline SgExpression *selector(); // the switch selector - inline void setSelector(SgExpression &cond); - inline int numberOfCaseOptions(); // the number of cases - inline SgStatement *caseOption(int i); // i-th case block - inline void addCaseOption(SgStatement &caseOption); - // added by A.V.Rakov 16.03.2015 - inline SgStatement *defOption(); -#if 0 - void deleteCaseOption(int i); -#endif -}; - -class SgCaseOptionStmt: public SgStatement{ - // Fortran case option statement - // variant == CASE_NODE -public: - // added by A.S.Kolganov 18.07.2018 - inline SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body); - inline SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body, SgSymbol &constructName); - // added by A.V.Rakov 16.03.2015 - inline SgCaseOptionStmt(SgExpression &caseRangeList); - inline ~SgCaseOptionStmt(); - - inline SgExpression *caseRangeList(); - inline void setCaseRangeList(SgExpression &caseRangeList); - inline SgExpression *caseRange(int i); - inline void setCaseRange(int i, SgExpression &caseRange); - inline SgStatement *body(); - inline void setBody(SgStatement &body); -}; - - -class SgExecutableStatement: public SgStatement{ - // this is really a non-control, non-declaration stmt. - // no special functions here. -public: - inline SgExecutableStatement(int variant); -}; - -class SgAssignStmt: public SgExecutableStatement{ - // Fortran assignment Statment - // variant == ASSIGN_STAT -public: - inline SgAssignStmt(int variant); - inline SgAssignStmt(SgExpression &lhs, SgExpression &rhs); - inline SgExpression *lhs(); // the left hand side - inline SgExpression *rhs(); // the right hand side - inline void replaceLhs(SgExpression &e); // replace lhs with e - inline void replaceRhs(SgExpression &e); // replace rhs with e -#if 0 - SgExpression *varReferenced(); - SgExpression *varUsed(); - SgExpression *varDefined(); -#endif -}; - - -class SgCExpStmt: public SgExecutableStatement{ - // C non-control expression Statment - // variant == EXPR_STMT_NODE -public: - inline SgCExpStmt(SgExpression &exp); - inline SgCExpStmt(SgExpression &lhs, SgExpression &rhs); - inline SgExpression *expr(); // the expression - inline void replaceExpression(SgExpression &e); // replace exp with e - inline ~SgCExpStmt(); -}; - -class SgPointerAssignStmt: public SgAssignStmt{ - // Fortran pointer assignment statement - // variant == POINTER_ASSIGN_STAT -public: - inline SgPointerAssignStmt(SgExpression lhs, SgExpression rhs); - inline ~SgPointerAssignStmt(); -}; - -// heap and nullify statements can be sub-classes -// of list executable statement class. -class SgHeapStmt: public SgExecutableStatement{ - // Fortran heap space allocation and deallocation statements - // variant == ALLOCATE_STMT or DEALLOCATE_STMT -public: - inline SgHeapStmt(int variant, SgExpression &allocationList, SgExpression &statVariable); - inline ~SgHeapStmt(); - inline SgExpression *allocationList(); - inline void setAllocationList(SgExpression &allocationList); - inline SgExpression *statVariable(); - inline void setStatVariable(SgExpression &statVar); -}; - -class SgNullifyStmt: public SgExecutableStatement{ - // Fortran pointer initialization statement - // variant == NULLIFY_STMT -public: - inline SgNullifyStmt(SgExpression &objectList); - inline ~SgNullifyStmt(); - inline SgExpression *nullifyList(); - inline void setNullifyList(SgExpression &nullifyList); -}; - - -class SgContinueStmt: public SgExecutableStatement{ - // variant == CONT_STAT in Fortran and - // variant == CONTINUE_NODE in C -public: - inline SgContinueStmt(); - inline ~SgContinueStmt(); -}; - -class SgControlEndStmt: public SgExecutableStatement{ - // the end of a basic block - // variant == CONTROL_END -public: - inline SgControlEndStmt(int variant); - inline SgControlEndStmt(); - inline ~SgControlEndStmt(); -}; - - -class SgBreakStmt: public SgExecutableStatement{ - // the end of a basic block - // variant == BREAK_NODE -public: - inline SgBreakStmt(); - inline ~SgBreakStmt(); -}; - -class SgCycleStmt: public SgExecutableStatement{ - // the fortran 90 cycle statement - // variant == CYCLE_STMT -public: - inline SgCycleStmt(SgSymbol &symbol); -// added by A.S. Kolganov 20.12.2015 - inline SgCycleStmt(); - inline SgSymbol *constructName(); // the name of the loop to cycle - inline void setConstructName(SgSymbol &constructName); - inline ~SgCycleStmt(); -}; - -class SgReturnStmt: public SgExecutableStatement{ - // the return (expr) node - // variant == RETURN_NODE//RETURN_STAT -public: - SgReturnStmt(SgExpression &returnValue); - SgReturnStmt(); - inline SgExpression *returnValue(); - inline void setReturnValue(SgExpression &retVal); - inline ~SgReturnStmt(); -}; - - -class SgExitStmt: public SgControlEndStmt{ - // the fortran 90 exit statement - // variant == EXIT_STMT -public: - inline SgExitStmt(SgSymbol &construct_name); - inline ~SgExitStmt(); - inline SgSymbol *constructName(); // the name of the loop to cycle - inline void setConstructName(SgSymbol &constructName); -}; - -class SgGotoStmt: public SgExecutableStatement{ - // the fortran or C goto - // variant == GOTO_NODE -public: - inline SgGotoStmt(SgLabel &label); - inline SgLabel *branchLabel(); -#if 0 - SgStatement *target(); //the statement we go to -#endif - inline ~SgGotoStmt(); -}; - - -class SgLabelListStmt: public SgExecutableStatement{ - // the fortran - // statements containg a list of labels -public: - SgLabelListStmt(int variant); - int numberOfTargets(); - SgExpression *labelList(); - void setLabelList(SgExpression &labelList); -#if 0 - SgStatement *target(int i); //the statement we go to -#endif -}; - - -class SgAssignedGotoStmt: public SgLabelListStmt{ - // the fortran - // variant == ASSGOTO_NODE -public: - SgAssignedGotoStmt(SgSymbol &symbol, SgExpression &labelList); - SgSymbol *symbol(); - void setSymbol(SgSymbol &symb); - ~SgAssignedGotoStmt(); -}; - - -class SgComputedGotoStmt: public SgLabelListStmt{ - // the fortran goto - // variant == COMGOTO_NODE -public: - inline SgComputedGotoStmt(SgExpression &expr, SgLabel &label); - inline void addLabel(SgLabel &label); - inline SgExpression *exp(); - inline void setExp(SgExpression &exp); - inline ~SgComputedGotoStmt(); -}; - -class SgStopOrPauseStmt: public SgExecutableStatement{ - // the fortran stop - // variant == STOP_STAT -public: - SgStopOrPauseStmt(int variant, SgExpression *expr); - SgExpression *exp(); - void setExp(SgExpression &exp); - ~SgStopOrPauseStmt(); -}; - -class SgCallStmt: public SgExecutableStatement{ - // the fortran call - // variant == PROC_STAT -public: - SgCallStmt(SgSymbol &name, SgExpression &args); - SgCallStmt(SgSymbol &name); - SgSymbol *name(); // name of subroutine being called - int numberOfArgs(); // the number of arguement expressions - void addArg(SgExpression &arg); - SgExpression *arg(int i); // the i-th argument expression - ~SgCallStmt(); - -#if 0 - // global analysis functions - int numberOfVarsUsed(); - SgExpression *varsUsed(int i); // i-th region description - int numberOfVarsMod(); - SgExpression *varsMod(int i); // i-th region description -#endif -}; - - -class SgProsCallStmt: public SgExecutableStatement{ - // the Fortran M process call - // variant == PROS_STAT -public: - SgProsCallStmt(SgSymbol &name, SgExprListExp &args); - SgProsCallStmt(SgSymbol &name); - SgSymbol *name(); // name of process being called - int numberOfArgs(); // the number of arguement expressions - void addArg(SgExpression &arg); - SgExprListExp *args(); - SgExpression *arg(int i); // the i-th argument expression - ~SgProsCallStmt(); -}; - - -class SgProsCallLctn: public SgExecutableStatement{ - // the Fortran M process call with location - // variant == PROS_STAT_LCTN -public: - SgProsCallLctn(SgSymbol &name, SgExprListExp &args, SgExprListExp &lctn); - SgProsCallLctn(SgSymbol &name, SgExprListExp &lctn); - SgSymbol *name(); // name of process being called - int numberOfArgs(); // the number of arguement expressions - void addArg(SgExpression &arg); - SgExprListExp *args(); - SgExpression *arg(int i); // the i-th argument expression - SgExpression *location(); - ~SgProsCallLctn(); -}; - - -class SgProsCallSubm: public SgExecutableStatement{ - // the Fortran M process call with submachine - // variant == PROS_STAT_SUBM -public: - SgProsCallSubm(SgSymbol &name, SgExprListExp &args, SgExprListExp &subm); - SgProsCallSubm(SgSymbol &name, SgExprListExp &subm); - SgSymbol *name(); // name of process being called - int numberOfArgs(); // the number of arguement expressions - void addArg(SgExpression &arg); - SgExprListExp *args(); - SgExpression *arg(int i); // the i-th argument expression - SgExpression *submachine(); - ~SgProsCallSubm(); -}; - - -class SgProcessesStmt: public SgStatement{ - // the Fortran M processes statement - // variant == PROCESSES_STAT -public: - inline SgProcessesStmt(); - inline ~SgProcessesStmt(); -}; - - -class SgEndProcessesStmt: public SgStatement{ - // the Fortran M endprocesses statement - // variant == PROCESSES_END -public: - inline SgEndProcessesStmt(); - inline ~SgEndProcessesStmt(); -}; - - -class SgPortTypeExp: public SgExpression{ - // variant == PORT_TYPE_OP, INPORT_TYPE_OP, or OUTPORT_TYPE_OP -public: - inline SgPortTypeExp(SgType &type); - inline SgPortTypeExp(SgType &type, SgExpression &ref); - inline SgPortTypeExp(int variant, SgExpression &porttype); - inline ~SgPortTypeExp(); - inline SgType *type(); - inline int numberOfRef(); - inline SgExpression *ref(); // return a ref or a port type - inline SgPortTypeExp *next(); -}; - - -class SgInportStmt: public SgStatement -{ - // the Fortran M inport statement - // variant == INPORT_DECL -public: - inline SgInportStmt(SgExprListExp &name); - inline SgInportStmt(SgExprListExp &name, SgPortTypeExp &porttype); - inline ~SgInportStmt(); - inline void addname(SgExpression &name); - inline int numberOfNames(); - inline SgExprListExp *names(); - inline SgExpression *name(int i); - inline void addporttype(SgExpression &porttype); - inline int numberOfPortTypes(); - inline SgPortTypeExp *porttypes(); - inline SgPortTypeExp *porttype(int i); -}; - - -class SgOutportStmt: public SgStatement{ - // the Fortran M outport statement - // variant == OUTPORT_DECL -public: - inline SgOutportStmt(SgExprListExp &name); - inline SgOutportStmt(SgExprListExp &name, SgPortTypeExp &porttype); - inline ~SgOutportStmt(); - inline void addname(SgExpression &name); - inline int numberOfNames(); - inline SgExprListExp *names(); - inline SgExpression *name(int i); - inline void addporttype(SgExpression &porttype); - inline int numberOfPortTypes(); - inline SgPortTypeExp *porttypes(); - inline SgPortTypeExp *porttype(int i); -}; - - -class SgChannelStmt: public SgStatement{ - // the Fortran M channel statement - // variant == CHANNEL_STAT -public: - inline SgChannelStmt(SgExpression &outport, SgExpression &inport); - inline SgChannelStmt(SgExpression &outport, SgExpression &inport, - SgExpression &io_or_err); - inline SgChannelStmt(SgExpression &outport, SgExpression &inport, - SgExpression &iostore, SgExpression &errlabel); - inline ~SgChannelStmt(); - inline SgExpression *outport(); - inline SgExpression *inport(); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); -}; - - -class SgMergerStmt: public SgStatement{ - // the Fortran M merger statement - // variant == MERGER_STAT -public: - inline SgMergerStmt(SgExpression &outport, SgExpression &inport); - inline SgMergerStmt(SgExpression &outport, SgExpression &inport, - SgExpression &io_or_err); - inline SgMergerStmt(SgExpression &outport, SgExpression &inport, - SgExpression &iostore, SgExpression &errlabel); - inline ~SgMergerStmt(); - inline void addOutport(SgExpression &outport); - inline void addIoStore(SgExpression &iostore); //can't add it before outports - inline void addErrLabel(SgExpression &errlabel); //can't add it before iostore - inline int numberOfOutports(); - inline SgExpression *outport(int i); - inline SgExpression *inport(); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); -}; - - -class SgMoveportStmt: public SgStatement{ - // the Fortran M moveport statement - // variant == MOVE_PORT -public: - inline SgMoveportStmt(SgExpression &fromport, SgExpression &toport); - inline SgMoveportStmt(SgExpression &fromport, SgExpression &toport, - SgExpression &io_or_err); - inline SgMoveportStmt(SgExpression &fromport, SgExpression &toport, - SgExpression &iostore, SgExpression &errlabel); - inline ~SgMoveportStmt(); - inline SgExpression *fromport(); - inline SgExpression *toport(); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); -}; - - -class SgSendStmt: public SgStatement{ - // the Fortran M send statement - // variant == SEND_STAT -public: - inline SgSendStmt(SgExpression &control, SgExprListExp &argument); - inline SgSendStmt(SgExpression &outport, SgExprListExp &argument, SgExpression &io_or_err); - inline SgSendStmt(SgExpression &outport, SgExprListExp &argument, SgExpression &iostore, SgExpression &errlabel); - inline ~SgSendStmt(); - inline void addOutport(SgExpression &outport); - inline void addIoStore(SgExpression &iostore); //can't add it before outports - inline void addErrLabel(SgExpression &errlabel); //can't add it before iostore - inline void addArgument(SgExpression &argument); - inline int numberOfOutports(); - inline int numberOfArguments(); - inline SgExpression *controls(); - inline SgExpression *outport(int i); - inline SgExprListExp *arguments(); - inline SgExpression *argument(int i); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); -}; - - -class SgReceiveStmt: public SgStatement{ - // the Fortran M receive statement - // variant == RECEIVE_STAT -public: - inline SgReceiveStmt(SgExpression &control, SgExprListExp &argument); - inline SgReceiveStmt(SgExpression &inport, SgExprListExp &argument, - SgExpression &e1); - inline SgReceiveStmt(SgExpression &inport, SgExprListExp &argument, - SgExpression &e1, SgExpression &e2); - inline SgReceiveStmt(SgExpression &inport, SgExprListExp &argument, - SgExpression &e1, SgExpression &e2, SgExpression &e3); - inline ~SgReceiveStmt(); - inline void addInport(SgExpression &inport); - inline void addIoStore(SgExpression &iostore);//can't add it before inports - inline void addErrLabel(SgExpression &errlabel);//can't add it before iostore - inline void addEndLabel(SgExpression &endlabel);//can't add it before errlabel - inline void addArgument(SgExpression &argument); - inline int numberOfInports(); - inline int numberOfArguments(); - inline SgExpression *controls(); - inline SgExpression *inport(int i); - inline SgExprListExp *arguments(); - inline SgExpression *argument(int i); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); - inline SgExpression *endLabel(); -}; - - - -class SgEndchannelStmt: public SgStatement{ - // the Fortran M endchannel statement - // variant == ENDCHANNEL_STAT -public: - inline SgEndchannelStmt(SgExpression &outport); - inline SgEndchannelStmt(SgExpression &outport, SgExpression &io_or_err); - inline SgEndchannelStmt(SgExpression &outport, SgExpression &iostore, - SgExpression &errlabel); - inline ~SgEndchannelStmt(); - inline void addOutport(SgExpression &outport); - inline void addIoStore(SgExpression &iostore);//can't add it before outports - inline void addErrLabel(SgExpression &errlabel);//can't add it before iostore - inline int numberOfOutports(); - inline SgExpression *controls(); - inline SgExpression *outport(int i); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); -}; - - -class SgProbeStmt: public SgStatement{ - // the Fortran M probe statement - // variant == PROBE_STAT -public: - inline SgProbeStmt(SgExpression &inport); - inline SgProbeStmt(SgExpression &inport, SgExpression &e1); - inline SgProbeStmt(SgExpression &inport, SgExpression &e1, - SgExpression &e2); - inline SgProbeStmt(SgExpression &inport, SgExpression &e1, - SgExpression &e2, SgExpression &e3); - inline ~SgProbeStmt(); - inline void addInport(SgExpression &inport); - inline void addIoStore(SgExpression &iostore);//can't add before inports - inline void addErrLabel(SgExpression &errlabel);//can't add before iostore - inline void addEmptyStore(SgExpression &endlabel);//can't add before errlabel - inline int numberOfInports(); - inline SgExpression *controls(); - inline SgExpression *inport(int i); - inline SgExpression *ioStore(); - inline SgExpression *errLabel(); - inline SgExpression *emptyStore(); -}; - - -class SgProcessorsRefExp: public SgExpression{ - // variant == PROCESSORS_REF -public: - inline SgProcessorsRefExp(PTR_LLND ll); - inline SgProcessorsRefExp(); - inline SgProcessorsRefExp(SgExpression &subscripts); - inline SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2); - - inline SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2, - SgExpression &sub3); - - inline SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2, - SgExpression &sub3,SgExpression &sub4); - inline ~SgProcessorsRefExp(); - inline int numberOfSubscripts(); // the number of subscripts in reference - inline SgExpression *subscripts(); - inline SgExpression *subscript(int i); - inline void addSubscript(SgExpression &e); -}; - - -class SgControlExp: public SgExpression{ - //parent of INPORT_NAME, OUTPORT_NAME, FROMPORT_NAME, TOPORT_NAME - // IOSTAT_STORE, EMPTY_STORE, ERR_LABEL, END_LABEL -public: - inline SgControlExp(int variant); - inline ~SgControlExp(); - inline SgExpression *exp(); -}; - - -class SgInportExp: public SgControlExp{ - // variant == INPORT_NAME -public: - inline SgInportExp(SgExprListExp &exp); - inline ~SgInportExp(); -}; - - -class SgOutportExp: public SgControlExp{ - // variant == OUTPORT_NAME -public: - inline SgOutportExp(SgExprListExp &exp); - inline ~SgOutportExp(); -}; - - -class SgFromportExp: public SgControlExp{ - // variant == FROMPORT_NAME -public: - inline SgFromportExp(SgExprListExp &exp); - inline ~SgFromportExp(); -}; - - -class SgToportExp: public SgControlExp{ - // variant == TOPORT_NAME -public: - inline SgToportExp(SgExprListExp &exp); - inline ~SgToportExp(); -}; - - -class SgIO_statStoreExp: public SgControlExp{ - // variant == IOSTAT_STORE -public: - inline SgIO_statStoreExp(SgExprListExp &exp); - inline ~SgIO_statStoreExp(); -}; - - -class SgEmptyStoreExp: public SgControlExp{ - // variant == EMPTY_STORE -public: - inline SgEmptyStoreExp(SgExprListExp &exp); - inline ~SgEmptyStoreExp(); -}; - - -class SgErrLabelExp: public SgControlExp{ - // variant == ERR_LABEL -public: - inline SgErrLabelExp(SgExprListExp &exp); - inline ~SgErrLabelExp(); -}; - - -class SgEndLabelExp: public SgControlExp{ - // variant == END_LABEL -public: - inline SgEndLabelExp(SgExprListExp &exp); - inline ~SgEndLabelExp(); -}; - - -class SgDataImpliedDoExp: public SgExpression{ - // variant == DATA_IMPL_DO -public: - inline SgDataImpliedDoExp(SgExprListExp &dlist, SgSymbol &iname, - SgExprListExp &ilist); - inline ~SgDataImpliedDoExp(); - inline void addDataelt(SgExpression &data); - inline void addIconexpr(SgExpression &icon); - inline SgSymbol *iname(); - inline int numberOfDataelt(); - inline SgExprListExp *dataelts(); - inline SgExprListExp *iconexprs(); /* only the first 3 elements in the - iconexpr list are useful. They represent - the initial value, the limit, and the - increment of the implied do expression - respectively */ - inline SgExpression *dataelt(int i); - inline SgExpression *init(); - inline SgExpression *limit(); - inline SgExpression *increment(); -}; - - -class SgDataEltExp: public SgExpression{ - // variant == DATA_ELT -public: - inline SgDataEltExp(SgExpression &dataimplieddo); - inline SgDataEltExp(SgSymbol &name, SgExpression &datasubs, - SgExpression &datarange); - inline ~SgDataEltExp(); - inline SgExpression *dataimplieddo(); - inline SgSymbol *name(); - inline SgExpression *datasubs(); - inline SgExpression *datarange(); -}; - - -class SgDataSubsExp: public SgExpression{ - // variant == DATA_SUBS -public: - inline SgDataSubsExp(SgExprListExp &iconexprlist); - inline ~SgDataSubsExp(); - inline SgExprListExp *iconexprlist(); -}; - - -class SgDataRangeExp: public SgExpression{ - // variant == DATA_RANGE -public: - inline SgDataRangeExp(SgExpression &iconexpr1, SgExpression &iconexpr2); - inline ~SgDataRangeExp(); - inline SgExpression *iconexpr1(); - inline SgExpression *iconexpr2(); -}; - - -class SgIconExprExp: public SgExpression{ - // variant == ICON_EXPR -public: - inline SgIconExprExp(SgExpression &expr); - inline ~SgIconExprExp(); - inline SgExpression *expr(); -}; - - -class SgIOStmt: public SgExecutableStatement{ - // fortran input/output and their control statements - // abstract class -public: - inline SgIOStmt(int variant); -}; - -class SgInputOutputStmt: public SgIOStmt{ - // fortran input and output statements - // variant = READ_STAT, WRITE_STATE, PRINT_STAT -public: - inline SgInputOutputStmt(int variant, SgExpression &specList, SgExpression &itemList); - inline SgExpression *specList(); - inline void setSpecList(SgExpression &specList); - inline SgExpression *itemList(); - inline void setItemList(SgExpression &itemList); - inline ~SgInputOutputStmt(); -}; - -class SgIOControlStmt: public SgExecutableStatement{ - // fortran input/output control and editing statements - // variant = OPEN_STAT, CLOSE_STAT, INQUIRE_STAT, BACKSPACE_STAT, - // REWIND_STAT, ENDFILE_STAT, FORMAT_STAT -public: - SgIOControlStmt(int variant, SgExpression &controlSpecifierList); - inline SgExpression *controlSpecList(); - inline void setControlSpecList(SgExpression &controlSpecList); - inline ~SgIOControlStmt(); -}; - -// ******************** Declaration Nodes *************************** - -class SgDeclarationStatement: public SgStatement{ - // Declaration class - // abstract class -public: - inline SgDeclarationStatement(int variant); - inline ~SgDeclarationStatement(); - - inline SgExpression *varList(); - inline int numberOfVars(); - inline SgExpression *var(int i); - inline void deleteVar(int i); - inline void deleteTheVar(SgExpression &var); - inline void addVar(SgExpression &exp); -}; - -class SgVarDeclStmt: public SgDeclarationStatement{ - // Declaration Statement - // variant == VAR_DECL -public: - // varRefValList is a list of low-level nodes of - // variants VAR_REFs or ARRAY_REFs or ASSIGN_OPs - inline SgVarDeclStmt(SgExpression &varRefValList, SgExpression &attributeList, SgType &type); - inline SgVarDeclStmt(SgExpression &varRefValList, SgType &type); - inline SgVarDeclStmt(SgExpression &varRefValList); - inline ~SgVarDeclStmt(); - inline SgType *type(); // the type; - inline int numberOfAttributes(); // the number of F90 attributes; - // the attributes are: PARAMETER_OP | PUBLIC_OP | - // PRIVATE_OP | ALLOCATABLE_OP | EXTERNAL_OP | - // OPTIONAL_OP | POINTER_OP | SAVE_OP TARGET_OP - - inline SgExpression* attribute(int i) - { - SgExpression* ex = LlndMapping(BIF_LL3(thebif)); - if (ex->variant() != EXPR_LIST) - return NULL; - - SgExprListExp* list = (SgExprListExp*)ex; - return list->elem(i); - } - - inline bool addAttributeExpression(SgExpression* attr) - { - SgExpression* ex = LlndMapping(BIF_LL3(thebif)); - if (ex && ex->variant() != EXPR_LIST) - return false; - - if (ex != NULL) - { - SgExprListExp* list = (SgExprListExp*)ex; - list->append(*attr); - } - else - { - ex = new SgExpression(EXPR_LIST, attr, NULL); - BIF_LL3(thebif) = ex->thellnd; - } - return true; - } - - inline int numberOfSymbols(); // the number of variables declared; - inline SgSymbol *symbol(int i); - - inline void deleteSymbol(int i); - inline void deleteTheSymbol(SgSymbol &symbol); - inline SgExpression *initialValue(int i); // the initial value ofthe i-th variable - SgExpression *completeInitialValue(int i); // The complete ASSGN_OP - // expression of the initial value *BW* from M. Golden - void setInitialValue(int i, SgExpression &initVal); // sets the initial value ofthe i-th variable - // an alternative way to initialize variables. The low-level node (VAR_REF or ARRAY_REF) is - // replaced by a ASSIGN_OP low-level node. - void clearInitialValue(int i); // removes initial value of the i-th declaration -}; - - -class SgIntentStmt: public SgDeclarationStatement{ - // the Fortran M Intent Statement - // variant == INTENT_STMT -public: - inline SgIntentStmt(SgExpression &varRefValList, SgExpression &attribute); - inline ~SgIntentStmt(); - inline int numberOfArgs(); // the number of arguement expressions - inline void addArg(SgExpression &arg); - inline SgExpression *args(); - inline SgExpression *arg(int i); // the i-th argument expression - inline SgExpression *attribute(); -}; - - -class SgVarListDeclStmt: public SgDeclarationStatement{ - // Declaration Statement - // variant == OPTIONAL_STMT, SAVE_STMT, PUBLIC_STMT, - // PRIVATE_STMT, EXTERNAL_STAT, INTRINSIC_STAT, DIM_STAT, - // ALLOCATABLE_STAT, POINTER_STAT, TARGET_STAT, MODULE_PROC_STMT, - // PROCESSORS_STAT (for Fortran M processors statement) -public: - SgVarListDeclStmt(int variant, SgExpression &symbolRefList); - SgVarListDeclStmt(int variant, SgSymbol &symbolList, SgStatement &scope); - - inline ~SgVarListDeclStmt(); - - inline int numberOfSymbols(); - inline SgSymbol *symbol(int i); - inline void appendSymbol(SgSymbol &symbol); - inline void deleteSymbol(int i); - inline void deleteTheSymbol(SgSymbol &symbol); -}; - - -class SgStructureDeclStmt: public SgDeclarationStatement{ - // Fortran 90 structure declaration statement - // variant == STRUCT_DECL -public: - SgStructureDeclStmt(SgSymbol &name, SgExpression &attributes, SgStatement &body); - ~SgStructureDeclStmt(); - -#if 0 - int isPrivate(); - int isPublic(); - int isSequence(); -#endif -}; - -class SgNestedVarListDeclStmt: public SgDeclarationStatement{ - // Declaration statement - // variant == NAMELIST_STAT, EQUI_STAT, COMM_STAT, - // and PROS_COMM for Fortran M - // These statements have the format of a list of variable lists. For example, - // EQUIVALENCE (A, C, D), (B, G, F), .... -public: - SgNestedVarListDeclStmt(int variant, SgExpression &listOfVarList); - // varList must be of low-level variant appropriate to variant. For example, - // if the variant is COMM_STAT, listOfVarList must be of variant COMM_LIST. - ~SgNestedVarListDeclStmt(); - - SgExpression *lists(); - int numberOfLists(); - SgExpression *list(int i); -#if 0 - SgExpression *leadingVar(int i); -#endif - void addList(SgExpression &list); - void addVarToList(SgExpression &varRef); - void deleteList(int i); - void deleteTheList(SgExpression &list); - void deleteVarInList(int i, SgExpression &varRef); - void deleteVarInTheList(SgExpression &list, SgExpression &varRef); -}; - -class SgParameterStmt: public SgDeclarationStatement{ - // Fortran constants declaration statement - // variant = PARAM_DECL -public: - SgParameterStmt() : SgDeclarationStatement(PARAM_DECL) { } - SgParameterStmt(SgExpression &constants, SgExpression &values); - SgParameterStmt(SgExpression &constantsWithValues); - ~SgParameterStmt(); - - int numberOfConstants(); // the number of constants declared - - SgSymbol *constant(int i); // the i-th variable - SgExpression *value(int i); // the value of i-th variable - - void addConstant(SgSymbol *constant); - void deleteConstant(int i); - void deleteTheConstant(SgSymbol &constant); -}; - -class SgImplicitStmt: public SgDeclarationStatement{ - // Fortran implicit type declaration statement - // variant = IMPL_DECL -public: - SgImplicitStmt(SgExpression& implicitLists); - SgImplicitStmt(SgExpression* implicitLists); - ~SgImplicitStmt(); - - int numberOfImplicitTypes(); // the number of implicit types declared; - SgType *implicitType(int i); // the i-th implicit type - SgExpression *implicitRangeList(int i) ; - void appendImplicitNode(SgExpression &impNode); -#if 0 - void addImplicitType(SgType Type, char alphabet[]); - int deleteImplicitItem(int i); - int deleteTheImplicitItem(SgExpression &implicitItem); -#endif -}; -#if 0 -class SgUseStmt: public SgDeclarationStatement{ - // Fortran 90 module usuage statement - // variant = USE_STMT -public: - SgUseStmt(SgSymbol &moduleName, SgExpression &renameList, SgStatement &scope); - // renameList must be a list of low-level nodes of variant RENAME_NODE - ~SgUseStmt(); - - int isOnly(); - SgSymbol *moduleName(); - void setModuleName(SgSymbol &moduleName); - int numberOfRenames(); - SgExpression *renameNode(int i); - void addRename(SgSymbol &localName, SgSymbol &useName); - void addRenameNode(SgExpression &renameNode); - void deleteRenameNode(int i); - void deleteTheRenameNode(SgExpression &renameNode); -}; - - - - -class SgStmtFunctionStmt: public SgDeclarationStatement{ - // Fortran statement function declaration - // variant == STMTFN_DECL -public: - SgStmtFunctionStmt(SgSymbol &name, SgExpression &args, SgStatement Body); - ~SgStmtFunctionStmt(); - SgSymbol *name(); - void setName(SgSymbol &name); - SgType *type(); - int numberOfParameters(); // the number of parameters - SgSymbol *parameter(int i); // the i-th parameter -}; - -class SgMiscellStmt: public SgDeclarationStatement{ - // Fortran 90 simple miscellaneous statements - // variant == CONTAINS_STMT, PRIVATE_STMT, SEQUENCE_STMT -public: - SgMiscellStmt(int variant); - ~SgMiscellStmt(); -}; - - -#endif -// -// -// More stuffs for types and symbols -// -// - - -class SgVariableSymb: public SgSymbol{ - // a variable - // variant = VARIABLE_NAME -public: - inline SgVariableSymb(char *identifier, SgType &t, SgStatement &scope); - inline SgVariableSymb(char *identifier, SgType *t, SgStatement *scope); - inline SgVariableSymb(char *identifier, SgType &t); - inline SgVariableSymb(char *identifier, SgStatement &scope); - inline SgVariableSymb(char *identifier, SgStatement *scope); - inline SgVariableSymb(char *identifier); - inline SgVariableSymb(const char *identifier, SgType &t, SgStatement &scope); - inline SgVariableSymb(const char *identifier, SgType *t, SgStatement *scope); - inline SgVariableSymb(const char *identifier, SgType &t); - inline SgVariableSymb(const char *identifier, SgStatement &scope); - inline SgVariableSymb(const char *identifier, SgStatement *scope); - inline SgVariableSymb(const char *identifier); - inline ~SgVariableSymb(); - - /* This function allocates and returns a new variable reference - expression to this symbol. (ajm) */ - inline SgVarRefExp *varRef (void); - -#if 0 - int isAttributeSet(int attribute); - void setAttribute(int attribute); - - int numberOfUses(); // number of uses. - SgStatement *useStmt(int i); // statement where i-th use occurs - SgExpression *useExpr(int i); // expression where i-th use occurs - int numberOfDefs(); -#endif -}; - -class SgConstantSymb: public SgSymbol{ - // a symbol for a constant object - // variant == CONST_NAME -public: - inline SgConstantSymb(char *identifier, SgStatement &scope, - SgExpression &value); - inline SgConstantSymb(const char *identifier, SgStatement &scope, - SgExpression &value); - inline ~SgConstantSymb(); - inline SgExpression *constantValue(); -}; - - -class SgFunctionSymb: public SgSymbol{ - // a subroutine, function or main program - // variant == PROGRAM_NAME, PROCEDURE_NAME, or FUNCTION_NAME -public: - SgFunctionSymb(int variant); - SgFunctionSymb(int variant, char *identifier, SgType &t, - SgStatement &scope); - SgFunctionSymb(int variant, const char *identifier, SgType &t, - SgStatement &scope); - ~SgFunctionSymb(); - void addParameter(int, SgSymbol ¶meters); - void insertParameter(int position, SgSymbol &symb); - int numberOfParameters(); - SgSymbol *parameter(int i); - SgSymbol *result(); - void setResult(SgSymbol &symbol); -#if 0 - int isRecursive(); - int setRecursive(); -#endif -}; - - -class SgMemberFuncSymb: public SgFunctionSymb{ - // a member function for a class or struct or collection - // variant = MEMBER_FUNC - // may be either MEMB_PRIVATE, MEMB_PUBLIC, - // MEMP_METHOELEM or MEMB_PROTECTED -public: - inline SgMemberFuncSymb(char *identifier, SgType &t, SgStatement &cla, - int status); - inline ~SgMemberFuncSymb(); -#if 0 - int status(); - int isVirtual(); // 1 if virtual. -#endif - inline int isMethodOfElement(); - inline SgSymbol *className(); - inline void setClassName(SgSymbol &symb); -}; - -class SgFieldSymb: public SgSymbol{ - // a field in an enum or in a struct. - // variant == ENUM_NAME or FIELD_NAME -public: - // no check is made to see if the field "identifier" - // already exists in the structure. - inline SgFieldSymb(char *identifier, SgType &t, SgSymbol &structureName); - inline SgFieldSymb(const char *identifier, SgType &t, SgSymbol &structureName); - inline ~SgFieldSymb(); - inline int offset(); // position in the structure - inline SgSymbol *structureName(); // parent structure - inline SgSymbol *nextField(); - inline int isMethodOfElement(); -#if 0 - int isPrivate(); - int isSequence(); - void setPrivate(); - void setSequence(); -#endif -}; - -class SgClassSymb: public SgSymbol{ - // the class, union, struct and collection type. - // variant == CLASS_NAME, UNION_NAME, STRUCT_NAME or COLLECTION_NAME -public: - inline SgClassSymb(int variant, char *name, SgStatement &scope); - inline ~SgClassSymb(); - inline int numberOfFields(); - inline SgSymbol *field(int i); -}; - -#if 0 -class SgTypeSymb: public SgSymbol{ - // a C typedef. the type() function returns the base type. - // variant == TYPE_NAME -public: - SgTypeSymb(char *name, SgType &baseType); - SgType &baseType(); - ~SgTypeSymb(); -}; - -#endif - - -class SgLabelSymb: public SgSymbol{ - // a C label name - // variant == LABEL_NAME -public: - inline SgLabelSymb(char *name); - inline ~SgLabelSymb(); -}; - - -class SgLabelVarSymb: public SgSymbol{ - // a Fortran label variable for an assigned goto stmt - // variant == LABEL_NAME -public: - inline SgLabelVarSymb(char *name, SgStatement &scope); - inline ~SgLabelVarSymb(); -}; - -class SgExternalSymb: public SgSymbol{ - // for fortran external statement - // variant == ROUTINE_NAME -public: - inline SgExternalSymb(char *name, SgStatement &scope); - inline ~SgExternalSymb(); -}; - -class SgConstructSymb: public SgSymbol{ - // for fortran statement with construct names - // variant == CONSTRUCT_NAME -public: - inline SgConstructSymb(char *name, SgStatement &scope); - inline ~SgConstructSymb(); -}; - -// A lot of work needs to be done on this class. -class SgInterfaceSymb: public SgSymbol{ - // for fortran interface statement - // variant == INTERFACE_NAME -public: - inline SgInterfaceSymb(char *name, SgStatement &scope); - inline ~SgInterfaceSymb(); -}; - -// A lot of work needs to be done on this class. -class SgModuleSymb: public SgSymbol{ - // for fortran module statement - // variant == MODULE_NAME -public: - inline SgModuleSymb(char *name); - inline ~SgModuleSymb(); -}; - -// ********************* Types ******************************* - -class SgArrayType: public SgType{ - // A new array type is generated for each array. - // variant == T_ARRAY -public: - inline SgArrayType(SgType &base_type); - inline int dimension(); - inline SgExpression *sizeInDim(int i); - inline void addDimension(SgExpression *e); - inline SgExpression * getDimList(); - inline SgType * baseType(); - inline void setBaseType(SgType &bt); - inline void addRange(SgExpression &e); - inline ~SgArrayType(); -}; - - -#if 0 -class SgClassType: public SgType{ - // a C struct or Fortran Record, a C++ class, a C Union and a C Enum - // and a pC++ collection. note: derived classes are another type. - // this type is very simple. it only contains the standard type - // info from SgType and a pointer to the class declaration stmt - // and a pointer to the symbol that is the first field in the struct. - // variant == T_STRUCT, T_ENUM, T_CLASS, T_ENUM, T_COLLECTION -public: - // why is struct_decl needed. No appropriate field found. - // assumes that first_field has been declared as - // FIELD_NAME and the remaining fields have been stringed to it. - SgClassType(int variant, char *name, SgStatement &struct_decl, int num_fields, - SgSymbol &first_field); - SgStatement &structureDecl(); - SgSymbol *firstFieldSymb(); - SgSymbol *fieldSymb(int i); - ~SgClassType(); -}; - -#endif - - -class SgPointerType: public SgType{ - // A pointer type contains only one hany bit of information: - // the base type. - // can also have a modifier like BIT_CONST BIT_GLOBAL. see SgDescriptType. - // variant == T_POINTER -public: - SgPointerType(SgType &base_type); - SgPointerType(SgType *base_type); - inline SgType *baseType(); - inline int indirection(); - inline void setIndirection(int); - inline int modifierFlag(); - inline void setModifierFlag(int flag); - inline void setBaseType(SgType &baseType); - inline ~SgPointerType(); -}; - - -class SgFunctionType: public SgType{ - // Function Types have a returned value type - // variant == T_FUNCTION -public: - SgFunctionType(SgType &return_val_type); - SgType *returnedValue(); - void changeReturnedValue(SgType &rv); - ~SgFunctionType(); -}; - - -class SgReferenceType: public SgType{ - // A reference (&xx in c+=) type contains only one hany bit of information: - // the base type. - // variant == T_REFERENCE -public: - inline SgReferenceType(SgType &base_type); - inline SgType *baseType(); - inline void setBaseType(SgType &baseType); - inline ~SgReferenceType(); - inline int modifierFlag(); - inline void setModifierFlag(int flag); -}; - -class SgDerivedType: public SgType{ - // for example: typedef int integer; go to the symbol table - // for the base type and Id. - // variant == T_DERIVED_TYPE -public: - inline SgDerivedType(SgSymbol &type_name); - inline SgSymbol * typeName(); - inline ~SgDerivedType(); -}; - -class SgDerivedClassType: public SgType{ - // for example: typedef int integer; go to the symbol table - // for the base type and Id. - // variant == T_DERIVED_CLASS -public: - inline SgDerivedClassType(SgSymbol &type_name); - inline SgSymbol *typeName(); - inline ~SgDerivedClassType(); -}; - -class SgDerivedTemplateType: public SgType{ - // this is the type for a template object: T_DERIVED_TEMPLATE -public: - SgDerivedTemplateType(SgExpression *arg_vals, SgSymbol *classname); - SgExpression *argList(); - void addArg(SgExpression *arg); - int numberOfArgs(); - SgExpression *arg(int i); - void setName(SgSymbol &s); - SgSymbol *typeName(); // the name of the template class. -}; - -class SgDescriptType: public SgType{ - // for example in C: long volatile int x; - // long and volatile are modifiers and there is a descriptor - // type whose base type is the real type of x. - // the modifier is an integer with bits set if the modifier - // holds. - // the bits are: - // BIT_SYN, BIT_SHARED, BIT_PRIVATE, BIT_FUTURE, BIT_VIRTUAL, - // BIT_INLINE, BIT_UNSIGNED, BIT_SIGNED, BIT_LONG, BIT_SHORT, - // BIT_VOLATILE, BIT_CONST, BIT_TYPEDEF, BIT_EXTERN, BIT_AUTO, - // BIT_STATIC, BIT_REGISTER, BIT_FRIEND, BIT_GLOBAL, and more. - // - // variant = T_DESCRIPT -public: - inline SgDescriptType(SgType &base_type, int bit_flag); - inline int modifierFlag(); - inline void setModifierFlag(int flag); - inline ~SgDescriptType(); -}; - -class SgDerivedCollectionType: public SgType{ - // for example: - // Collection DistributedArray {body1} ; - // class object {body2} ; - // DistributedArray X; - // X is of type with variant = T_DERIVED_COLLECTION -public: - inline SgDerivedCollectionType(SgSymbol &s, SgType &t); - inline SgType *elementClass(); - inline void setElementClass(SgType &ty); - inline SgSymbol *collectionName(); - inline SgStatement *createCollectionWithElemType(); - inline ~SgDerivedCollectionType(); -}; - -// Class definition ends; Inline definitions begin - -// SgProject--inlines - -inline SgProject::~SgProject() -{ -#if __SPF - removeFromCollection(this); -#endif -} -inline SgProject::SgProject(SgProject &) -{ - Message("SgProject copy constructor not allowed",0); -#if __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif -} - -inline int SgProject::numberOfFiles() -{ return LibnumberOfFiles(); } - -inline char *SgProject::fileName(int i) -{ - PTR_FILE file; - char * x; - - file = GetFileWithNum(i); - SetCurrentFileTo(file); - SwitchToFile(GetFileNumWithPt(file)); - if (!file) - x = NULL; - else - x = FILE_FILENAME(file); - return x; -} - -inline int SgProject::Fortranlanguage() -{ return LibFortranlanguage(); } - -inline int SgProject::Clanguage() -{ return LibClanguage(); } - - -// SgFile--inlines -inline int SgFile::languageType() -{ return FILE_LANGUAGE(filept); } - -inline void SgFile::saveDepFile(const char *dep_file) -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - LibsaveDepFile(dep_file); -// id may have change all the bifnode class are deleted.... - ResetbfndTableClass(); -} - -inline void SgFile::unparse(FILE *filedisc) -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - UnparseProgram(filedisc); -} - -inline void SgFile::unparseS(FILE *filedisc, int size) -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - UnparseProgram_ThroughAllocBuffer(filedisc,filept,size); -} - - -inline void SgFile::unparsestdout() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - UnparseProgram(stdout); -} - - -inline SgStatement *SgFile::mainProgram() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - return BfndMapping(getMainProgram()); -} - -inline int SgFile::numberOfFunctions() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - return getNumberOfFunction(); -} - -inline int SgFile::numberOfStructs() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - return getNumberOfStruct(); -} - -inline SgStatement *SgFile::firstStatement() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - SgStatement* retVal = BfndMapping(getFirstStmt()); -#ifdef __SPF - if (retVal) - { - SgStatement::setCurrProcessFile(retVal->fileName()); - SgStatement::setCurrProcessLine(0); - } -#endif - return retVal; -} - -inline SgSymbol *SgFile::firstSymbol() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - return SymbMapping(PROJ_FIRST_SYMB ()); -} - -inline SgExpression *SgFile::firstExpression() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - return LlndMapping(PROJ_FIRST_LLND ()); -} - -inline SgType *SgFile::firstType() -{ - SetCurrentFileTo(filept); - SwitchToFile(GetFileNumWithPt(filept)); - return TypeMapping(PROJ_FIRST_TYPE ()); -} - - -inline SgExpression *SgFile::SgExpressionWithId(int i) -{ return LlndMapping(Get_ll_with_id (i));} - -inline SgStatement *SgFile::SgStatementWithId( int id) -{ return BfndMapping(Get_bif_with_id (id)); } - -inline SgStatement *SgFile::SgStatementAtLine(int lineno) -{ return BfndMapping(rec_num_near_search(lineno));} - -inline SgSymbol *SgFile::SgSymbolWithId( int id) -{ return SymbMapping(Get_Symb_with_id (id)); } - -inline SgType *SgFile::SgTypeWithId( int id) -{ return TypeMapping(Get_type_with_id (id)); } - - - -// SgStatement--inlines - -inline int SgStatement::lineNumber() -{ return BIF_LINE(thebif); } - -inline int SgStatement::localLineNumber() -{ return BIF_LOCAL_LINE(thebif); } - -inline int SgStatement::id() -{ return BIF_ID(thebif);} - -inline int SgStatement::variant() -{ return BIF_CODE(thebif); } - -// inline functions should contain single return -// hence int x is needed. -inline int SgStatement::hasSymbol() -{ - int x; - - if (BIF_SYMB(thebif)) - x = TRUE; - else - x = FALSE; - - return x; -} - -inline SgSymbol * SgStatement::symbol() -{ -#ifdef __SPF - checkConsistence(); -#endif - return SymbMapping(BIF_SYMB(thebif)); -} - -inline char * SgStatement::fileName() -{ return BIF_FILE_NAME(thebif)->name; } - -inline void SgStatement::setFileName(char *newFile) -{ -#ifdef __SPF - checkConsistence(); -#endif - BIF_FILE_NAME(thebif)->name = newFile; -} - -inline int SgStatement::hasLabel() -{ - int x; - if (BIF_LABEL(thebif)) - x = TRUE; - else - x = FALSE; - return x; -} - -inline void SgStatement::setlineNumber(const int n) -{ BIF_LINE(thebif) = n; } - -inline void SgStatement::setLocalLineNumber(const int n) -{ BIF_LOCAL_LINE(thebif) = n; } - -inline void SgStatement::setId(int) -{ Message("Id cannot be changed",BIF_LINE(thebif)); } - -inline void SgStatement::setVariant(int n) -{ BIF_CODE(thebif) = n; } - -inline void SgStatement::setLabel(SgLabel &l) -{ -#ifdef __SPF - checkConsistence(); -#endif - BIF_LABEL(thebif) = l.thelabel; -} - -inline void SgStatement::deleteLabel(bool saveLabel) -{ -#ifdef __SPF - checkConsistence(); -#endif - if (!saveLabel) - if (BIF_LABEL(thebif)) - BIF_LABEL(thebif)->stateno = -1; - BIF_LABEL(thebif) = NULL; -} - -inline void SgStatement::setSymbol(SgSymbol &s) -{ -#ifdef __SPF - checkConsistence(); -#endif - BIF_SYMB(thebif) = s.thesymb; -} - - -inline SgStatement * SgStatement::lexNext() -{ -#ifdef __SPF - checkConsistence(); -#endif - SgStatement* retVal = BfndMapping(BIF_NEXT(thebif)); -#ifdef __SPF - if (retVal) - setCurrProcessLine(retVal->lineNumber()); -#endif - return retVal; -} - -inline SgStatement * SgStatement::lexPrev() -{ -#ifdef __SPF - checkConsistence(); -#endif - SgStatement* retVal = BfndMapping(getNodeBefore(thebif)); -#ifdef __SPF - if (retVal) - setCurrProcessLine(retVal->lineNumber()); -#endif - return retVal; -} - - -inline SgStatement * SgStatement::controlParent() -{ -#ifdef __SPF - checkConsistence(); -#endif - if (this->variant() != GLOBAL) - return BfndMapping(BIF_CP(thebif)); - else - return 0; -} - -inline int SgStatement::numberOfChildrenList1() -{ -#ifdef __SPF - checkConsistence(); -#endif - return (blobListLength(BIF_BLOB1(thebif))); -} - -inline int SgStatement::numberOfChildrenList2() -{ -#ifdef __SPF - checkConsistence(); -#endif - return (blobListLength(BIF_BLOB2(thebif))); -} - -inline SgStatement * SgStatement::childList1(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(childfInBlobList(BIF_BLOB1(thebif),i)); -} - -inline SgStatement * SgStatement::childList2(int i) -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(childfInBlobList(BIF_BLOB2(thebif),i)); -} - - -inline void SgStatement::setLexNext(SgStatement &s) -{ -#ifdef __SPF - checkConsistence(); -#endif - BIF_NEXT(thebif) = s.thebif; -} - -inline void SgStatement::setLexNext(SgStatement* s) -{ -#ifdef __SPF - checkConsistence(); -#endif - if (s) - BIF_NEXT(thebif) = s->thebif; - else - BIF_NEXT(thebif) = NULL; -} - -inline SgStatement * SgStatement::lastDeclaration() -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(LiblastDeclaration(thebif)); -} - - -inline SgStatement * SgStatement::lastExecutable() -{ -#ifdef __SPF - checkConsistence(); -#endif - PTR_BFND last; - last = getLastNodeOfStmt(thebif); - last = getNodeBefore(last); - return BfndMapping(last); -} - -inline SgStatement *SgStatement::lastNodeOfStmt() -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(getLastNodeOfStmt(thebif)); -} - -inline SgStatement *SgStatement::nodeBefore() -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(getNodeBefore(thebif)); -} - -inline void SgStatement::insertStmtBefore(SgStatement &s,SgStatement &cp ) -{ -#ifdef __SPF - checkConsistence(); - - //convert to simple IF - if (cp.variant() == LOGIF_NODE) - { - SgControlEndStmt* control = new SgControlEndStmt(); - cp.setVariant(IF_NODE); - this->insertStmtAfter(*control, cp); - } -#endif - insertBfndBeforeIn(s.thebif,thebif,cp.thebif); -} - - -inline SgStatement * SgStatement::extractStmt() -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(LibextractStmt(thebif)); -} - -inline SgStatement *SgStatement::extractStmtBody() -{ -#ifdef __SPF - checkConsistence(); -#endif - return BfndMapping(LibextractStmtBody(thebif)); -} - -inline void SgStatement::replaceWithStmt(SgStatement &s) -{ -#ifdef __SPF - checkConsistence(); -#endif - LibreplaceWithStmt(thebif,s.thebif); -} - -inline void SgStatement::deleteStmt() -{ -#ifdef __SPF - checkConsistence(); -#endif - LibdeleteStmt(thebif); -} - -inline int SgStatement::isIncludedInStmt(SgStatement &s) -{ -#ifdef __SPF - checkConsistence(); -#endif - return isInStmt(thebif, s.thebif); -} - -inline SgStatement &SgStatement::copy() -{ - return *copyPtr(); -} - -inline SgStatement *SgStatement::copyPtr() -{ -#ifdef __SPF - checkConsistence(); -#endif - SgStatement *copy = BfndMapping(duplicateStmtsNoExtract(thebif)); - -#ifdef __SPF - copy->setProject(project); - copy->setFileId(fileID); - copy->setUnparseIgnore(unparseIgnore); -#endif - return copy; -} - -inline SgStatement & SgStatement::copyOne() -{ - return *copyOnePtr(); -} - -inline SgStatement * SgStatement::copyOnePtr() -{ -#ifdef __SPF - checkConsistence(); -#endif - SgStatement *new_stmt = BfndMapping(duplicateOneStmt(thebif)); - - /* Hackery to make sure the control parent propagates correctly. - Unfortunately, the copy function itself it badly broken. */ - - new_stmt->setControlParent (this->controlParent()); -#ifdef __SPF - new_stmt->setProject(project); - new_stmt->setFileId(fileID); - new_stmt->setUnparseIgnore(unparseIgnore); -#endif - return new_stmt; -} - -inline SgStatement& SgStatement::copyBlock() -{ return *copyBlockPtr(); } - -inline SgStatement *SgStatement::copyBlockPtr() -{ return copyBlockPtr(0); } - -inline SgStatement* SgStatement::copyBlockPtr(int saveLabelId) -{ -#ifdef __SPF - checkConsistence(); -#endif - SgStatement *new_stmt = BfndMapping(duplicateStmtsBlock(thebif, saveLabelId)); -#ifdef __SPF - new_stmt->setProject(project); - new_stmt->setFileId(fileID); - new_stmt->setUnparseIgnore(unparseIgnore); -#endif - return new_stmt; -} - -inline void SgStatement::replaceSymbByExp(SgSymbol &symb, SgExpression &exp) -{ - LibreplaceSymbByExpInStmts(thebif, getLastNodeOfStmt(thebif), symb.thesymb, exp.thellnd); -} - -inline void SgStatement::replaceSymbBySymb(SgSymbol &symb,SgSymbol &newsymb ) -{ -#ifdef __SPF - checkConsistence(); -#endif - replaceSymbInStmts(thebif, getLastNodeOfStmt(thebif), symb.thesymb, newsymb.thesymb); -} - -inline void SgStatement::replaceSymbBySymbSameName(SgSymbol &symb,SgSymbol &newsymb) -{ -#ifdef __SPF - checkConsistence(); -#endif - replaceSymbInStmtsSameName(thebif, getLastNodeOfStmt(thebif), symb.thesymb, newsymb.thesymb); -} - -inline void SgStatement::replaceTypeInStmt(SgType &old, SgType &newtype) -{// do redundant work by should be ok go twice in member function -#ifdef __SPF - checkConsistence(); -#endif - if (BIF_SYMB(thebif)) - replaceTypeUsedInStmt(BIF_SYMB(thebif),thebif,old.thetype,newtype.thetype); - else - replaceTypeUsedInStmt(NULL,thebif,old.thetype,newtype.thetype); -} - -inline void SgStatement::setComments(char *comments) -{ - checkCommentPosition(comments); - LibSetAllComments (thebif, comments); -} - -inline void SgStatement::setComments(const char *comments) -{ - checkCommentPosition(comments); - LibSetAllComments(thebif, comments); -} - -inline void SgStatement::delComments() -{ -#ifdef __SPF - checkConsistence(); -#endif - LibDelAllComments(thebif); -} - - -inline SgStatement *SgStatement::getScopeForDeclare() -{ - return BfndMapping(LibGetScopeForDeclare(thebif)); -} - -//Kataev 07.03.2013 -inline char* SgStatement::unparse(int lang) -{ -#ifdef __SPF - checkConsistence(); -#endif - return UnparseBif_Char(thebif, lang); //0 - fortran language -} - -inline void SgStatement::unparsestdout() -{ - UnparseBif(thebif); -} - -inline char* SgStatement::comments() -{ - char *x; - - if (BIF_CMNT(thebif)) - x = CMNT_STRING(BIF_CMNT(thebif)); - else - x = NULL; - - return x; -} - -inline void SgStatement::addDeclSpec(int type) -{ -#ifdef __SPF - checkConsistence(); -#endif - BIF_DECL_SPECS(thebif) = BIF_DECL_SPECS(thebif) | type; -} - -inline void SgStatement::clearDeclSpec() -{ -#ifdef __SPF - checkConsistence(); -#endif - BIF_DECL_SPECS(thebif) = 0; -} - -inline int SgStatement::isFriend() -{ - return (BIF_DECL_SPECS(thebif) & BIT_FRIEND); -} - -inline int SgStatement::isInline() -{ - return (BIF_DECL_SPECS(thebif) & BIT_INLINE); -} - -inline int SgStatement::isExtern() -{ - return (BIF_DECL_SPECS(thebif) & BIT_EXTERN); -} - -inline int SgStatement::isStatic() -{ - return (BIF_DECL_SPECS(thebif) & BIT_STATIC); -} - - -// SgExpression--inlines - -inline SgExpression *SgExpression::lhs() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression *SgExpression::rhs() -{ return LlndMapping(NODE_OPERAND1(thellnd)); } - -inline SgExpression *SgExpression::nextInExprTable() -{ return LlndMapping(NODE_NEXT(thellnd)); } - -inline int SgExpression::variant() -{ return NODE_CODE(thellnd); } - -inline SgType *SgExpression::type() -{ return TypeMapping(NODE_TYPE(thellnd)); } - -inline int SgExpression::id() -{ return NODE_ID(thellnd); } - -inline void SgExpression::setLhs(SgExpression &e) -{ NODE_OPERAND0(thellnd) = e.thellnd; } - -inline void SgExpression::setLhs(SgExpression *e) -{ NODE_OPERAND0(thellnd) = (e == 0) ? 0 : e->thellnd; } - -inline void SgExpression::setRhs(SgExpression &e) -{ NODE_OPERAND1(thellnd) = e.thellnd; } - -inline void SgExpression::setRhs(SgExpression *e) -{ NODE_OPERAND1(thellnd) = ( e == 0 ) ? 0 : e->thellnd; } - -inline void SgExpression::setSymbol(SgSymbol &s) -{ NODE_SYMB(thellnd) = s.thesymb; } - -inline void SgExpression::setSymbol(SgSymbol *s) -{ NODE_SYMB(thellnd) = ( s == 0 ) ? 0 : s->thesymb; } - -inline void SgExpression::setType(SgType &t) -{ NODE_TYPE(thellnd) = t.thetype; } - -inline void SgExpression::setType(SgType *t) -{ NODE_TYPE(thellnd) = (t == 0) ? 0 : t->thetype; } - -inline void SgExpression::setVariant(int v) -{ - Message("Variant of a low level node node should not be change",0); - NODE_CODE(thellnd) = v; -} - -inline SgExpression &SgExpression::copy() -{ return *copyPtr(); } - -inline SgExpression *SgExpression::copyPtr() -{ return LlndMapping(copyLlNode(thellnd)); } - - -inline SgExpression *SgExpression::IsSymbolInExpression(SgSymbol &symbol) -{ return LlndMapping(LibIsSymbolInExpression(thellnd, symbol.thesymb)); } - -inline void SgExpression::replaceSymbolByExpression(SgSymbol &symbol, SgExpression &expr) -{ LibreplaceSymbByExp(thellnd, symbol.thesymb, expr.thellnd); } - -inline SgExpression *SgExpression::arrayRefs() -{ return LlndMapping(LibarrayRefs(thellnd)); } - -inline SgExpression *SgExpression::symbRefs() -{ return LlndMapping(LibsymbRefs(thellnd,NULL));} - -//Kataev 07.03.2013, update 19.10.2013 -inline char* SgExpression::unparse() -{ - return UnparseLLND_Char(thellnd); -} -// podd 08.04.24 -inline char* SgExpression::unparse(int lang) //0 - Fortran, 1 - C -{ - return UnparseLLnode_Char(thellnd,lang); -} - -inline void SgExpression::unparsestdout() -{ - UnparseLLND(thellnd); - printf("\n"); -} - - -// SgSymbol--inlines -inline int SgSymbol::variant() const -{ return SYMB_CODE(thesymb); } - -inline int SgSymbol::id() const -{ return SYMB_ID(thesymb); } - -inline char *SgSymbol::identifier() const -{ return SYMB_IDENT(thesymb); } - -inline SgType *SgSymbol::type() -{ return TypeMapping(SYMB_TYPE(thesymb)); } - - -inline void SgSymbol::setType(SgType &t) -{ SYMB_TYPE(thesymb) = t.thetype; } - -inline void SgSymbol::setType(SgType *t) -{ SYMB_TYPE(thesymb) = (t == 0) ? 0 : t->thetype; } - -inline SgStatement *SgSymbol::scope() -{ return BfndMapping(SYMB_SCOPE(thesymb)); } - -inline SgSymbol *SgSymbol::next() -{ return SymbMapping(SYMB_NEXT(thesymb));} - -inline SgSymbol &SgSymbol::copy() -{ - SgSymbol *copy = SymbMapping(duplicateSymbol(thesymb)); - -#ifdef __SPF - if (!copy) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; - } - - copy->setProject(project); - copy->setFileId(fileID); -#endif - return *copy; -} - -inline SgSymbol* SgSymbol::copyPtr() -{ - SgSymbol* copy = SymbMapping(duplicateSymbol(thesymb)); - -#ifdef __SPF - if (!copy) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; - } - - copy->setProject(project); - copy->setFileId(fileID); -#endif - return copy; -} - -inline SgSymbol &SgSymbol::copyLevel1() -{ - SgSymbol *new_symb = SymbMapping(duplicateSymbolLevel1(thesymb)); - -#ifdef __SPF - if (!new_symb) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; - } - new_symb->setProject(project); - new_symb->setFileId(fileID); -#endif - return *new_symb; -} - -inline SgSymbol &SgSymbol::copyLevel2() -{ - SgSymbol *new_symb = SymbMapping(duplicateSymbolLevel2(thesymb)); - -#ifdef __SPF - if (!new_symb) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; - } - new_symb->setProject(project); - new_symb->setFileId(fileID); -#endif - return *new_symb; -} - -inline SgSymbol& SgSymbol::copyAcrossFiles(SgStatement& where) -{ - resetDoVarForSymb(); - SgSymbol* new_symb = SymbMapping(duplicateSymbolAcrossFiles(thesymb, where.thebif)); -#ifdef __SPF - if (!new_symb) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; - } - new_symb->setProject(project); - new_symb->setFileId(fileID); -#endif - return *new_symb; -} - -inline SgSymbol &SgSymbol::copySubprogram(SgStatement &where) -{ - return *SymbMapping(duplicateSymbolOfRoutine(thesymb,where.thebif)); -} - -inline void SgSymbol::declareTheSymbolWithParamList - (SgStatement &st, SgExpression &parlist) -{ declareAVarWPar(thesymb, parlist.thellnd, st.thebif); } - - -inline SgExpression *SgSymbol::makeDeclExprWithParamList - (SgExpression &parlist) -{ return LlndMapping(makeDeclExpWPar(thesymb, parlist.thellnd));} - -inline SgSymbol *SgSymbol::moduleSymbol() -{ return SymbMapping(SYMB_BASE_NAME(thesymb));} - -// SgType--inlines - -inline int SgType::variant() -{ return TYPE_CODE(thetype); } - -inline int SgType::id() -{ return TYPE_ID(thetype); } - -inline SgSymbol *SgType::symbol() -{/* return SymbMapping(TYPE_SYMB_DERIVE(thetype));*/ - return SymbMapping(TYPE_SYMB(thetype));} - -inline SgType &SgType::copy() -{ return *copyPtr(); } - -inline SgType *SgType::copyPtr() -{ return TypeMapping(duplicateType(thetype));} - -inline SgType *SgType::next() -{ return TypeMapping(TYPE_NEXT(thetype)); } - -inline int SgType::isTheElementType() -{ return isElementType(thetype);} - -inline int SgType::equivalentToType(SgType &type) -{ return isTypeEquivalent(thetype, type.thetype);} - -inline int SgType::equivalentToType(SgType *type) -{ - if ( type == 0 ) - return 0; - else - return isTypeEquivalent(thetype, type->thetype); -} - - -inline SgType *SgType::internalBaseType() -{ - PTR_TYPE ty; - ty = lookForInternalBasetype(thetype); - return TypeMapping(ty); -} - -inline int SgType::hasBaseType() -{ - return hasTypeBaseType(TYPE_CODE(thetype)); -} - -inline SgType *SgType::baseType() -{ - SgType * x; - if (hasTypeBaseType(TYPE_CODE(thetype))) - x = TypeMapping(TYPE_BASE(thetype)); - else - x = NULL; - - return x; -} - -/* update Kataev N.A. 30.08.2013 -- add check for NULL range -*/ -inline SgExpression *SgType::length() -{ - PTR_LLND lenExpr = TYPE_RANGES( thetype); - - return lenExpr ? LlndMapping(NODE_OPERAND0(lenExpr)) : NULL; -} - -inline void SgType::setLength(SgExpression* newLen) -{ - if (TYPE_RANGES(thetype)) - NODE_OPERAND0(TYPE_RANGES(thetype)) = newLen->thellnd; - else - ; //TODO -} - -inline SgExpression *SgType::selector() -{ - PTR_LLND kindExpr = TYPE_KIND_LEN(thetype); - return kindExpr ? LlndMapping(TYPE_KIND_LEN(thetype)) : NULL; -} - -inline void SgType::setSelector(SgExpression* newSelector) -{ - TYPE_KIND_LEN(thetype) = newSelector->thellnd; -} - -inline void SgType::deleteSelector() -{ - PTR_LLND kindExpr = TYPE_KIND_LEN(thetype); - if (kindExpr) - TYPE_KIND_LEN(thetype) = NULL; -} - -// SgLabel--inlines -inline int SgLabel::id() -{ return LABEL_STMTNO(thelabel); } - -inline int SgLabel::getLastLabelVal() -{ return getLastLabelId();} - -// SgValueExp--inlines - -inline SgValueExp::SgValueExp(bool value) :SgExpression(BOOL_VAL) -{ - NODE_TYPE(thellnd) = GetAtomicType(T_BOOL); - NODE_BOOL_CST(thellnd) = value; -} - -inline SgValueExp::SgValueExp(int value):SgExpression(INT_VAL) -{ - NODE_TYPE(thellnd) = GetAtomicType(T_INT); - NODE_INT_CST_LOW (thellnd) = value; -} - -inline SgValueExp::SgValueExp(char char_val):SgExpression( CHAR_VAL) -{ - NODE_TYPE(thellnd) = GetAtomicType(T_CHAR); - NODE_CHAR_CST(thellnd) = char_val; -} - -inline SgValueExp::SgValueExp(float float_val, char *val) :SgExpression(FLOAT_VAL) -{ - NODE_STR(thellnd) = (char*)xmalloc((strlen(val) + 1)*sizeof(char)); - strcpy(NODE_STR(thellnd), val); - NODE_TYPE(thellnd) = GetAtomicType(T_FLOAT); -} - -inline SgValueExp::SgValueExp(double double_val, char *val) :SgExpression(DOUBLE_VAL) -{ - NODE_STR(thellnd) = (char*)xmalloc((strlen(val) + 1)*sizeof(char)); - strcpy(NODE_STR(thellnd), val); - NODE_TYPE(thellnd) = GetAtomicType(T_DOUBLE); -} - -inline SgValueExp::SgValueExp(float float_val):SgExpression(FLOAT_VAL) -{ - char tmp[100]; // No doubles longer than 100 digits; - sprintf (tmp,"%.8e",float_val); - NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); - strcpy(NODE_STR(thellnd), tmp); - NODE_TYPE(thellnd) = GetAtomicType(T_FLOAT); - -} - -inline SgValueExp::SgValueExp(double double_val):SgExpression(DOUBLE_VAL) -{ - char tmp[100]; // No doubles longer than 100 digits ; - sprintf (tmp,"%.16e",double_val); - NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); - strcpy(NODE_STR(thellnd), tmp); - NODE_TYPE(thellnd) = GetAtomicType(T_DOUBLE); -} - -inline SgValueExp::SgValueExp(char *string_val):SgExpression(STRING_VAL) -{ - NODE_TYPE(thellnd) = GetAtomicType(T_STRING); - NODE_STRING_POINTER(thellnd) = string_val; -} - -inline SgValueExp::SgValueExp(const char *string_val) :SgExpression(STRING_VAL) -{ - NODE_STR(thellnd) = (char*)xmalloc((strlen(string_val) + 1) * sizeof(char)); - strcpy(NODE_STR(thellnd), string_val); - NODE_TYPE(thellnd) = GetAtomicType(T_STRING); -} - -inline SgValueExp::SgValueExp(double real, double imaginary):SgExpression(COMPLEX_VAL) -{ - NODE_TYPE(thellnd) = GetAtomicType(T_COMPLEX); - NODE_OPERAND0(thellnd) = SgValueExp(real).thellnd; - NODE_OPERAND1(thellnd) = SgValueExp(imaginary).thellnd; -} - -inline SgValueExp::SgValueExp(SgValueExp &real, SgValueExp &imaginary):SgExpression(COMPLEX_VAL) -{ - NODE_TYPE(thellnd) = GetAtomicType(T_COMPLEX); - NODE_OPERAND0(thellnd) = real.thellnd; - NODE_OPERAND1(thellnd) = imaginary.thellnd; -} - -// are these setValue functions really needed? -// the user can simply say, SgValueExp(3.0) and -// get the same functionality, in most cases. -// Moreover, the code is wrong. The NODE_ CODE field -// must be checked. -inline void SgValueExp::setValue(int int_val) -{ - NODE_INT_CST_LOW (thellnd) = int_val; -} - -inline void SgValueExp::setValue(char char_val) -{ - NODE_CHAR_CST(thellnd) = char_val; -} - -inline void SgValueExp::setValue(float float_val) -{ - char tmp[100]; // No doubles longer than 100 digits ; - sprintf (tmp,"%e",float_val); - if (!NODE_STR(thellnd)) - NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); - strcpy(NODE_STR(thellnd),tmp); -} - -inline void SgValueExp::setValue(double double_val) -{ - char tmp[100]; // No doubles longer than 100 digits ; - sprintf (tmp,"%e",double_val); - if (!NODE_STR(thellnd)) - NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); - strcpy(NODE_STR(thellnd),tmp); -} - -inline void SgValueExp::setValue(char *string_val) -{ - NODE_STRING_POINTER(thellnd) = string_val; -} - -inline void SgValueExp::setValue(double real, double im) -{ - NODE_OPERAND0(thellnd) = SgValueExp(real).thellnd; - NODE_OPERAND1(thellnd) = SgValueExp(im).thellnd; -} - -inline void SgValueExp::setValue(SgValueExp &real, SgValueExp & im) -{ - NODE_OPERAND0(thellnd) = real.thellnd; - NODE_OPERAND1(thellnd) = im.thellnd; -} - -inline bool SgValueExp::boolValue() -{ - bool x; - if (NODE_CODE(thellnd) != BOOL_VAL) - { - Message("message boolValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = false; - } - else - x = NODE_BOOL_CST(thellnd); - return x; -} - -inline int SgValueExp::intValue() -{ - int x; - if (NODE_CODE(thellnd) != INT_VAL) - { - Message("message intValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = 0; - } - else - x = NODE_INT_CST_LOW (thellnd); - return x; -} - -inline char* SgValueExp::floatValue() -{ - char* x; - - if (NODE_CODE(thellnd) != FLOAT_VAL) - { - Message("message floatValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = NULL; - } - else - x = NODE_FLOAT_CST(thellnd); - - return x; -} - -inline char SgValueExp::charValue() -{ - char x; - - if (NODE_CODE(thellnd) != CHAR_VAL) - { - Message("message charValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = 0; - } - else - x = NODE_CHAR_CST(thellnd); - - return x; -} - -inline char* SgValueExp::doubleValue() -{ - char* x; - - if (NODE_CODE(thellnd) != DOUBLE_VAL) - { - Message("message doubleValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = NULL; - } - else - x = NODE_DOUBLE_CST(thellnd); - - return x; -} - -inline char * SgValueExp::stringValue() -{ - char *x; - - if (NODE_CODE(thellnd) != STRING_VAL) - { - Message("message stringValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = NULL; - } - else - x = NODE_STRING_POINTER(thellnd); - - return x; -} - -inline SgExpression * SgValueExp:: realValue() -{ - SgExpression *x; - - if (NODE_CODE(thellnd) != COMPLEX_VAL) - { - Message("message realValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = NULL; - } - else - x = LlndMapping(NODE_OPERAND0(thellnd)); - - return x; -} - -inline SgExpression * SgValueExp::imaginaryValue() -{ - SgExpression *x; - - if (NODE_CODE(thellnd) != COMPLEX_VAL) - { - Message("message imaginaryValue not understood"); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - x = NULL; - } - else - x = LlndMapping(NODE_OPERAND1(thellnd)); - - return x; -} - - - -// SgKeywordValExp--inlines -inline SgKeywordValExp::SgKeywordValExp(char *name):SgExpression(KEYWORD_VAL) -{ NODE_STRING_POINTER(thellnd) = name; } - -inline SgKeywordValExp::SgKeywordValExp(const char *name):SgExpression(KEYWORD_VAL) -{ - NODE_STR(thellnd) = (char*)xmalloc((strlen(name) + 1) * sizeof(char)); - strcpy(NODE_STR(thellnd), name); -} - -inline char * SgKeywordValExp::value() -{ return NODE_STRING_POINTER(thellnd); } - - -// SgUnaryExp--inlines - -// In the code below, no type checking has been done. -// Some of the parser code may be modified to do the type-checking. -// For example, SgUnaryExp(ADDRESS_OP, 2) should not -// be detected. -// the standard unary expressons -// variant:DEREF_OP * expr -// variant:ADDRESS_OP & expr -// variant:MINUS_OP - expr -// variant:UNARY_ADD_OP + expr -// variant:PLUSPLUS_OP ++lhd or rhs++ -// variant:MINUSMINUS_OP --lhs or rhs-- -// variant:BIT_COMPLEMENT_OP ~ expr -// variant:NOT_OP ! expr -// variant:SIZE_OP sizeof( expr) - -inline SgUnaryExp::SgUnaryExp(PTR_LLND ll):SgExpression(ll) -{} -inline SgUnaryExp::SgUnaryExp(int variant, SgExpression & e):SgExpression(variant) -{ - NODE_OPERAND0(thellnd) = e.thellnd; -} - -inline SgUnaryExp::SgUnaryExp(int variant, int post, SgExpression &e):SgExpression(variant) -{ // post =1 rhs++ - if (post) - NODE_OPERAND1(thellnd) = e.thellnd; - else - NODE_OPERAND0(thellnd) = e.thellnd; -} - -inline int SgUnaryExp::post() // returns TRUE if a post inc or dec op. -{ if (NODE_OPERAND1(thellnd)) return TRUE; else return FALSE;} - - -// SgCastExp--inlines - -inline SgCastExp::SgCastExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgCastExp::SgCastExp(SgType &t, SgExpression &e):SgExpression(CAST_OP) -{ - NODE_TYPE(thellnd) = t.thetype; - NODE_OPERAND0(thellnd) = e.thellnd; - // an experiment to fix the bernd bug. - NODE_OPERAND1(thellnd) = (SgMakeDeclExp(NULL, &t))->thellnd; -} - -inline SgCastExp::SgCastExp(SgType &t):SgExpression(CAST_OP) -{ NODE_TYPE(thellnd) = t.thetype; } - -inline SgCastExp::~SgCastExp(){RemoveFromTableLlnd((void *) this);} - - -// SgDeleteExp--inlines - -inline SgDeleteExp::SgDeleteExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgDeleteExp::SgDeleteExp(SgExpression &size,SgExpression &expr):SgExpression(DELETE_OP) -{ - NODE_OPERAND0(thellnd) = expr.thellnd; - NODE_OPERAND1(thellnd) = size.thellnd; -} - -inline SgDeleteExp::SgDeleteExp( SgExpression &expr):SgExpression(DELETE_OP) -{ - NODE_OPERAND0(thellnd) = expr.thellnd; -} - -inline SgDeleteExp::~SgDeleteExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgNewExp--inlines - - -inline SgNewExp::SgNewExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgNewExp::SgNewExp(SgType &t):SgExpression(NEW_OP) -{ - SgCastExp *pt; - pt = new SgCastExp(t); - NODE_OPERAND0(thellnd) = pt->thellnd; -} - -inline SgNewExp::SgNewExp(SgType &t, SgExpression &e):SgExpression(NEW_OP) -{ - SgCastExp *pt; - pt = new SgCastExp(t); - NODE_OPERAND0(thellnd) = pt->thellnd; - NODE_OPERAND1(thellnd) = e.thellnd; -} - -inline SgNewExp::~SgNewExp() -{ RemoveFromTableLlnd((void *) this); } - - -// SgExprIfExp--inlines - -inline SgExprIfExp::SgExprIfExp(PTR_LLND ll): SgExpression(ll) -{} - -inline SgExprIfExp::SgExprIfExp(SgExpression &exp1, - SgExpression &exp2, - SgExpression &exp3):SgExpression(EXPR_IF) -{ - NODE_OPERAND0(thellnd)= exp1.thellnd; - NODE_OPERAND1(thellnd)= newExpr(EXPR_IF_BODY,NODE_TYPE(exp2.thellnd),exp2.thellnd,exp3.thellnd); -} - -inline void SgExprIfExp::setConditional(SgExpression &c) -{ - NODE_OPERAND0(thellnd) = c.thellnd; -} - -// SgFunctionRefExp--inlines -inline SgFunctionRefExp::SgFunctionRefExp(PTR_LLND ll):SgExpression(ll) -{} -inline SgFunctionRefExp::SgFunctionRefExp(SgSymbol &fun):SgExpression(FUNCTION_REF) -{ - NODE_SYMB (thellnd) = fun.thesymb; -} -inline SgFunctionRefExp::~SgFunctionRefExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgSymbol *SgFunctionRefExp::funName() -{ return SymbMapping(NODE_SYMB(thellnd)); } - -inline SgExpression * SgFunctionRefExp::args() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline int SgFunctionRefExp::numberOfArgs() -{ return exprListLength(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgFunctionRefExp::arg(int i) -{ return LlndMapping(getPositionInExprList(NODE_OPERAND0(thellnd),i)); } - -// SgFunctionCallExp--inlines - -inline SgFunctionCallExp::SgFunctionCallExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgFunctionCallExp::SgFunctionCallExp(SgSymbol &fun, SgExpression ¶mList):SgExpression(FUNC_CALL) -{ - NODE_SYMB (thellnd) = fun.thesymb; - NODE_OPERAND0(thellnd) = paramList.thellnd; -} - -inline SgFunctionCallExp::SgFunctionCallExp(SgSymbol &fun):SgExpression(FUNC_CALL) -{ - NODE_SYMB (thellnd) = fun.thesymb; -} -inline SgFunctionCallExp::~SgFunctionCallExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgSymbol *SgFunctionCallExp::funName() -{ return SymbMapping(NODE_SYMB(thellnd)); } - -inline SgExpression * SgFunctionCallExp::args() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline int SgFunctionCallExp::numberOfArgs() -{ return exprListLength(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgFunctionCallExp::arg(int i) -{ return LlndMapping(getPositionInExprList(NODE_OPERAND0(thellnd),i)); } - -inline void SgFunctionCallExp::addArg(SgExpression &arg) -{ NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),arg.thellnd); } - - - -// SgFuncPntrExp--inlines - -inline SgFuncPntrExp::SgFuncPntrExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgFuncPntrExp::SgFuncPntrExp(SgExpression &ptr):SgExpression(FUNCTION_OP) -{ NODE_OPERAND0(thellnd) = ptr.thellnd; } - -inline SgFuncPntrExp::~SgFuncPntrExp(){RemoveFromTableLlnd((void *) this);} - -inline SgExpression * SgFuncPntrExp::funExp() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline void SgFuncPntrExp::setFunExp(SgExpression &s) -{ NODE_OPERAND0(thellnd) = s.thellnd; } - -inline int SgFuncPntrExp::numberOfArgs() -{ return exprListLength(NODE_OPERAND1(thellnd)); } - -inline SgExpression * SgFuncPntrExp::arg(int i) -{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } - -inline void SgFuncPntrExp::addArg(SgExpression &arg) -{ NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),arg.thellnd);} - - - -// SgExprListExp--inlines - -// Kolganov A.S. 31.10.2013 -inline SgExprListExp::SgExprListExp(int variant) :SgExpression(variant) -{} - -inline SgExprListExp::SgExprListExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgExprListExp::SgExprListExp():SgExpression(EXPR_LIST) -{} - -inline SgExprListExp::SgExprListExp(SgExpression &ptr):SgExpression(EXPR_LIST) -{ NODE_OPERAND0(thellnd) = ptr.thellnd; } - -inline SgExprListExp::~SgExprListExp(){RemoveFromTableLlnd((void *) this);} - -inline int SgExprListExp::length() -{ return exprListLength(thellnd); } - -inline SgExpression * SgExprListExp::elem(int i) -{ return LlndMapping(getPositionInExprList(thellnd,i)); } - -inline SgExprListExp * SgExprListExp::next() -{ return (SgExprListExp *) LlndMapping(NODE_OPERAND1(thellnd)); } - -inline SgExpression * SgExprListExp::value() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline void SgExprListExp::setValue(SgExpression &ptr) -{ NODE_OPERAND0(thellnd) = ptr.thellnd; } - -inline void SgExprListExp::append(SgExpression &arg) -{ thellnd = addToExprList(thellnd,arg.thellnd); } - - -// SgRefExp--inlines -inline SgRefExp::SgRefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgRefExp::SgRefExp(int variant, SgSymbol &s):SgExpression(variant) -{ - NODE_SYMB(thellnd) = s.thesymb; - NODE_TYPE(thellnd) = SYMB_TYPE(s.thesymb); -} - -inline SgRefExp::~SgRefExp() -{ RemoveFromTableLlnd((void *) this); } - -// SgTypeRefExp -- inlines - -inline SgTypeRefExp::SgTypeRefExp(SgType &t): SgExpression(TYPE_REF){ - NODE_TYPE(thellnd) = t.thetype; -} - -inline SgType * SgTypeRefExp::getType(){ - return TypeMapping(NODE_TYPE(thellnd)); -} - -inline SgTypeRefExp::~SgTypeRefExp() -{ RemoveFromTableLlnd((void *) this); } - -// SgVarRefExp--inlines - -inline SgVarRefExp::SgVarRefExp (PTR_LLND ll):SgExpression(ll) -{} - -inline SgVarRefExp::SgVarRefExp(SgSymbol &s):SgExpression(VAR_REF) -{ - NODE_TYPE(thellnd) = SYMB_TYPE(s.thesymb); - NODE_SYMB(thellnd) = s.thesymb; -} -inline SgVarRefExp::SgVarRefExp(SgSymbol *s):SgExpression(VAR_REF) -{ - if(s){ - NODE_TYPE(thellnd) = SYMB_TYPE(s->thesymb); - NODE_SYMB(thellnd) = s->thesymb; - } -} - -inline SgVarRefExp::~SgVarRefExp() -{ RemoveFromTableLlnd((void *) this); } - - -// SgThisExp--inlines - -inline SgThisExp::SgThisExp (PTR_LLND ll):SgExpression(ll) -{} - -inline SgThisExp::SgThisExp(SgType &t):SgExpression(THIS_NODE) -{ NODE_TYPE(thellnd) = t.thetype; } - -inline SgThisExp::~SgThisExp() -{ RemoveFromTableLlnd((void *) this); } - - -// SgArrayRefExp--inlines - -inline SgArrayRefExp::SgArrayRefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s):SgExpression(ARRAY_REF) -{ - PTR_SYMB symb; - - symb = s.thesymb; - if (!arraySymbol(symb)) - { - Message("Attempt to create an array ref with a symbol not of type array", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - NODE_SYMB(thellnd) = symb; - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); -} - -inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &subscripts):SgExpression(ARRAY_REF) -{ - PTR_SYMB symb; - - symb = s.thesymb; - if (!arraySymbol(symb)) - { - Message("Attempt to create an array ref with a symbol not of type array", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_SYMB(thellnd) = symb; - if(NODE_CODE(subscripts.thellnd) == EXPR_LIST) - NODE_OPERAND0(thellnd) = subscripts.thellnd; - else - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),subscripts.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); -} - -inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2):SgExpression(ARRAY_REF) -{ - PTR_SYMB symb; - - symb = s.thesymb; - - if (!arraySymbol(symb)) - { - Message("Attempt to create an array ref with a symbol not of type array", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - NODE_SYMB(thellnd) = symb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); -} - - -inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3):SgExpression(ARRAY_REF) -{ - PTR_SYMB symb; - - symb = s.thesymb; - - if (!arraySymbol(symb)) - { - Message("Attempt to create an array ref with a symbol not of type array", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - NODE_SYMB(thellnd) = symb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); -} - -inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3,SgExpression &sub4):SgExpression(ARRAY_REF) -{ - PTR_SYMB symb; - - symb = s.thesymb; - - if (!arraySymbol(symb)) - { - Message("Attempt to create an array ref with a symbol not of type array", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - NODE_SYMB(thellnd) = symb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub4.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); -} - -inline SgArrayRefExp:: ~SgArrayRefExp() -{ RemoveFromTableLlnd((void *) this); } - -// the number of subscripts in reference -inline int SgArrayRefExp::numberOfSubscripts() -{ return exprListLength(NODE_OPERAND0(thellnd));} - -inline SgExpression * SgArrayRefExp::subscripts() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgArrayRefExp::subscript(int i) -{ - PTR_LLND ll = NULL; - ll = getPositionInExprList(NODE_OPERAND0(thellnd),i); - return LlndMapping(ll); -} - -inline void SgArrayRefExp::addSubscript(SgExpression &e) -{ NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),e.thellnd);} - -inline void SgArrayRefExp::replaceSubscripts(SgExpression &e) -{ NODE_OPERAND0(thellnd) = e.thellnd; } - -inline void SgArrayRefExp::setSymbol(SgSymbol &s) -{ NODE_SYMB(thellnd) = s.thesymb;} - - -// SgProcessorsRefExp--inlines - -inline SgProcessorsRefExp::SgProcessorsRefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgProcessorsRefExp::SgProcessorsRefExp():SgExpression(PROCESSORS_REF) -{ - SgSymbol *symb; - - symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); - NODE_SYMB(thellnd) = symb->thesymb; - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); -} - -inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &subscripts):SgExpression(PROCESSORS_REF) -{ - SgSymbol *symb; - - symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); - NODE_SYMB(thellnd) = symb->thesymb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),subscripts.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); -} - -inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2):SgExpression(PROCESSORS_REF) -{ - SgSymbol *symb; - - symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); - NODE_SYMB(thellnd) = symb->thesymb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); -} - - -inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2,SgExpression &sub3):SgExpression(PROCESSORS_REF) -{ - SgSymbol *symb; - - symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); - NODE_SYMB(thellnd) = symb->thesymb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); -} - -inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2,SgExpression &sub3,SgExpression &sub4):SgExpression(PROCESSORS_REF) -{ - SgSymbol *symb; - - symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); - NODE_SYMB(thellnd) = symb->thesymb; - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); - NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub4.thellnd); - NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); -} - -inline SgProcessorsRefExp:: ~SgProcessorsRefExp() -{ RemoveFromTableLlnd((void *) this); } - -// the number of subscripts in reference -inline int SgProcessorsRefExp::numberOfSubscripts() -{ return exprListLength(NODE_OPERAND0(thellnd));} - -inline SgExpression * SgProcessorsRefExp::subscripts() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgProcessorsRefExp::subscript(int i) -{ - PTR_LLND ll = NULL; - ll = getPositionInExprList(NODE_OPERAND0(thellnd),i); - return LlndMapping(ll); -} - -inline void SgProcessorsRefExp::addSubscript(SgExpression &e) -{ NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),e.thellnd);} - - - -// SgPntrArrRefExp--inlines - -inline SgPntrArrRefExp::SgPntrArrRefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p):SgExpression(ARRAY_OP) -{ NODE_OPERAND0(thellnd) = p.thellnd; } - -inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, SgExpression &subscripts):SgExpression(ARRAY_OP) -{ - NODE_OPERAND0(thellnd) = p.thellnd; - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),subscripts.thellnd); -} - -inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, int, SgExpression &sub1, SgExpression &sub2):SgExpression(ARRAY_OP) -{ - NODE_OPERAND0(thellnd) = p.thellnd; - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub1.thellnd); - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub2.thellnd); -} - -inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, int, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3):SgExpression(ARRAY_OP) -{ - NODE_OPERAND0(thellnd) = p.thellnd; - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub1.thellnd); - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub2.thellnd); - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub3.thellnd); -} - -inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, int, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3, SgExpression &sub4):SgExpression(ARRAY_OP) -{ - NODE_OPERAND0(thellnd) = p.thellnd; - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub1.thellnd); - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub2.thellnd); - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub3.thellnd); - NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub4.thellnd); -} - -inline SgPntrArrRefExp::~SgPntrArrRefExp() -{ RemoveFromTableLlnd((void *) this); } - -inline int SgPntrArrRefExp::dimension() -{ return exprListLength(NODE_OPERAND1(thellnd)); } - -inline SgExpression *SgPntrArrRefExp::subscript(int i) -{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } - -inline void SgPntrArrRefExp::addSubscript(SgExpression &e) -{ NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),e.thellnd); } - -inline void SgPntrArrRefExp::setPointer(SgExpression &p) -{ NODE_OPERAND0(thellnd) = p.thellnd; } - - -// SgPointerDerefExp--inlines - -inline SgPointerDerefExp::SgPointerDerefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgPointerDerefExp::SgPointerDerefExp(SgExpression &pointerExp):SgExpression(DEREF_OP) -{ - PTR_TYPE expType; - - expType = NODE_TYPE(pointerExp.thellnd); - if (!pointerType(expType)) - { - Message("Attempt to create SgPointerDerefExp with non pointer type", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = pointerExp.thellnd; - NODE_TYPE(thellnd) = lookForInternalBasetype(expType); -} - -inline SgPointerDerefExp::~SgPointerDerefExp() -{ RemoveFromTableLlnd((void *) this);} - - -inline SgExpression * SgPointerDerefExp::pointerExp() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - - -// SgRecprdRefExp--inlines - -inline SgRecordRefExp::SgRecordRefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgRecordRefExp::SgRecordRefExp(SgSymbol &recordName, char *fieldName):SgExpression(RECORD_REF) -{ - PTR_SYMB recordSym, fieldSym; - - recordSym = recordName.thesymb; - - if ((fieldSym = getFieldOfStructWithName(fieldName, SYMB_TYPE(recordSym))) == SMNULL) - { - Message("No such field", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = newExpr(VAR_REF,SYMB_TYPE(recordName.thesymb), recordName.thesymb); - NODE_OPERAND1(thellnd) = newExpr(VAR_REF,SYMB_TYPE(fieldSym), fieldSym); - NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); -} - -inline SgRecordRefExp::SgRecordRefExp(SgExpression &recordExp, char *fieldName):SgExpression(RECORD_REF) -{ - PTR_SYMB fieldSym; - - - if ((fieldSym = getFieldOfStructWithName(fieldName, NODE_TYPE(recordExp.thellnd))) == SMNULL) - { - Message("No such field", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = recordExp.thellnd; - NODE_OPERAND1(thellnd) = newExpr(VAR_REF,SYMB_TYPE(fieldSym),fieldSym); - NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); -} - -inline SgRecordRefExp::SgRecordRefExp(SgSymbol &recordName, const char *fieldName) :SgExpression(RECORD_REF) -{ - PTR_SYMB recordSym, fieldSym; - - recordSym = recordName.thesymb; - - if ((fieldSym = getFieldOfStructWithName(fieldName, SYMB_TYPE(recordSym))) == SMNULL) - { - Message("No such field", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = newExpr(VAR_REF, SYMB_TYPE(recordName.thesymb), recordName.thesymb); - NODE_OPERAND1(thellnd) = newExpr(VAR_REF, SYMB_TYPE(fieldSym), fieldSym); - NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); -} - -inline SgRecordRefExp::SgRecordRefExp(SgExpression &recordExp, const char *fieldName) :SgExpression(RECORD_REF) -{ - PTR_SYMB fieldSym; - - - if ((fieldSym = getFieldOfStructWithName(fieldName, NODE_TYPE(recordExp.thellnd))) == SMNULL) - { - Message("No such field", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = recordExp.thellnd; - NODE_OPERAND1(thellnd) = newExpr(VAR_REF, SYMB_TYPE(fieldSym), fieldSym); - NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); -} - -inline SgRecordRefExp::~SgRecordRefExp(){RemoveFromTableLlnd((void *) this);} - -inline SgSymbol * SgRecordRefExp::fieldName() -{ return SymbMapping(NODE_SYMB(NODE_OPERAND1(thellnd))); } - -inline SgSymbol * SgRecordRefExp::recordName() -{ - SgSymbol *x; - - if (NODE_CODE(NODE_OPERAND0(thellnd)) != VAR_REF) - x = NULL; - else - x = SymbMapping(NODE_SYMB(NODE_OPERAND0(thellnd))); - - return x; -} - -inline SgExpression* SgRecordRefExp::record() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression* SgRecordRefExp::field() -{ return LlndMapping(NODE_OPERAND1(thellnd)); } - - -// SgStructConstExp--inlines - -inline SgStructConstExp::SgStructConstExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgStructConstExp::SgStructConstExp(SgSymbol &structName, SgExpression &values):SgExpression(STRUCTURE_CONSTRUCTOR) -{ - NODE_OPERAND0(thellnd) = newExpr(TYPE_REF,SYMB_TYPE(structName.thesymb),structName.thesymb); - NODE_OPERAND1(thellnd) = values.thellnd; - NODE_TYPE(thellnd) = SYMB_TYPE(structName.thesymb); -} - -inline SgStructConstExp::SgStructConstExp(SgExpression &typeRef, SgExpression &values):SgExpression(STRUCTURE_CONSTRUCTOR) -{ - NODE_OPERAND0(thellnd) = typeRef.thellnd; - NODE_OPERAND1(thellnd) = values.thellnd; - NODE_TYPE(thellnd) = NODE_TYPE(typeRef.thellnd); -} - -inline SgStructConstExp::~SgStructConstExp() -{ RemoveFromTableLlnd((void *) this); } - -inline int SgStructConstExp::numberOfArgs() -{ return exprListLength(NODE_OPERAND1(thellnd)); } - -inline SgExpression * SgStructConstExp::arg(int i) -{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } - - -// SgConstExp--inlines - -inline SgConstExp::SgConstExp(PTR_LLND ll):SgExpression(ll) -{} - -// NODE_ TYPE needs to be filled here. -// type-checking of values needs to be done. -inline SgConstExp::SgConstExp(SgExpression &values):SgExpression(CONSTRUCTOR_REF) -{ - NODE_OPERAND0(thellnd) = values.thellnd; -} - -inline SgConstExp::~SgConstExp(){RemoveFromTableLlnd((void *) this);} - -inline int SgConstExp::numberOfArgs() -{ return exprListLength(NODE_OPERAND1(thellnd)); } - -inline SgExpression * SgConstExp::arg(int i) -{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } - - - -// SgVecConstExp--inlines - -inline SgVecConstExp::SgVecConstExp(PTR_LLND ll):SgExpression(ll) -{} - -#ifdef NOT_YET_IMPLEMENTED -inline SgVecConstExp::SgVecConstExp(SgExpression &expr_list):SgExpression(VECTOR_CONST) -{ SORRY; } -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgVecConstExp::SgVecConstExp(int n, SgExpression *components):SgExpression(VECTOR_CONST) -{ SORRY; } -#endif - -inline SgVecConstExp::~SgVecConstExp() -{ RemoveFromTableLlnd((void *) this); } - -#ifdef NOT_YET_IMPLEMENTED -inline SgExpression * SgVecConstExp::arg(int i) -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline int SgVecConstExp::numberOfArgs() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline void SgVecConstExp::setArg(int i, SgExpression &e) -{ - SORRY; -} -#endif - - - -// SgInitListExp--inlines - -inline SgInitListExp::SgInitListExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgInitListExp::SgInitListExp(SgExpression &expr_list):SgExpression(INIT_LIST) -{ - NODE_OPERAND0(thellnd)=expr_list.thellnd; - NODE_TYPE(thellnd)=NODE_TYPE(expr_list.thellnd); -} - -#ifdef NOT_YET_IMPLEMENTED -inline SgInitListExp::SgInitListExp(int n, SgExpression *components):SgExpression(INIT_LIST) -{ - SORRY; -} -#endif - -inline SgInitListExp::~SgInitListExp() -{ RemoveFromTableLlnd((void *) this); } - - -#ifdef NOT_YET_IMPLEMENTED -inline SgExpression * SgInitListExp::arg(int i) -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline int SgInitListExp::numberOfArgs() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline void SgInitListExp::setArg(int i, SgExpression &e) -{ - SORRY; -} -#endif - - -// SgObjectListExp--inlines - -inline SgObjectListExp::SgObjectListExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgObjectListExp::SgObjectListExp(int variant, SgSymbol &object, SgExpression &list):SgExpression(variant) -{ -#ifdef AJM_SUGGESTS - -// This is not what is expected in a COMMON block. -// NODE_OPERAND0(thellnd) = newExpr(VAR_REF, SYMB_TYPE(object.thesymb), object.thesymb); - NODE_SYMB(thellnd) = object.thesymb; - NODE_OPERAND0(thellnd) = list.thellnd; - -#else /* Original */ - - NODE_OPERAND0(thellnd) = newExpr(VAR_REF, SYMB_TYPE(object.thesymb), object.thesymb); - NODE_OPERAND1(thellnd) = list.thellnd; - -#endif -} - -inline SgObjectListExp::SgObjectListExp(int variant,SgExpression &objectRef, SgExpression &list):SgExpression(variant) -{ -#ifdef AJM_SUGGESTS -// Not what a common block wants. -// NODE_OPERAND0(thellnd) = objectRef.thellnd; - NODE_SYMB(thellnd)=objectRef.symbol()->thesymb; - NODE_OPERAND0(thellnd) = list.thellnd; -#else - NODE_OPERAND0(thellnd) = objectRef.thellnd; - NODE_OPERAND1(thellnd) = list.thellnd; -#endif -} - -inline SgObjectListExp::~SgObjectListExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgSymbol * SgObjectListExp::object( ) -{ return SymbMapping( NODE_SYMB(thellnd)); } - -inline SgObjectListExp * SgObjectListExp::next( ) -{ return static_cast< SgObjectListExp * >( LlndMapping(NODE_OPERAND1(thellnd))); } - -inline SgExpression * SgObjectListExp::body( ) -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline int SgObjectListExp::listLength() -{ return exprListLength(thellnd); } - -inline SgSymbol * SgObjectListExp::symbol(int i) -{ - PTR_LLND tail; - int len; - for (len = 0, tail = thellnd; len < i && tail; tail = NODE_OPERAND1(tail), ++len); - - return SymbMapping(NODE_SYMB(tail)); -} - -inline SgExpression * SgObjectListExp::body(int i) -{ return LlndMapping( getPositionInExprList(NODE_OPERAND1(thellnd),i)); } - - -// SgAttributeExp--inlines -inline SgAttributeExp::SgAttributeExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgAttributeExp::SgAttributeExp(int variant):SgExpression(variant) -{} - -inline SgAttributeExp::~SgAttributeExp() -{ RemoveFromTableLlnd((void *) this); } - - -// SgKeywordArgExp--inlines - -inline SgKeywordArgExp::SgKeywordArgExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgKeywordArgExp::SgKeywordArgExp(char *argName, SgExpression &exp):SgExpression(KEYWORD_ARG) -{ - NODE_OPERAND1(thellnd) = exp.thellnd; - NODE_OPERAND0(thellnd) = SgKeywordValExp(argName).thellnd; - NODE_TYPE(thellnd) = NODE_TYPE(exp.thellnd); -} - -inline SgKeywordArgExp::SgKeywordArgExp(const char *argName, SgExpression &exp) :SgExpression(KEYWORD_ARG) -{ - NODE_OPERAND1(thellnd) = exp.thellnd; - NODE_OPERAND0(thellnd) = SgKeywordValExp(argName).thellnd; - NODE_TYPE(thellnd) = NODE_TYPE(exp.thellnd); -} - -inline SgKeywordArgExp::~SgKeywordArgExp() -{ RemoveFromTableLlnd((void *) this); } - -#if 0 //Kataev N.A. 30.05.2013 -inline SgSymbol * SgKeywordArgExp::arg() -{ return SymbMapping(NODE_SYMB(thellnd)); } -#endif - -inline SgExpression * SgKeywordArgExp::arg() //Kataev N.A. 30.05.2013 -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgKeywordArgExp::value() -{ return LlndMapping(NODE_OPERAND1(thellnd)); } // fix bag: change NODE_OPERAND0 -> NODE_OPERAND1 (Kataev N.A. 30.05.2013) - - -// SgSubscriptExp--inlines - -inline SgSubscriptExp::SgSubscriptExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgSubscriptExp::SgSubscriptExp(SgExpression &lbound, SgExpression &ubound, SgExpression &step):SgExpression(DDOT) -{ - PTR_LLND lb, ub, inc; - - lb = lbound.thellnd; ub = ubound.thellnd; inc = step.thellnd; - if (!isIntegerType(lb) && !isIntegerType(ub) && !isIntegerType(inc)) - { - Message("Non integer type for SgSubscriptExp", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = lbound.thellnd; - NODE_OPERAND1(thellnd) = newExpr(DDOT,NULL,ubound.thellnd, step.thellnd); -} - -inline SgSubscriptExp::SgSubscriptExp(SgExpression &lbound, SgExpression &ubound):SgExpression(DDOT) -{ - PTR_LLND lb, ub; - - lb = lbound.thellnd; ub = ubound.thellnd; - if (!isIntegerType(lb) && !isIntegerType(ub)) - { - Message("Non integer type for SgSubscriptExp", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - - NODE_OPERAND0(thellnd) = lbound.thellnd; - NODE_OPERAND1(thellnd) = ubound.thellnd; -} - -inline SgSubscriptExp:: ~SgSubscriptExp() -{ RemoveFromTableLlnd((void *) this);} - -// SgUseOnlyExp--inlines - -inline SgUseOnlyExp::SgUseOnlyExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgUseOnlyExp::SgUseOnlyExp(SgExpression &onlyList):SgExpression(ONLY_NODE) -{ NODE_OPERAND0(thellnd) = onlyList.thellnd; } - -inline SgUseOnlyExp::~SgUseOnlyExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgExpression * SgUseOnlyExp::onlyList() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - - -inline SgUseRenameExp::SgUseRenameExp(PTR_LLND ll):SgExpression(ll) -{} - -#ifdef NOT_YET_IMPLEMENTED -inline SgUseRenameExp::SgUseRenameExp(SgSymbol &newName, SgSymbol &oldName):SgExpression( RENAME_NODE) -{ SORRY; } -#endif - -inline SgUseRenameExp::~SgUseRenameExp() -{ RemoveFromTableLlnd((void *) this); } - - -#ifdef NOT_YET_IMPLEMENTED -inline SgSymbol *SgUseRenameExp::newName() -{ - SORRY; - return (SgSymbol *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgSymbol *SgUseRenameExp::oldName() -{ - SORRY; - return (SgSymbol *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgExpression * SgUseRenameExp::newNameExp() -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgExpression * SgUseRenameExp::oldNameExp() -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - - -// SgSpecPairExp--inlines - -inline SgSpecPairExp::SgSpecPairExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgSpecPairExp::SgSpecPairExp(SgExpression &arg, SgExpression &value):SgExpression(SPEC_PAIR) -{ - NODE_OPERAND0(thellnd) = arg.thellnd; - NODE_OPERAND1(thellnd) = value.thellnd; -} - -inline SgSpecPairExp::SgSpecPairExp(SgExpression &arg):SgExpression(SPEC_PAIR) -{ NODE_OPERAND0(thellnd) = arg.thellnd; } - -inline SgSpecPairExp::SgSpecPairExp(char *arg, char *):SgExpression(SPEC_PAIR) -{ - NODE_OPERAND0(thellnd) = SgKeywordValExp(arg).thellnd; - NODE_OPERAND1(thellnd) = SgKeywordValExp(arg).thellnd; -} - -inline SgSpecPairExp::~SgSpecPairExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgExpression *SgSpecPairExp::arg() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgSpecPairExp::value() -{ return LlndMapping(NODE_OPERAND1(thellnd)); } - - -// SgIOAccessExp--inlines - -inline SgIOAccessExp::SgIOAccessExp(PTR_LLND ll):SgExpression(ll) -{} - -// type-checking on bounds needs to be done. -// Float values are legal in some cases. check manual. -inline SgIOAccessExp::SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound, SgExpression step):SgExpression(IOACCESS) -{ - NODE_SYMB(thellnd) = s.thesymb; - NODE_OPERAND0(thellnd) = newExpr(SEQ,NULL, newExpr(DDOT,NULL, lbound.thellnd, ubound.thellnd), step.thellnd); -} - -inline SgIOAccessExp::SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound):SgExpression(IOACCESS) -{ - NODE_SYMB(thellnd) = s.thesymb; - NODE_OPERAND0(thellnd) = newExpr(SEQ,NULL, newExpr(DDOT,NULL, lbound.thellnd, ubound.thellnd), NULL); -} - -inline SgIOAccessExp::~SgIOAccessExp() -{ RemoveFromTableLlnd((void *) this); } - - -// SgImplicitTypExp--inlines - -inline SgImplicitTypeExp::SgImplicitTypeExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgImplicitTypeExp::SgImplicitTypeExp(SgType &type, SgExpression &rangeList):SgExpression(IMPL_TYPE) -{ - NODE_TYPE(thellnd) = type.thetype; - NODE_OPERAND0(thellnd) = rangeList.thellnd; -} - -inline SgImplicitTypeExp::~SgImplicitTypeExp() -{ RemoveFromTableLlnd((void *) this);} - -inline SgType * SgImplicitTypeExp::type() -{ return TypeMapping(NODE_TYPE(thellnd)); } - -inline SgExpression * SgImplicitTypeExp::rangeList() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -#ifdef NOT_YET_IMPLEMENTED -inline char * SgImplicitTypeExp::alphabeticRange() -{ - SORRY; - return (char *) NULL; -} -#endif - - -// SgTypeExp--inlines - -inline SgTypeExp::SgTypeExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgTypeExp::SgTypeExp(SgType &type):SgExpression(TYPE_OP) -{ NODE_TYPE(thellnd) = type.thetype; } - -inline SgTypeExp::~SgTypeExp() -{ RemoveFromTableLlnd((void *) this);} - -inline SgType * SgTypeExp::type() -{ return TypeMapping( NODE_TYPE(thellnd)); } - - -// SgSeqExp--inlines - -inline SgSeqExp::SgSeqExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgSeqExp::SgSeqExp(SgExpression &exp1, SgExpression &exp2):SgExpression(SEQ) -{ - NODE_OPERAND0(thellnd) = exp1.thellnd; - NODE_OPERAND1(thellnd) = exp2.thellnd; -} - -inline SgSeqExp::~SgSeqExp() -{ RemoveFromTableLlnd((void *) this);} - -inline SgExpression * SgSeqExp::front() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression * SgSeqExp::rear() -{ return LlndMapping(NODE_OPERAND1(thellnd)); } - - - -// SgStringLengthExp--inlines - -inline SgStringLengthExp::SgStringLengthExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgStringLengthExp::SgStringLengthExp(SgExpression &length):SgExpression(LEN_OP) -{ NODE_OPERAND0(thellnd) = length.thellnd; } - -inline SgStringLengthExp::~SgStringLengthExp() -{ RemoveFromTableLlnd((void *) this);} - -inline SgExpression * SgStringLengthExp::length() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - - - -// SgDefaultExp--inlines - -inline SgDefaultExp::SgDefaultExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgDefaultExp::SgDefaultExp():SgExpression(DEFAULT) -{} - -inline SgDefaultExp::~SgDefaultExp() -{ RemoveFromTableLlnd((void *) this); } - - -// SgLabelRefExp--inlines - -inline SgLabelRefExp::SgLabelRefExp(PTR_LLND ll):SgExpression(ll) -{} - -inline SgLabelRefExp::SgLabelRefExp(SgLabel &label):SgExpression(LABEL_REF) -{ NODE_LABEL(thellnd) = label.thelabel; } - -inline SgLabelRefExp::~SgLabelRefExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgLabel * SgLabelRefExp::label() -{ return LabelMapping(NODE_LABEL(thellnd)); } - - -// SgProgHedrStmt--inlines - - -inline SgProgHedrStmt::SgProgHedrStmt(PTR_BFND bif):SgStatement(bif) -{} - -inline SgProgHedrStmt::SgProgHedrStmt(int variant):SgStatement(variant) -{ addControlEndToStmt(thebif); } - -inline SgProgHedrStmt::SgProgHedrStmt(SgSymbol &name, SgStatement &Body):SgStatement(PROG_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - insertBfndListIn(Body.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -inline SgProgHedrStmt::SgProgHedrStmt(SgSymbol &name):SgStatement(PROG_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - addControlEndToStmt(thebif); -} - -inline SgProgHedrStmt::SgProgHedrStmt(char *name):SgStatement(PROG_HEDR) -{ - SgSymbol *proc; - proc = new SgSymbol(PROGRAM_NAME, name); - SYMB_SCOPE(proc->thesymb) = PROJ_FIRST_BIF(); - SYMB_TYPE(proc->thesymb) = GetAtomicType(DEFAULT); - BIF_SYMB(thebif) = proc->thesymb; - addControlEndToStmt(thebif); -} - -inline SgSymbol & SgProgHedrStmt::name() -{ - PTR_SYMB symb; - SgSymbol *pt = NULL; - symb = BIF_SYMB(thebif); - if (!symb) - { - Message("The bif has no symbol", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - else - { - pt = GetMappingInTableForSymbol(symb); - if (!pt) - pt = new SgSymbol(symb); - } - return *pt; -} - -inline void SgProgHedrStmt::setName(SgSymbol &symbol) -{ BIF_SYMB(thebif) = symbol.thesymb; } - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::numberOfFunctionsCalled() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgSymbol * SgProgHedrStmt::calledFunction(int i) -{ - SORRY; - return (SgSymbol *) NULL; -} -#endif - -inline int SgProgHedrStmt::numberOfStmtFunctions() -{ return countInStmtNode1(thebif, STMTFN_STAT); } - -inline SgStatement * SgProgHedrStmt::statementFunc(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif, STMTFN_STAT, i)); } - -inline int SgProgHedrStmt::numberOfEntryPoints() -{ return countInStmtNode1(thebif, ENTRY_STAT); } - -inline SgStatement * SgProgHedrStmt::entryPoint(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif, ENTRY_STAT, i)); } - -inline int SgProgHedrStmt::numberOfParameters() -{ - if (BIF_CODE(thebif) == PROG_HEDR) - return 0; - else - return lenghtOfParamList(BIF_SYMB(thebif)); -} - -inline SgSymbol * SgProgHedrStmt::parameter(int i) -{ - PTR_SYMB symb; - symb = GetThParam(BIF_SYMB(thebif),i); - return SymbMapping(symb); -} - - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::numberOfSpecificationStmts() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::numberOfExecutionStmts() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgStatement * SgProgHedrStmt::specificationStmt(int i) -{ - SORRY; - return (SgStatement *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgStatement * SgProgHedrStmt::executionStmt(int i) -{ - SORRY; - return (SgStatement *) NULL; -} -#endif - -inline int SgProgHedrStmt::numberOfInternalFunctionsDefined() -{ return countInStmtNode1(thebif, FUNC_HEDR); } - -inline int SgProgHedrStmt::numberOfInternalSubroutinesDefined() -{ return countInStmtNode1(thebif, PROC_HEDR); } - -inline int SgProgHedrStmt::numberOfInternalSubProgramsDefined() -{ - return (countInStmtNode1(thebif, FUNC_HEDR) + - countInStmtNode1(thebif, PROC_HEDR)) ; -} - -#ifdef NOT_YET_IMPLEMENTED -inline SgStatement * SgProgHedrStmt::internalSubProgram(int i) -{ - SORRY; - return (SgStatement *) NULL; -} -#endif - -inline SgStatement * SgProgHedrStmt::internalFunction(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif, FUNC_HEDR, i)); } - -inline SgStatement * SgProgHedrStmt::internalSubroutine(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif, PROC_HEDR, i)); } - - -#ifdef NOT_YET_IMPLEMENTED -SgSymbol &addVariable(SgType &T, char *name) -{ - SORRY; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -//add a declaration for new variable -SgStatement &addCommonBlock(char *blockname, int noOfVars, - SgSymbol *Vars) -{ - SORRY; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::isSymbolInScope(SgSymbol &symbol) -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::isSymbolDeclaredHere(SgSymbol &symbol) -{ - SORRY; - return 0; -} -#endif - -// global analysis data - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::numberOfVarsUsed() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgExpression * SgProgHedrStmt::varsUsed(int i) -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProgHedrStmt::numberofVarsMod() -{ - SORRY; - return 0; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline SgExpression *varsMod(int i) -{ - SORRY; - return (SgExpression *) NULL; -} -#endif - -inline SgProgHedrStmt::~SgProgHedrStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgProcHedrStmt--inlines - -inline SgProcHedrStmt::SgProcHedrStmt(int variant):SgProgHedrStmt(variant) -{ } - -inline SgProcHedrStmt::SgProcHedrStmt(SgSymbol &name, SgStatement &Body):SgProgHedrStmt(PROC_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - if(LibClanguage()) - { - printf("SgProcHedrStmt: not a valid C construct. use FuncHedr\n"); - } - name.thesymb->entry.proc_decl.proc_hedr = thebif; - insertBfndListIn(Body.thebif,thebif,thebif); -} - -inline SgProcHedrStmt::SgProcHedrStmt(SgSymbol &name):SgProgHedrStmt(PROC_HEDR) -{ BIF_SYMB(thebif) = name.thesymb; - name.thesymb->entry.proc_decl.proc_hedr = thebif; - if(LibClanguage()){ - printf("SgProcHedrStmt: not a valid C construct. use FuncHedr\n"); - } -} - -inline SgProcHedrStmt::SgProcHedrStmt(const char *name):SgProgHedrStmt(PROC_HEDR) -{ - SgSymbol *proc; - proc = new SgSymbol(PROCEDURE_NAME, name); - SYMB_SCOPE(proc->thesymb) = PROJ_FIRST_BIF(); - SYMB_TYPE(proc->thesymb) = GetAtomicType(DEFAULT); - BIF_SYMB(thebif) = proc->thesymb; - proc->thesymb->entry.proc_decl.proc_hedr = thebif; - if(LibClanguage()){ - printf("SgProcHedrStmt: not a valid C construct. use FuncHedr\n"); - } - -} - -inline void SgProcHedrStmt::AddArg(SgExpression &arg) -{ - PTR_SYMB symb; - PTR_LLND ll; - - if(LibFortranlanguage()) - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); - else{ - ll = BIF_LL1(thebif); - ll = NODE_OPERAND0(ll); - NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg.thellnd); - } - ll = giveLlSymbInDeclList(arg.thellnd); - if (ll && (symb= NODE_SYMB(ll))) - { - appendSymbToArgList(BIF_SYMB(thebif),symb); - SYMB_SCOPE(symb) = thebif; - if(LibFortranlanguage()) - declareAVar(symb,thebif); - } - else - { - Message("bad symbol in SgProcHedrStmt::AddArg", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } -} - - -#ifdef NOT_YET_IMPLEMENTED -inline int SgProcHedrStmt::isRecursive() // 1 if recursive. -{ - SORRY; - return 0; - //return isAttributeSet(BIF_SYMB(thebif), RECURSIVE_BIT); -} -#endif - -inline int SgProcHedrStmt::numberOfEntryPoints() -{ return countInStmtNode1(thebif,ENTRY_STAT); } - -inline SgStatement * SgProcHedrStmt::entryPoint(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif,ENTRY_STAT,i)); } - -// this is incorrect. Takes only subroutines calls into account. -// Should be modified to take function calls into account too. -inline int SgProcHedrStmt::numberOfCalls() -{ return countInStmtNode1(thebif,PROC_STAT); } - -inline SgStatement * SgProcHedrStmt::call(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif,PROC_STAT,i)); } - -inline SgProcHedrStmt::~SgProcHedrStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgProsHedrStmt--inlines - -inline SgProsHedrStmt::SgProsHedrStmt():SgProgHedrStmt(PROS_HEDR) -{} - -inline SgProsHedrStmt::SgProsHedrStmt(SgSymbol &name, SgStatement &Body) - :SgProgHedrStmt(PROS_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - insertBfndListIn(Body.thebif,thebif,thebif); -} - -inline SgProsHedrStmt::SgProsHedrStmt(SgSymbol &name):SgProgHedrStmt(PROS_HEDR) -{ BIF_SYMB(thebif) = name.thesymb; } - -inline SgProsHedrStmt::SgProsHedrStmt(char *name):SgProgHedrStmt(PROS_HEDR) -{ - SgSymbol *pros; - pros = new SgSymbol(PROCESS_NAME, name); - SYMB_SCOPE(pros->thesymb) = PROJ_FIRST_BIF(); - SYMB_TYPE(pros->thesymb) = GetAtomicType(DEFAULT); - BIF_SYMB(thebif) = pros->thesymb; -} - -inline void SgProsHedrStmt::AddArg(SgExpression &arg) -{ - PTR_SYMB symb; - PTR_LLND ll; - - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); - ll = giveLlSymbInDeclList(arg.thellnd); - if (ll && (symb= NODE_SYMB(ll))) - { - appendSymbToArgList(BIF_SYMB(thebif),symb); - SYMB_SCOPE(symb) = thebif; - declareAVar(symb,thebif); - } - else - { - Message("Pb in SgProsHedrStmt::AddArg", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } -} - -inline int SgProsHedrStmt::numberOfCalls() -{ return countInStmtNode1(thebif,PROS_STAT); } - -inline SgStatement * SgProsHedrStmt::call(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif,PROS_STAT,i)); } - -inline SgProsHedrStmt::~SgProsHedrStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgFuncHedrStmt--inlines -inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgStatement &Body): - SgProcHedrStmt(FUNC_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - if(LibClanguage()){ - SgExpression *fref = new SgExpression(FUNCTION_REF); - fref->setSymbol(name); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); - } - SYMB_FUNC_HEDR(name.thesymb) = thebif; - insertBfndListIn(Body.thebif,thebif,thebif); -} - -inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgType &type, SgStatement &Body): SgProcHedrStmt(FUNC_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - if(LibClanguage()){ - SgExpression *fref = new SgExpression(FUNCTION_REF); - fref->setSymbol(name); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); - } - SYMB_TYPE(BIF_SYMB(thebif)) = type.thetype; - SYMB_FUNC_HEDR(name.thesymb) = thebif; - insertBfndListIn(Body.thebif,thebif,thebif); -} - -inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgSymbol &resultName, - SgType &type, SgStatement &Body): SgProcHedrStmt(FUNC_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - if(LibClanguage()){ - SgExpression *fref = new SgExpression(FUNCTION_REF); - fref->setSymbol(name); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); - } - SYMB_TYPE(BIF_SYMB(thebif)) = type.thetype; - SYMB_DECLARED_NAME(BIF_SYMB(thebif)) = resultName.thesymb; - SYMB_FUNC_HEDR(name.thesymb) = thebif; - insertBfndListIn(Body.thebif,thebif,thebif); -} - -inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name): SgProcHedrStmt(FUNC_HEDR) -{ BIF_SYMB(thebif) = name.thesymb; - if(LibClanguage()){ - SgExpression *fref = new SgExpression(FUNCTION_REF); - fref->setSymbol(name); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); - } -} - -inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgExpression *exp): SgProcHedrStmt(FUNC_HEDR) -{ - BIF_SYMB(thebif) = name.thesymb; - if (exp) - BIF_LL1(thebif) = exp->thellnd; - SYMB_FUNC_HEDR(name.thesymb) = thebif; -} - -inline SgFuncHedrStmt::SgFuncHedrStmt(char *name): SgProcHedrStmt(FUNC_HEDR) -{ - SgSymbol *proc; - proc = new SgSymbol(FUNCTION_NAME, name); - if(LibClanguage()){ - SgExpression *fref = new SgExpression(FUNCTION_REF); - fref->setSymbol(*proc); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); - } - SYMB_SCOPE(proc->thesymb) = PROJ_FIRST_BIF(); - SYMB_TYPE(proc->thesymb) = GetAtomicType(T_INT); - SYMB_FUNC_HEDR(proc->thesymb) = thebif; - BIF_SYMB(thebif) = proc->thesymb; -} - -inline SgFuncHedrStmt::~SgFuncHedrStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgType * SgFuncHedrStmt::returnedType() -{ - PTR_TYPE ty = NULL; - if (BIF_SYMB(thebif)) - ty = SYMB_TYPE(BIF_SYMB(thebif)); - return TypeMapping(ty); -} - -inline void SgFuncHedrStmt::setReturnedType(SgType &type) -{ - if (BIF_SYMB(thebif)) - SYMB_TYPE(BIF_SYMB(thebif)) = type.thetype; -} - -//fixed by Kolganov A.S. 02.06.2022 -inline SgSymbol* SgFuncHedrStmt::resultName() // name of result variable. -{ - SgSymbol* x = NULL; - PTR_LLND ll = BIF_LL1(thebif); - if (ll) - x = SymbMapping(NODE_SYMB(ll)); - return x; -} - -// Use Message to flag error and type it void? -//fixed by Kolganov A.S. 02.06.2022 -inline int SgFuncHedrStmt::setResultName(SgSymbol& symbol) // set name of result variable. -{ - int x = 0; - PTR_LLND ll = BIF_LL1(thebif); - if (ll) - { - x = 1; - NODE_SYMB(ll) = symbol.thesymb; - } - return x; -} - - -// SgClassStmt--inlines - -inline SgClassStmt::SgClassStmt(int variant):SgStatement(variant) -{} - -inline SgClassStmt::SgClassStmt(SgSymbol &name):SgStatement(CLASS_DECL) -{ BIF_SYMB(thebif) = name.thesymb; } - -inline SgClassStmt::~SgClassStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline int SgClassStmt::numberOfSuperClasses() -{ return exprListLength(BIF_LL2(thebif)); } - -inline SgSymbol * SgClassStmt::name() -{ return SymbMapping(BIF_SYMB(thebif)); } - -inline SgSymbol * SgClassStmt::superClass(int i) -{ - PTR_LLND pt; - SgSymbol *x; - - pt = getPositionInExprList(BIF_LL2(thebif),i); - pt = giveLlSymbInDeclList(pt); - if (pt) - x = SymbMapping(NODE_SYMB(pt)); - else - x = SymbMapping(NULL); - - return x; -} - -inline void SgClassStmt::setSuperClass(int i, SgSymbol &symb) -{ - PTR_LLND pt; - - if (!BIF_LL2(thebif)) - { - BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif),newExpr(VAR_REF,NULL,symb.thesymb)); - } - else - { - pt = getPositionInExprList(BIF_LL2(thebif),i); - pt = giveLlSymbInDeclList(pt); - if (pt) - NODE_SYMB(pt) = symb.thesymb; - else - BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif),newExpr(VAR_REF,NULL,symb.thesymb)); - } -} - - -// SgStructStmt--inlines - -inline SgStructStmt::SgStructStmt():SgClassStmt(STRUCT_DECL) -{} - -inline SgStructStmt::SgStructStmt(SgSymbol &name):SgClassStmt(name) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_CODE(thebif) = STRUCT_DECL; -} - -inline SgStructStmt::~SgStructStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgUnionStmt--inlines -// consider like a class. -inline SgUnionStmt::SgUnionStmt():SgClassStmt(UNION_DECL) -{} - -inline SgUnionStmt::SgUnionStmt(SgSymbol &name):SgClassStmt(name) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_CODE(thebif) = UNION_DECL; -} - -inline SgUnionStmt::~SgUnionStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgEnumStmt--inlines -// consider like a class. -inline SgEnumStmt::SgEnumStmt():SgClassStmt(ENUM_DECL) -{} - -inline SgEnumStmt::SgEnumStmt(SgSymbol &name):SgClassStmt(name) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_CODE(thebif) = ENUM_DECL; -} - -inline SgEnumStmt::~SgEnumStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgCollectionStmt--inlines - -inline SgCollectionStmt::SgCollectionStmt():SgClassStmt(COLLECTION_DECL) -{} - -inline SgCollectionStmt::SgCollectionStmt(SgSymbol &name):SgClassStmt(name) -{ BIF_CODE(thebif) = COLLECTION_DECL; } - -inline SgCollectionStmt::~SgCollectionStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgStatement * SgCollectionStmt::firstElementMethod() -{ return BfndMapping(LibfirstElementMethod(thebif)); } - - -// SgBasicBlockStmt--inlines -inline SgBasicBlockStmt::SgBasicBlockStmt(): SgStatement(BASIC_BLOCK) -{} - -inline SgBasicBlockStmt::~SgBasicBlockStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgForStmt--inlines -inline SgForStmt::SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end, - SgExpression &step, SgStatement &body):SgStatement(FOR_NODE) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_SYMB(thebif) = do_var.thesymb; - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end.thellnd),start.thellnd,end.thellnd); - BIF_LL2(thebif) = step.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} - -inline SgForStmt::SgForStmt(SgSymbol *do_var, SgExpression *start, SgExpression *end, - SgExpression *step, SgStatement *body):SgStatement(FOR_NODE) -{ - if (CurrentProject->Fortranlanguage()) - { - if (do_var) - BIF_SYMB(thebif) = do_var->thesymb; - if (start && end) - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end->thellnd),start->thellnd,end->thellnd); - if (step) - BIF_LL2(thebif) = step->thellnd; - if (body) - insertBfndListIn(body->thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} - -inline SgForStmt::SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end - , SgStatement &body):SgStatement(FOR_NODE) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_SYMB(thebif) = do_var.thesymb; - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end.thellnd),start.thellnd,end.thellnd); - BIF_LL2(thebif) = NULL; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} -// For C Statement; -// added by Kolganov A.S. 24.10.2013 -inline SgForStmt::SgForStmt(SgExpression *start, SgExpression *end, SgExpression *step, SgStatement *body): SgStatement(FOR_NODE) -{ - if(start) - BIF_LL1(thebif) = start->thellnd; - if(end) - BIF_LL2(thebif) = end->thellnd; - if(step) - BIF_LL3(thebif) = step->thellnd; - - if(body) - insertBfndListIn(body->thebif, thebif, thebif); - addControlEndToStmt(thebif); -} - -inline SgForStmt::SgForStmt(SgExpression &start, SgExpression &end, - SgExpression &step, SgStatement &body):SgStatement(FOR_NODE) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end.thellnd),start.thellnd,end.thellnd); - BIF_LL2(thebif) = step.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - BIF_LL1(thebif) = start.thellnd; - BIF_LL2(thebif) = end.thellnd; - BIF_LL3(thebif) = step.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } -} - -inline void SgForStmt::setDoName(SgSymbol &doName) -{ BIF_SYMB(thebif) = doName.thesymb; } // sets the name of the loop (for F90.) - -#if __SPF -inline SgSymbol* SgForStmt::doName() -{ - return symbol(); -} -#else -inline SgSymbol SgForStmt::doName() -{ - return SgSymbol(BIF_SYMB(thebif)); // the name of the loop (for F90.) -} -#endif - -inline SgExpression * SgForStmt::start() -{ - SgExpression *x; - - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && - (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - x = LlndMapping(NODE_OPERAND0(BIF_LL1(thebif))); - else { - x = NULL; - SORRY; - } - } - else - x = LlndMapping(BIF_LL1(thebif)); - - return x; -} - -inline void SgForStmt::setStart(SgExpression &lbound) -{ - - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && - (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - { - NODE_OPERAND0(BIF_LL1(thebif)) = lbound.thellnd; - } - else - { - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(lbound.thellnd),lbound.thellnd,NULL); - } - } - else - { - BIF_LL1(thebif) = lbound.thellnd; - } -} - -inline SgExpression * SgForStmt::end() -{ - SgExpression *x; - - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && - (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - x = LlndMapping(NODE_OPERAND1(BIF_LL1(thebif))); - else { - x = NULL; - SORRY; - } - } - else /* BW, change contributed by Michael Golden */ - { - if (BIF_LL2(thebif) == LLNULL) - x = NULL; - else - x = LlndMapping(BIF_LL2(thebif)); - } - return x; -} - -inline void SgForStmt::setEnd(SgExpression &ubound) -{ - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && - (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - NODE_OPERAND1(BIF_LL1(thebif)) = ubound.thellnd; - else - { - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(ubound.thellnd),NULL,ubound.thellnd); - } - } - else - { - BIF_LL2(thebif) = ubound.thellnd; - } -} - - -inline SgLabel * SgForStmt::endOfLoop() - { return LabelMapping(BIF_LABEL_USE(thebif)); } - -inline SgExpression * SgForStmt::step() -{ - SgExpression *x; - if (CurrentProject->Fortranlanguage()) - { - x = LlndMapping(BIF_LL2(thebif)); - } - else /* BW, change contributed by Michael Golden */ - { - if (BIF_LL3(thebif) == LLNULL) - x = NULL; - else - x = LlndMapping(BIF_LL3(thebif)); - } - - return x; -} - -inline void SgForStmt::setStep(SgExpression &step) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_LL2(thebif) = step.thellnd; - } - else - { - BIF_LL3(thebif) = step.thellnd; - } -} - -//added by Kolganov A.S. 27.10.2020 -inline void SgForStmt::interchangeNestedLoops(SgForStmt* loop) -{ - std::swap(BIF_LL1(thebif), BIF_LL1(loop->thebif)); - std::swap(BIF_LL2(thebif), BIF_LL2(loop->thebif)); - std::swap(BIF_LL3(thebif), BIF_LL3(loop->thebif)); - std::swap(BIF_SYMB(thebif), BIF_SYMB(loop->thebif)); - std::swap(BIF_LABEL(thebif), BIF_LABEL(loop->thebif)); -} - -inline SgStatement * SgForStmt::body() -{ - PTR_BFND bif =NULL; - - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - - return BfndMapping(bif); -} - -// s is assumed to terminate with a -// control end statement. -inline void SgForStmt::set_body(SgStatement &s) -{ - BIF_BLOB1(thebif) = NULL; - insertBfndListIn(s.thebif,thebif,thebif); -} - -// False if the loop is not a prefect nest -// else returns size of the loop nest - -inline int SgForStmt::isPerfectLoopNest() -{ return LibperfectlyNested (thebif); } - -// returns inner nested loop -inline SgStatement * SgForStmt::getNextLoop() -{ return BfndMapping(LibgetNextNestedLoop (thebif)); } - -// returns outer nested loop -inline SgStatement * SgForStmt::getPreviousLoop() -{ return BfndMapping(LibgetPreviousNestedLoop (thebif)); } - -// returns innermost nested loop -inline SgStatement * SgForStmt::getInnermostLoop() -{ return BfndMapping(LibgetInnermostLoop (thebif)); } - -// TRUE if the loop ends with an Enddo -inline int SgForStmt::isEnddoLoop() -{ return LibisEnddoLoop (thebif); } - -// Convert the loop into a Good loop. -inline int SgForStmt::convertLoop() -{ return convertToEnddoLoop (thebif); } - -inline SgForStmt::~SgForStmt() -{ RemoveFromTableBfnd((void *) this);} - - - -// SgProcessDoStmt--inlines -inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgExpression &step, - SgLabel &endofloop, SgStatement &body) - :SgStatement(PROCESS_DO_STAT) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_SYMB(thebif) = do_var.thesymb; - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end.thellnd); - BIF_LL2(thebif) = step.thellnd; - BIF_LABEL_USE(thebif) = endofloop.thelabel; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} - -inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgLabel &endofloop, - SgStatement &body) - :SgStatement(PROCESS_DO_STAT) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_SYMB(thebif) = do_var.thesymb; - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end. -thellnd); - BIF_LABEL_USE(thebif) = endofloop.thelabel; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} - -inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgExpression &step, - SgStatement &body) - :SgStatement(PROCESS_DO_STAT) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_SYMB(thebif) = do_var.thesymb; - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end. -thellnd); - BIF_LL2(thebif) = step.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} - -inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, - SgExpression &end, SgStatement &body) - :SgStatement(PROCESS_DO_STAT) -{ - if (CurrentProject->Fortranlanguage()) - { - BIF_SYMB(thebif) = do_var.thesymb; - BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end. -thellnd); - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); - } else - { - SORRY; - } -} - - -inline void SgProcessDoStmt::setDoName(SgSymbol &doName) -{ BIF_SYMB(thebif) = doName.thesymb; } - -/* -inline SgSymbol SgProcessDoStmt::doName() -{ return SgSymbol(BIF_SYMB(thebif)); } -*/ - -inline SgExpression * SgProcessDoStmt::start() -{ - SgExpression *x; - - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && - (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - x = LlndMapping(NODE_OPERAND0(BIF_LL1(thebif))); - else { - x = NULL; - SORRY; - } - } - else { - x = NULL; - SORRY; - } - - return x; -} - -inline SgExpression * SgProcessDoStmt::end() -{ - SgExpression *x; - - if (CurrentProject->Fortranlanguage()) - { - if ((BIF_LL1(thebif) != LLNULL) && - (NODE_CODE(BIF_LL1(thebif)) == DDOT)) - x = LlndMapping(NODE_OPERAND1(BIF_LL1(thebif))); - else { - x = NULL; - SORRY; - } - } - else { - x = NULL; - SORRY; - } - - return x; -} - -inline SgExpression * SgProcessDoStmt::step() -{ - SgExpression *x; - if (CurrentProject->Fortranlanguage()) - { - x = LlndMapping(BIF_LL2(thebif)); - } - else { - x = NULL; - SORRY; - }; - - return x; -} - -inline SgLabel * SgProcessDoStmt::endOfLoop() -{ return LabelMapping(BIF_LABEL_USE(thebif)); } - -inline SgStatement * SgProcessDoStmt::body() -{ - PTR_BFND bif =NULL; - - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - - return BfndMapping(bif); -} - -// s is assumed to terminate with a -// control end statement. -inline void SgProcessDoStmt::set_body(SgStatement &s) -{ - BIF_BLOB1(thebif) = NULL; - insertBfndListIn(s.thebif,thebif,thebif); -} - -// False if the loop is not a prefect nest -// else returns size of the loop nest - -inline int SgProcessDoStmt::isPerfectLoopNest() -{ return LibperfectlyNested (thebif); } - -// returns inner nested loop -inline SgStatement * SgProcessDoStmt::getNextLoop() -{ return BfndMapping(LibgetNextNestedLoop (thebif)); } - -// returns outer nested loop -inline SgStatement * SgProcessDoStmt::getPreviousLoop() -{ return BfndMapping(LibgetPreviousNestedLoop (thebif)); } - -// returns innermost nested loop -inline SgStatement * SgProcessDoStmt::getInnermostLoop() -{ return BfndMapping(LibgetInnermostLoop (thebif)); } - -// TRUE if the loop ends with an Enddo -inline int SgProcessDoStmt::isEnddoLoop() -{ return LibisEnddoLoop (thebif); } - -// Convert the loop into a Good loop. -inline int SgProcessDoStmt::convertLoop() -{ return convertToEnddoLoop (thebif); } - -inline SgProcessDoStmt::~SgProcessDoStmt() -{ RemoveFromTableBfnd((void *) this);} - - - -// SgWhileStmt--inlines - -inline SgWhileStmt::SgWhileStmt(int variant):SgStatement(variant) -{} - -inline SgWhileStmt::SgWhileStmt(SgExpression &cond, SgStatement &body):SgStatement(WHILE_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -//added by A.S.Kolganov 08.04.2015 -inline SgWhileStmt::SgWhileStmt(SgExpression *cond, SgStatement *body) :SgStatement(WHILE_NODE) -{ - if (cond) - BIF_LL1(thebif) = cond->thellnd; - if (body) - insertBfndListIn(body->thebif, thebif, thebif); - addControlEndToStmt(thebif); -} - -// the while test -inline SgExpression * SgWhileStmt::conditional() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgWhileStmt::replaceBody(SgStatement &s) -{ - BIF_BLOB1(thebif) = NULL; - insertBfndListIn(s.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -// added by A.V.Rakov 16.03.2015 -inline SgStatement * SgWhileStmt::body() -{ - PTR_BFND bif = NULL; - - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - - return BfndMapping(bif); -} - -inline SgWhileStmt::~SgWhileStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgDoWhileStmt--inlines - -inline SgDoWhileStmt::SgDoWhileStmt(SgExpression &cond, SgStatement &body): SgWhileStmt(DO_WHILE_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -inline SgDoWhileStmt::~SgDoWhileStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgLabel *SgWhileStmt::endOfLoop( ) -{ - return LabelMapping(BIF_LABEL_USE(thebif)); -} - -// SgLofIfStmt--inlines - -inline SgLogIfStmt::SgLogIfStmt(int variant):SgStatement(variant) -{} - -inline SgLogIfStmt::SgLogIfStmt(SgExpression &cond, SgStatement &s):SgStatement(LOGIF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(s.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -inline SgStatement * SgLogIfStmt::body() -{ - PTR_BFND bif =NULL; - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - return BfndMapping(bif); -} - -inline SgExpression * SgLogIfStmt::conditional() -{ return LlndMapping(BIF_LL1(thebif)); } // the while test - -// check if the statement s is a single statement. -inline void SgLogIfStmt::setBody(SgStatement &s) -{ - BIF_BLOB1(thebif) = NULL; - insertBfndListIn(s.thebif,thebif,thebif); -} - -// this code won't work, since after the addition false -// clause, it should become SgIfThenElse statement. -inline void SgLogIfStmt::addFalseClause(SgStatement &s) -{ - appendBfndListToList2(s.thebif,thebif); - addControlEndToList2(thebif); -} - -//need a forward definition; -SgIfStmt * isSgIfStmt (SgStatement *pt); - -inline SgIfStmt *SgLogIfStmt::convertLogicIf() -{ - LibconvertLogicIf(thebif); - return isSgIfStmt(this); -} - -inline SgLogIfStmt::~SgLogIfStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgIfStmt--inlines -inline SgIfStmt::SgIfStmt(int variant): SgStatement(variant) -{} - -// added by A.S.Kolganov 02.07.2014 -inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &body, int t) : SgStatement(IF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - if (t == 0) // only false body - appendBfndListToList2(body.thebif, thebif); - else if (t == 1) // only true body - insertBfndListIn(body.thebif, thebif, thebif); - addControlEndToStmt(thebif); -} -// added by A.S.Kolganov 21.12.2014 -inline SgIfStmt::SgIfStmt(SgExpression &cond) : SgStatement(IF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - addControlEndToStmt(thebif); -} - -inline SgIfStmt::SgIfStmt(SgExpression* cond) : SgStatement(IF_NODE) -{ - if (cond) - BIF_LL1(thebif) = cond->thellnd; - addControlEndToStmt(thebif); -} - -inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody, SgSymbol &construct_name):SgStatement(IF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - BIF_SYMB(thebif) = construct_name.thesymb; - insertBfndListIn(trueBody.thebif,thebif,thebif); - appendBfndListToList2(falseBody.thebif,thebif); - addControlEndToStmt(thebif); -} - -inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody):SgStatement(IF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(trueBody.thebif,thebif,thebif); - appendBfndListToList2(falseBody.thebif,thebif); - addControlEndToStmt(thebif); -} - -inline void SgIfStmt::setBodies(SgStatement *trueBody, SgStatement *falseBody) -{ - if (trueBody && falseBody) - { - insertBfndListIn(trueBody->thebif, thebif, thebif); - appendBfndListToList2(falseBody->thebif, thebif); - addControlEndToStmt(thebif); - } - else if (trueBody) - { - insertBfndListIn(trueBody->thebif, thebif, thebif); - addControlEndToStmt(thebif); - } -} - -inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &trueBody):SgStatement(IF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(trueBody.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -// the first stmt in the True clause -inline SgStatement * SgIfStmt::trueBody() -{ - PTR_BFND bif = NULL; - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - return BfndMapping(bif); -} - -// SgBlock is needed? -// i-th stmt in True clause -inline SgStatement * SgIfStmt::trueBody(int i) -{ - PTR_BFND bif =NULL; - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - return BfndMapping(getStatementNumber(bif,i)); -} - -// the first stmt in the False -inline SgStatement * SgIfStmt::falseBody() -{ - PTR_BFND bif = NULL; - if (BIF_BLOB2(thebif)) - bif = BLOB_VALUE(BIF_BLOB2(thebif)); - return BfndMapping(bif); -} - -// i-th statement of the body. -inline SgStatement * SgIfStmt::falseBody(int i) -{ - PTR_BFND bif =NULL; - if (BIF_BLOB2(thebif)) - bif = BLOB_VALUE(BIF_BLOB2(thebif)); - return BfndMapping(getStatementNumber(bif,i)); -} - -// the while test -inline SgExpression * SgIfStmt::conditional() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline SgSymbol * SgIfStmt::construct_name() -{ return SymbMapping(BIF_SYMB(thebif)); } - -// new body=s and lex successors. -inline void SgIfStmt::replaceTrueBody(SgStatement &s) -{ - BIF_BLOB1(thebif) = NULL; - insertBfndListIn(s.thebif,thebif,thebif); -} - -// new body=s and lex successors. -inline void SgIfStmt::replaceFalseBody(SgStatement &s) -{ - BIF_BLOB2(thebif) = NULL; - appendBfndListToList2(s.thebif,thebif); - addControlEndToList2(thebif); -} - -inline SgIfStmt::~SgIfStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgArithIfStmt--inlines - -inline SgArithIfStmt::SgArithIfStmt(int variant):SgStatement(variant) -{} - -inline SgArithIfStmt::SgArithIfStmt(SgExpression &cond, SgLabel &llabel, SgLabel &elabel, SgLabel &glabel):SgStatement(ARITHIF_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - BIF_LL2(thebif) = addLabelRefToExprList(BIF_LL2(thebif),llabel.thelabel); - BIF_LL2(thebif) = addLabelRefToExprList(BIF_LL2(thebif),elabel.thelabel); - BIF_LL2(thebif) = addLabelRefToExprList(BIF_LL2(thebif),glabel.thelabel); -} - -inline SgExpression * SgArithIfStmt::conditional() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgArithIfStmt::set_conditional(SgExpression &cond) -{ BIF_LL1(thebif) = cond.thellnd; } - -// the <, ==, and > goto labels. in order 0->2. -inline SgExpression * SgArithIfStmt::label(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } - -#ifdef NOT_YET_IMPLEMENTED -inline void SgArithIfStmt::setLabel(SgLabel &label) -{ - BIF_LL3(thebif) = addLabelRefToExprList(BIF_LL3(thebif) , label.thelabel); - SORRY; -} -#endif - -inline SgArithIfStmt::~SgArithIfStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgWhereStmt--inlines - -inline SgWhereStmt::SgWhereStmt(SgExpression &cond, SgStatement &body):SgLogIfStmt(WHERE_NODE) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -inline SgWhereStmt::~SgWhereStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgWhereBlockStmt--inlines - -inline SgWhereBlockStmt::SgWhereBlockStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody):SgIfStmt(WHERE_BLOCK_STMT) -{ - BIF_LL1(thebif) = cond.thellnd; - insertBfndListIn(trueBody.thebif,thebif,thebif); - appendBfndListToList2(falseBody.thebif,thebif); - // appendBfndListToList2 does not update BIF_ NEXT... - addControlEndToList2(thebif); -} - -inline SgWhereBlockStmt::~SgWhereBlockStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgSwitchStmt--inlines - -inline SgSwitchStmt::SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList, - SgSymbol &constructName):SgStatement(SWITCH_NODE) -{ - BIF_SYMB(thebif) = constructName.thesymb; - BIF_LL1(thebif) = selector.thellnd; - insertBfndListIn(caseOptionList.thebif,thebif,thebif); -} - -// added by A.V.Rakov 16.03.2015 -inline SgSwitchStmt::SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList) :SgStatement(SWITCH_NODE) -{ - BIF_LL1(thebif) = selector.thellnd; - insertBfndListIn(caseOptionList.thebif, thebif, thebif); -} - -// added by A.S. Kolganov 14.04.2015 -inline SgSwitchStmt::SgSwitchStmt(SgExpression &selector) :SgStatement(SWITCH_NODE) -{ - BIF_LL1(thebif) = selector.thellnd; -} - -inline SgSwitchStmt::~SgSwitchStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgExpression * SgSwitchStmt::selector() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgSwitchStmt::setSelector(SgExpression &cond) -{ BIF_LL1(thebif) = cond.thellnd; } - -// the number of cases -inline int SgSwitchStmt::numberOfCaseOptions() -{ return countInStmtNode1(thebif,CASE_NODE); } - -// i-th case block -inline SgStatement * SgSwitchStmt::caseOption(int i) -{ return BfndMapping(GetcountInStmtNode1(thebif,CASE_NODE,i)); } - -// added by A.V.Rakov 16.03.2015 -inline SgStatement * SgSwitchStmt::defOption() -{ return BfndMapping(GetcountInStmtNode1(thebif, DEFAULT_NODE, 0)); } -inline void SgSwitchStmt::addCaseOption(SgStatement &caseOption) -{ insertBfndListIn(caseOption.thebif,thebif,thebif); } - -#if 0 -// extractBifSectionBetween not defined -inline void SgSwitchStmt::deleteCaseOption(int i) -{ - PTR_BFND pt; - if ( pt = GetcountInStmtNode1(thebif,CASE_NODE,i)) - extractBifSectionBetween(pt,getLastNodeOfStmt(pt)); -} -#endif - - -// SgCaseOptionStmt--inlines - -inline SgCaseOptionStmt::SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body) : SgStatement(CASE_NODE) -{ - BIF_LL1(thebif) = caseRangeList.thellnd; - insertBfndListIn(body.thebif, thebif, thebif); - addControlEndToStmt(thebif); -} - -inline SgCaseOptionStmt::SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body, - SgSymbol &constructName):SgStatement(CASE_NODE) -{ - BIF_SYMB(thebif) = constructName.thesymb; - BIF_LL1(thebif) = caseRangeList.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); - addControlEndToStmt(thebif); -} - -inline SgCaseOptionStmt::SgCaseOptionStmt(SgExpression &caseRangeList) :SgStatement(CASE_NODE) -{ - BIF_LL1(thebif) = caseRangeList.thellnd; - addControlEndToStmt(thebif); -} - -inline SgCaseOptionStmt::~SgCaseOptionStmt() -{ RemoveFromTableBfnd((void *) this);} - -inline SgExpression * SgCaseOptionStmt::caseRangeList() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgCaseOptionStmt::setCaseRangeList(SgExpression &caseRangeList) -{ BIF_LL1(thebif) = caseRangeList.thellnd; } - -inline SgExpression * SgCaseOptionStmt::caseRange(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i));} - -inline void SgCaseOptionStmt::setCaseRange(int, SgExpression &caseRange) -{ - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),caseRange.thellnd); -} - -inline SgStatement * SgCaseOptionStmt::body() -{ - PTR_BFND bif =NULL; - if (BIF_BLOB1(thebif)) - bif = BLOB_VALUE(BIF_BLOB1(thebif)); - return BfndMapping(bif); -} - -inline void SgCaseOptionStmt::setBody(SgStatement &body) -{ - BIF_BLOB1(thebif) = NULL; - insertBfndListIn(body.thebif,thebif,thebif); -} - - -// ******************** Leaf Executable Nodes *********************** - -// SgExecutableStatement--inlines - -inline SgExecutableStatement::SgExecutableStatement(int variant):SgStatement(variant) -{} - -// SgAssignStmt--inlines - -inline SgAssignStmt::SgAssignStmt(int variant):SgExecutableStatement(variant) -{} -inline SgAssignStmt::SgAssignStmt(SgExpression &lhs, SgExpression &rhs):SgExecutableStatement(ASSIGN_STAT) -{ - BIF_LL1(thebif) = lhs.thellnd; - BIF_LL2(thebif) = rhs.thellnd; -} - -inline SgExpression * SgAssignStmt::lhs() -{ return LlndMapping(BIF_LL1(thebif)); } - -// the right hand side -inline SgExpression * SgAssignStmt::rhs() -{ return LlndMapping(BIF_LL2(thebif)); } - -// replace lhs with e -inline void SgAssignStmt::replaceLhs(SgExpression &e) -{ BIF_LL1(thebif) = e.thellnd; } - -// replace rhs with e -inline void SgAssignStmt::replaceRhs(SgExpression &e) -{ BIF_LL2(thebif) = e.thellnd; } - - -// SgCExpStmt--inlines -inline SgCExpStmt::SgCExpStmt(SgExpression &exp):SgExecutableStatement(EXPR_STMT_NODE) -{ BIF_LL1(thebif) = exp.thellnd; } - -inline SgCExpStmt::SgCExpStmt(SgExpression &lhs, SgExpression &rhs):SgExecutableStatement(EXPR_STMT_NODE) -{ BIF_LL1(thebif) =addToExprList(BIF_LL1(thebif),newExpr(ASSGN_OP,NULL,lhs.thellnd,rhs.thellnd)); } - -// the expression -inline SgExpression *SgCExpStmt::expr() -{ return LlndMapping(BIF_LL1(thebif)); } - -// replace exp with e -inline void SgCExpStmt::replaceExpression(SgExpression &e) -{ BIF_LL1(thebif) = e.thellnd; } - -inline SgCExpStmt::~SgCExpStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgPointerAssignStmt--inlines - -inline SgPointerAssignStmt::SgPointerAssignStmt(SgExpression lhs, SgExpression rhs):SgAssignStmt(POINTER_ASSIGN_STAT) -{ - BIF_LL1(thebif) = lhs.thellnd; - BIF_LL2(thebif) = rhs.thellnd; -} - -inline SgPointerAssignStmt::~SgPointerAssignStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgHeapStmt--inlines - -inline SgHeapStmt::SgHeapStmt(int variant, SgExpression &allocationList, SgExpression &statVariable):SgExecutableStatement(variant) -{ - BIF_LL1(thebif) = allocationList.thellnd; - BIF_LL2(thebif) = statVariable.thellnd; -} - -inline SgHeapStmt::~SgHeapStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgExpression * SgHeapStmt::allocationList() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgHeapStmt::setAllocationList(SgExpression &allocationList) -{ BIF_LL1(thebif) = allocationList.thellnd;} - -inline SgExpression * SgHeapStmt::statVariable() -{ return LlndMapping(BIF_LL2(thebif)); } - -inline void SgHeapStmt::setStatVariable(SgExpression &statVar) -{ BIF_LL2(thebif) = statVar.thellnd; } - - -// SgNullifyStmt--inlines - -inline SgNullifyStmt::SgNullifyStmt(SgExpression &objectList):SgExecutableStatement(NULLIFY_STMT) -{ BIF_LL1(thebif) = objectList.thellnd; } - -inline SgNullifyStmt::~SgNullifyStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgExpression * SgNullifyStmt::nullifyList() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgNullifyStmt::setNullifyList(SgExpression &nullifyList) -{ BIF_LL1(thebif) = nullifyList.thellnd; } - - -// SgContinueStmt--inlines - -inline SgContinueStmt::SgContinueStmt():SgExecutableStatement(CONT_STAT) -{} -inline SgContinueStmt::~SgContinueStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgControlEndStmt--inlines - -inline SgControlEndStmt::SgControlEndStmt(int variant):SgExecutableStatement(variant) -{} - -inline SgControlEndStmt::SgControlEndStmt():SgExecutableStatement(CONTROL_END) -{} - -inline SgControlEndStmt::~SgControlEndStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgBreakStmt--inlines - -inline SgBreakStmt::SgBreakStmt():SgExecutableStatement(BREAK_NODE) -{} - -inline SgBreakStmt::~SgBreakStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgCycleStmt--inlines - - -inline SgCycleStmt::SgCycleStmt(SgSymbol &symbol):SgExecutableStatement(CYCLE_STMT) -{ BIF_SYMB(thebif) = symbol.thesymb; } - -// added by A.S. Kolganov 20.12.2015 -inline SgCycleStmt::SgCycleStmt():SgExecutableStatement(CYCLE_STMT) -{ } - -// the name of the loop to cycle -inline SgSymbol * SgCycleStmt::constructName() -{ return SymbMapping(BIF_SYMB(thebif)); } - -inline void SgCycleStmt::setConstructName(SgSymbol &constructName) -{ BIF_SYMB(thebif) = constructName.thesymb; } - -inline SgCycleStmt::~SgCycleStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline SgExpression * SgReturnStmt::returnValue() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgReturnStmt::setReturnValue(SgExpression &retVal) -{ BIF_LL1(thebif) = retVal.thellnd; } - -inline SgReturnStmt::~SgReturnStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgExitStmt--inlines - -inline SgExitStmt::SgExitStmt(SgSymbol &construct_name):SgControlEndStmt(EXIT_STMT) -{ BIF_SYMB(thebif) = construct_name.thesymb; } - -inline SgExitStmt::~SgExitStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgSymbol * SgExitStmt::constructName() -{ return SymbMapping(BIF_SYMB(thebif)); } // the name of the loop to cycle - -inline void SgExitStmt::setConstructName(SgSymbol &constructName) -{ BIF_SYMB(thebif) = constructName.thesymb; } - - - -// SgGotoStmt--inlines -inline SgGotoStmt::SgGotoStmt(SgLabel &label):SgExecutableStatement(GOTO_NODE) -{ BIF_LL3(thebif) = SgLabelRefExp(label).thellnd; } -/* Tried to fix a bug reported by anl's people. - The following line is the original code. -{ BIF_LABEL(thebif) = label.thelabel; } -*/ - - -inline SgLabel * SgGotoStmt::branchLabel() -{ SgLabelRefExp *e = (SgLabelRefExp *) LlndMapping(BIF_LL3(thebif)); - return (e)?e->label(): (SgLabel *) NULL; - } - - -inline SgGotoStmt::~SgGotoStmt(){RemoveFromTableBfnd((void *) this);} - - -// SgLabelListStmt--inlines - -inline SgLabelListStmt::SgLabelListStmt(int variant):SgExecutableStatement(variant) -{} - -inline int SgLabelListStmt::numberOfTargets() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgExpression * SgLabelListStmt::labelList() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgLabelListStmt::setLabelList(SgExpression &labelList) -{ BIF_LL1(thebif) = labelList.thellnd; } - - - -// SgAssignedGotoStmt--inlines - -inline SgAssignedGotoStmt::SgAssignedGotoStmt(SgSymbol &symbol, SgExpression &labelList):SgLabelListStmt(ASSGOTO_NODE) -{ - BIF_SYMB(thebif) = symbol.thesymb; - BIF_LL1(thebif) = labelList.thellnd; -} - -inline SgSymbol * SgAssignedGotoStmt::symbol() -{ return SymbMapping(BIF_SYMB(thebif)); } - -inline void SgAssignedGotoStmt::setSymbol(SgSymbol &symb) -{ BIF_SYMB(thebif) = symb.thesymb; } - -inline SgAssignedGotoStmt::~SgAssignedGotoStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgComputedGotoStmt--inlines - -inline SgComputedGotoStmt::SgComputedGotoStmt(SgExpression &expr, SgLabel &label):SgLabelListStmt(COMGOTO_NODE) -{ - BIF_LL1(thebif) = addLabelRefToExprList(BIF_LL1(thebif),label.thelabel); - BIF_LL2(thebif) = expr.thellnd; -} - -inline void SgComputedGotoStmt::addLabel(SgLabel &label) -{ - BIF_LL1(thebif) = addLabelRefToExprList(BIF_LL1(thebif),label.thelabel); -} - -inline SgExpression * SgComputedGotoStmt::exp() -{ return LlndMapping(BIF_LL2(thebif)); } - -inline void SgComputedGotoStmt::setExp(SgExpression &exp) -{ BIF_LL2(thebif) = exp.thellnd; } - -inline SgComputedGotoStmt::~SgComputedGotoStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgStopOrPauseStmt--inlines - -inline SgStopOrPauseStmt::SgStopOrPauseStmt(int variant, SgExpression *expr):SgExecutableStatement(variant) -{ -if (expr) - BIF_LL1(thebif) = expr->thellnd; - } - -inline SgExpression * SgStopOrPauseStmt::exp() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgStopOrPauseStmt::setExp(SgExpression &exp) -{ BIF_LL1(thebif) = exp.thellnd; } - -inline SgStopOrPauseStmt::~SgStopOrPauseStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgCallStmt--inlines - -inline SgCallStmt::SgCallStmt(SgSymbol &name, SgExpression &args):SgExecutableStatement(PROC_STAT) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL1(thebif) = args.thellnd; -} - -inline SgCallStmt::SgCallStmt(SgSymbol &name):SgExecutableStatement(PROC_STAT) -{ BIF_SYMB(thebif) = name.thesymb; } - -// name of subroutine being called -inline SgSymbol * SgCallStmt::name() -{ return SymbMapping(BIF_SYMB(thebif)); } - -// the number of arguement expressions -inline int SgCallStmt::numberOfArgs() -{ return exprListLength(BIF_LL1(thebif)); } - -inline void SgCallStmt::addArg(SgExpression &arg) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } - -// the i-th argument expression -inline SgExpression * SgCallStmt::arg(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } - -inline SgCallStmt::~SgCallStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgProsCallStmt--inlines - -inline SgProsCallStmt::SgProsCallStmt(SgSymbol &name, SgExprListExp &args):SgExecutableStatement(PROS_STAT) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL1(thebif) = args.thellnd; -} - -inline SgProsCallStmt::SgProsCallStmt(SgSymbol &name):SgExecutableStatement(PROS_STAT) -{ BIF_SYMB(thebif) = name.thesymb; } - -// name of process being called -inline SgSymbol * SgProsCallStmt::name() -{ return SymbMapping(BIF_SYMB(thebif)); } - -// the number of arguement expressions -inline int SgProsCallStmt::numberOfArgs() -{ return exprListLength(BIF_LL1(thebif)); } - -inline void SgProsCallStmt::addArg(SgExpression &arg) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } - -inline SgExprListExp *SgProsCallStmt::args() -{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } - -// the i-th argument expression -inline SgExpression * SgProsCallStmt::arg(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } - -inline SgProsCallStmt::~SgProsCallStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgProsCallLctn--inlines - -inline SgProsCallLctn::SgProsCallLctn(SgSymbol &name, SgExprListExp &args, - SgExprListExp &lctn) - :SgExecutableStatement(PROS_STAT_LCTN) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL1(thebif) = args.thellnd; - BIF_LL2(thebif) = lctn.thellnd; -} - -inline SgProsCallLctn::SgProsCallLctn(SgSymbol &name, SgExprListExp &lctn) - :SgExecutableStatement(PROS_STAT_LCTN) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL2(thebif) = lctn.thellnd; -} - -// name of process being called -inline SgSymbol * SgProsCallLctn::name() -{ return SymbMapping(BIF_SYMB(thebif)); } - -// the number of arguement expressions -inline int SgProsCallLctn::numberOfArgs() -{ return exprListLength(BIF_LL1(thebif)); } - -inline void SgProsCallLctn::addArg(SgExpression &arg) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } - -inline SgExprListExp *SgProsCallLctn::args() -{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } - -// the i-th argument expression -inline SgExpression * SgProsCallLctn::arg(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } - -inline SgExpression * SgProsCallLctn::location() -{ return LlndMapping(BIF_LL2(thebif)); } - -inline SgProsCallLctn::~SgProsCallLctn() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgProsCallSubm--inlines - -inline SgProsCallSubm::SgProsCallSubm(SgSymbol &name, SgExprListExp &args, - SgExprListExp &subm) - :SgExecutableStatement(PROS_STAT_SUBM) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL1(thebif) = args.thellnd; - BIF_LL2(thebif) = subm.thellnd; -} - -inline SgProsCallSubm::SgProsCallSubm(SgSymbol &name, SgExprListExp &subm) - :SgExecutableStatement(PROS_STAT_SUBM) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL2(thebif) = subm.thellnd; -} - -// name of process being called -inline SgSymbol * SgProsCallSubm::name() -{ return SymbMapping(BIF_SYMB(thebif)); } - -// the number of arguement expressions -inline int SgProsCallSubm::numberOfArgs() -{ return exprListLength(BIF_LL1(thebif)); } - -inline void SgProsCallSubm::addArg(SgExpression &arg) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } - -inline SgExprListExp *SgProsCallSubm::args() -{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } - -// the i-th argument expression -inline SgExpression * SgProsCallSubm::arg(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } - -inline SgExpression * SgProsCallSubm::submachine() -{ return LlndMapping(BIF_LL2(thebif)); } - -inline SgProsCallSubm::~SgProsCallSubm() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgProcessesStmt--inlines - -inline SgProcessesStmt::SgProcessesStmt():SgStatement(PROCESSES_STAT) -{} - -inline SgProcessesStmt::~SgProcessesStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgEndProcessesStmt--inlines - -inline SgEndProcessesStmt::SgEndProcessesStmt():SgStatement(PROCESSES_END) -{} - -inline SgEndProcessesStmt::~SgEndProcessesStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgInportStmt--inlines - -inline SgInportStmt::SgInportStmt(SgExprListExp &name):SgStatement(INPORT_DECL) -{ BIF_LL1(thebif) = name.thellnd; } - -inline SgInportStmt::SgInportStmt(SgExprListExp &name, SgPortTypeExp &porttype) - :SgStatement(INPORT_DECL) -{ - BIF_LL1(thebif) = name.thellnd; - BIF_LL2(thebif) = porttype.thellnd; -} - -inline SgInportStmt::~SgInportStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline void SgInportStmt::addname(SgExpression &name) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), name.thellnd); } - -inline int SgInportStmt::numberOfNames() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgExprListExp * SgInportStmt::names() -{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } - -inline SgExpression *SgInportStmt::name(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } - -inline void SgInportStmt::addporttype(SgExpression &porttype) -{ BIF_LL2(thebif) = addToList(BIF_LL2(thebif), porttype.thellnd); } - -inline int SgInportStmt::numberOfPortTypes() -{ return exprListLength(BIF_LL2(thebif)); } - -inline SgPortTypeExp * SgInportStmt::porttypes() -{ return (SgPortTypeExp *) LlndMapping(BIF_LL2(thebif)); } - -inline SgPortTypeExp * SgInportStmt::porttype(int i) -{ return (SgPortTypeExp *) LlndMapping(getPositionInList(BIF_LL2(thebif),i)); } - - - -// SgOutportStmt--inlines - -inline SgOutportStmt::SgOutportStmt(SgExprListExp &name) - :SgStatement(OUTPORT_DECL) -{ BIF_LL1(thebif) = name.thellnd; } - -inline SgOutportStmt::SgOutportStmt(SgExprListExp &name, - SgPortTypeExp &porttype) - :SgStatement(OUTPORT_DECL) -{ - BIF_LL1(thebif) = name.thellnd; - BIF_LL2(thebif) = porttype.thellnd; -} - -inline SgOutportStmt::~SgOutportStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline void SgOutportStmt::addname(SgExpression &name) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), name.thellnd); } - -inline int SgOutportStmt::numberOfNames() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgExprListExp * SgOutportStmt::names() -{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } - -inline SgExpression *SgOutportStmt::name(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } - -inline void SgOutportStmt::addporttype(SgExpression &porttype) -{ BIF_LL2(thebif) = addToList(BIF_LL2(thebif), porttype.thellnd); } - -inline int SgOutportStmt::numberOfPortTypes() -{ return exprListLength(BIF_LL2(thebif)); } - -inline SgPortTypeExp * SgOutportStmt::porttypes() -{ return (SgPortTypeExp *) LlndMapping(BIF_LL2(thebif)); } - -inline SgPortTypeExp * SgOutportStmt::porttype(int i) -{ return (SgPortTypeExp *) LlndMapping(getPositionInList(BIF_LL2(thebif),i)); } - - - -// SgChannelStmt--inlines - -inline SgChannelStmt::SgChannelStmt(SgExpression &outport, SgExpression &inport) - :SgStatement(CHANNEL_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); -} - - -inline SgChannelStmt::SgChannelStmt(SgExpression &outport, SgExpression &inport, - SgExpression &io_or_err) - :SgStatement(CHANNEL_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); -} - - -inline SgChannelStmt::SgChannelStmt(SgExpression &outport, SgExpression &inport, - SgExpression &iostore, SgExpression &errlabel) - :SgStatement(CHANNEL_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); -} - - -inline SgChannelStmt::~SgChannelStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline SgExpression * SgChannelStmt::outport() -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),0)); } - - -inline SgExpression * SgChannelStmt::inport() -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),1)); } - - -inline SgExpression * SgChannelStmt::ioStore() -{ - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),2); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) // must be ERR_LABEL - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgChannelStmt::errLabel() -{ - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),2); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - - -// SgMergerStmt--inlines - -inline SgMergerStmt::SgMergerStmt(SgExpression &outport, SgExpression &inport): - SgStatement(MERGER_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); -} - - -inline SgMergerStmt::SgMergerStmt(SgExpression &outport, SgExpression &inport, - SgExpression &io_or_err) - :SgStatement(MERGER_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); -} - - -inline SgMergerStmt::SgMergerStmt(SgExpression &outport, SgExpression &inport, - SgExpression &iostore, SgExpression &errlabel): - SgStatement(MERGER_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); -} - - -inline SgMergerStmt::~SgMergerStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline void SgMergerStmt::addOutport(SgExpression &outport) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), outport.thellnd); } - - -inline void SgMergerStmt::addIoStore(SgExpression &iostore) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } - - -inline void SgMergerStmt::addErrLabel(SgExpression &errlabel) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } - - -inline int SgMergerStmt::numberOfOutports() -{ - PTR_LLND ll = BIF_LL1(thebif); - int n = 0; - - while (ll && (n != 3)) { - if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL ) || - ( NODE_CODE(ll) == INPORT_NAME )) - n = n + 1; - ll = NODE_OPERAND1(ll); - }; - return (exprListLength(BIF_LL1(thebif)) - n); - // double scanning the list may be improved -} - - -inline SgExpression * SgMergerStmt::outport(int i) -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } - - -inline SgExpression * SgMergerStmt::inport() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) { - return (SgExpression *) NULL; - } else - return LlndMapping(ll); -} - - -inline SgExpression * SgMergerStmt::ioStore() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n+1); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) //must be ERR_LABEL - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgMergerStmt::errLabel() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n+1); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // imust be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } - else - return LlndMapping(ll); -} - - - -// SgMoveportStmt--inlines - -inline SgMoveportStmt::SgMoveportStmt(SgExpression &fromport, - SgExpression &toport) - :SgStatement(MOVE_PORT) -{ - BIF_LL1(thebif) = fromport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), toport.thellnd); -} - - -inline SgMoveportStmt::SgMoveportStmt(SgExpression &fromport, - SgExpression &toport, - SgExpression &io_or_err) - :SgStatement(MOVE_PORT) -{ - BIF_LL1(thebif) = fromport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), toport.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); -} - - -inline SgMoveportStmt::SgMoveportStmt(SgExpression &fromport, - SgExpression &toport, - SgExpression &iostore, - SgExpression &errlabel) - :SgStatement(MOVE_PORT) -{ - BIF_LL1(thebif) = fromport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), toport.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); -} - - -inline SgMoveportStmt::~SgMoveportStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline SgExpression * SgMoveportStmt::fromport() -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),0)); } - - -inline SgExpression * SgMoveportStmt::toport() -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),1)); } - - -inline SgExpression * SgMoveportStmt::ioStore() -{ - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),2); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) // must be ERR_LABEL - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgMoveportStmt::errLabel() -{ - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),2); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - - -// SgSendStmt--inlines - -inline SgSendStmt::SgSendStmt(SgExpression &control, SgExprListExp &argument): - SgStatement(SEND_STAT) -{ - BIF_LL1(thebif) = control.thellnd; - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgSendStmt::SgSendStmt(SgExpression &outport, SgExprListExp &argument, - SgExpression &io_or_err): SgStatement(SEND_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgSendStmt::SgSendStmt(SgExpression &outport, SgExprListExp &argument, - SgExpression &iostore, SgExpression &errlabel): - SgStatement(SEND_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgSendStmt::~SgSendStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline void SgSendStmt::addOutport(SgExpression &outport) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), outport.thellnd); } - - -inline void SgSendStmt::addIoStore(SgExpression &iostore) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } - - -inline void SgSendStmt::addErrLabel(SgExpression &errlabel) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } - - -inline void SgSendStmt::addArgument(SgExpression &argument) -{ BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif), argument.thellnd); } - - -inline int SgSendStmt::numberOfOutports() -{ - PTR_LLND ll = BIF_LL1(thebif); - int n = 0; - - while (ll && (n != 2)) { - if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL )) - n = n + 1; - ll = NODE_OPERAND1(ll); - }; - return (exprListLength(BIF_LL1(thebif)) - n); - // double scanning the list may be improved -} - - -inline int SgSendStmt::numberOfArguments() -{ return exprListLength(BIF_LL2(thebif)); } - - -inline SgExpression * SgSendStmt::controls() -{ return LlndMapping(BIF_LL1(thebif)); } - - -inline SgExpression * SgSendStmt::outport(int i) -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } - - -inline SgExprListExp * SgSendStmt::arguments() -{ return (SgExprListExp *) LlndMapping(BIF_LL2(thebif)); } - - -inline SgExpression * SgSendStmt::argument(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL2(thebif),i)); } - - -inline SgExpression * SgSendStmt::ioStore() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgSendStmt::errLabel() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - - -// SgReceiveStmt--inlines - -inline SgReceiveStmt::SgReceiveStmt(SgExpression &control, - SgExprListExp &argument) - :SgStatement(RECEIVE_STAT) -{ - BIF_LL1(thebif) = control.thellnd; - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgReceiveStmt::SgReceiveStmt(SgExpression &inport, - SgExprListExp &argument, - SgExpression &e1):SgStatement(RECEIVE_STAT) -{ - BIF_LL1(thebif) = inport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgReceiveStmt::SgReceiveStmt(SgExpression &inport, - SgExprListExp &argument, - SgExpression &e1, - SgExpression &e2):SgStatement(RECEIVE_STAT) -{ - BIF_LL1(thebif) = inport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgReceiveStmt::SgReceiveStmt(SgExpression &inport, - SgExprListExp &argument, - SgExpression &e1, - SgExpression &e2, - SgExpression &e3):SgStatement(RECEIVE_STAT) -{ - BIF_LL1(thebif) = inport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e3.thellnd); - BIF_LL2(thebif) = argument.thellnd; -} - - -inline SgReceiveStmt::~SgReceiveStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline void SgReceiveStmt::addInport(SgExpression &inport) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); } - - -inline void SgReceiveStmt::addIoStore(SgExpression &iostore) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } - - -inline void SgReceiveStmt::addErrLabel(SgExpression &errlabel) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } - - -inline void SgReceiveStmt::addEndLabel(SgExpression &endlabel) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), endlabel.thellnd); } - - -inline void SgReceiveStmt::addArgument(SgExpression &argument) -{ BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif), argument.thellnd); } - - -inline int SgReceiveStmt::numberOfInports() -{ - PTR_LLND ll = BIF_LL1(thebif); - int n = 0; - - while (ll && (n != 3)) { - if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL ) || - ( NODE_CODE(ll) == END_LABEL )) - n = n + 1; - ll = NODE_OPERAND1(ll); - }; - return (exprListLength(BIF_LL1(thebif)) - n); - // double scanning the list may be improved -} - - -inline int SgReceiveStmt::numberOfArguments() -{ return exprListLength(BIF_LL2(thebif)); } - - -inline SgExpression * SgReceiveStmt::controls() -{ return LlndMapping(BIF_LL1(thebif)); } - - -inline SgExpression * SgReceiveStmt::inport(int i) -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } - - -inline SgExprListExp * SgReceiveStmt::arguments() -{ return (SgExprListExp *) LlndMapping(BIF_LL2(thebif)); } - - -inline SgExpression * SgReceiveStmt::argument(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL2(thebif),i)); } - - -inline SgExpression * SgReceiveStmt::ioStore() -{ - int n = numberOfInports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgReceiveStmt::errLabel() -{ - int n = numberOfInports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - -inline SgExpression * SgReceiveStmt::endLabel() -{ - int n = numberOfInports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != END_LABEL) { // must be IOSTAT_STORE or ERR_LABEL - ll = NODE_OPERAND1(ll); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != END_LABEL) { // must be ERR_LABEL - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != END_LABEL)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - -// SgEndchannelStmt--inlines - -inline SgEndchannelStmt::SgEndchannelStmt(SgExpression &outport) - :SgStatement(ENDCHANNEL_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; -} - - -inline SgEndchannelStmt::SgEndchannelStmt(SgExpression &outport, - SgExpression &io_or_err) - :SgStatement(ENDCHANNEL_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); -} - - -inline SgEndchannelStmt::SgEndchannelStmt(SgExpression &outport, - SgExpression &iostore, - SgExpression &errlabel) - :SgStatement(ENDCHANNEL_STAT) -{ - BIF_LL1(thebif) = outport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); -} - - -inline SgEndchannelStmt::~SgEndchannelStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline void SgEndchannelStmt::addOutport(SgExpression &outport) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), outport.thellnd); } - - -inline void SgEndchannelStmt::addIoStore(SgExpression &iostore) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } - - -inline void SgEndchannelStmt::addErrLabel(SgExpression &errlabel) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } - - -inline int SgEndchannelStmt::numberOfOutports() -{ - PTR_LLND ll = BIF_LL1(thebif); - int n = 0; - - while (ll && (n != 2)) { - if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL )) - n = n + 1; - ll = NODE_OPERAND1(ll); - }; - return (exprListLength(BIF_LL1(thebif)) - n); - // double scanning the list may be improved -} - - -inline SgExpression * SgEndchannelStmt::controls() -{ return LlndMapping(BIF_LL1(thebif)); } - - -inline SgExpression * SgEndchannelStmt::outport(int i) -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } - - -inline SgExpression * SgEndchannelStmt::ioStore() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgEndchannelStmt::errLabel() -{ - int n = numberOfOutports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - - -// SgProbeStmt--inlines - -inline SgProbeStmt::SgProbeStmt(SgExpression &inport):SgStatement(PROBE_STAT) -{ BIF_LL1(thebif) = inport.thellnd; } - - -inline SgProbeStmt::SgProbeStmt(SgExpression &inport, SgExpression &e1) - :SgStatement(PROBE_STAT) -{ - BIF_LL1(thebif) = inport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); -} - - -inline SgProbeStmt::SgProbeStmt(SgExpression &inport, SgExpression &e1, - SgExpression &e2):SgStatement(PROBE_STAT) -{ - BIF_LL1(thebif) = inport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); -} - - -inline SgProbeStmt::SgProbeStmt(SgExpression &inport, SgExpression &e1, - SgExpression &e2, SgExpression &e3) - :SgStatement(PROBE_STAT) -{ - BIF_LL1(thebif) = inport.thellnd; - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e3.thellnd); -} - - -inline SgProbeStmt::~SgProbeStmt() -{ RemoveFromTableBfnd((void *) this); } - - -inline void SgProbeStmt::addInport(SgExpression &inport) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); } - - -inline void SgProbeStmt::addIoStore(SgExpression &iostore) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } - - -inline void SgProbeStmt::addErrLabel(SgExpression &errlabel) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } - - -inline void SgProbeStmt::addEmptyStore(SgExpression &emptystore) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), emptystore.thellnd); } - - -inline int SgProbeStmt::numberOfInports() -{ - PTR_LLND ll = BIF_LL1(thebif); - int n = 0; - - while (ll && (n != 3)) { - if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL ) || - ( NODE_CODE(ll) == EMPTY_STORE )) - n = n + 1; - ll = NODE_OPERAND1(ll); - }; - return (exprListLength(BIF_LL1(thebif)) - n); - // double scanning the list may be improved -} - - -inline SgExpression * SgProbeStmt::controls() -{ return LlndMapping(BIF_LL1(thebif)); } - - -inline SgExpression * SgProbeStmt::inport(int i) -{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } - - -inline SgExpression * SgProbeStmt::ioStore() -{ - int n = numberOfInports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != IOSTAT_STORE) - return (SgExpression *) NULL; - else - return LlndMapping(ll); -} - - -inline SgExpression * SgProbeStmt::errLabel() -{ - int n = numberOfInports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) // must be EMPTY_STORE - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - -inline SgExpression * SgProbeStmt::emptyStore() -{ - int n = numberOfInports(); - PTR_LLND ll; - - ll = getPositionInList(BIF_LL1(thebif),n); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != EMPTY_STORE) { // must be IOSTAT_STORE or ERR_LABEL - ll = NODE_OPERAND1(ll); - if (!ll) - return (SgExpression *) NULL; - else - if (NODE_CODE(ll) != EMPTY_STORE) { // must be ERR_LABEL - ll = NODE_OPERAND1(ll); - if ((!ll) || (NODE_CODE(ll) != EMPTY_STORE)) - return (SgExpression *) NULL; - else - return LlndMapping(ll); - } else - return LlndMapping(ll); - } else - return LlndMapping(ll); -} - - - -// SgPortTypeExp--inlines - -inline SgPortTypeExp::SgPortTypeExp(SgType &type):SgExpression(PORT_TYPE_OP) -{ NODE_TYPE(thellnd) = type.thetype; } - - -inline SgPortTypeExp::SgPortTypeExp(SgType &type, SgExpression &ref) - :SgExpression(PORT_TYPE_OP) -{ - NODE_TYPE(thellnd) = type.thetype; - NODE_OPERAND0(thellnd) = ref.thellnd; -} - - -inline SgPortTypeExp::SgPortTypeExp(int variant, SgExpression &porttype) - :SgExpression(variant) -{ NODE_OPERAND0(thellnd) = porttype.thellnd; } - - -inline SgPortTypeExp::~SgPortTypeExp() -{ RemoveFromTableLlnd((void *) this); } - - -inline SgType * SgPortTypeExp::type() -{ return TypeMapping(NODE_TYPE(thellnd)); } - -inline int SgPortTypeExp::numberOfRef() -{ - PTR_LLND ll = NODE_OPERAND0(thellnd); - int n = 0; - while (ll) { - n = n + 1; - ll = NODE_OPERAND1(ll); - }; - return n; -} - -inline SgExpression * SgPortTypeExp::ref() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgPortTypeExp * SgPortTypeExp::next() -{ return (SgPortTypeExp *) LlndMapping(NODE_OPERAND1(thellnd)); } - - -// SgControlExp--inlines - -inline SgControlExp::SgControlExp(int variant):SgExpression(variant) -{} - -inline SgControlExp::~SgControlExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgExpression * SgControlExp::exp() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - - - -// SgInportExp--inlines - -inline SgInportExp::SgInportExp(SgExprListExp &exp):SgControlExp(INPORT_NAME) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgInportExp::~SgInportExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgOutportExp--inlines - -inline SgOutportExp::SgOutportExp(SgExprListExp &exp):SgControlExp(OUTPORT_NAME) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgOutportExp::~SgOutportExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgFromportExp--inlines - -inline SgFromportExp::SgFromportExp(SgExprListExp &exp) - :SgControlExp(FROMPORT_NAME) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgFromportExp::~SgFromportExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgToportExp--inlines - -inline SgToportExp::SgToportExp(SgExprListExp &exp):SgControlExp(TOPORT_NAME) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgToportExp::~SgToportExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgIO_statStoreExp--inlines - -inline SgIO_statStoreExp::SgIO_statStoreExp(SgExprListExp &exp) - :SgControlExp(IOSTAT_STORE) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgIO_statStoreExp::~SgIO_statStoreExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgEmptyStoreExp--inlines - -inline SgEmptyStoreExp::SgEmptyStoreExp(SgExprListExp &exp) - :SgControlExp(EMPTY_STORE) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgEmptyStoreExp::~SgEmptyStoreExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgErrLabelExp--inlines - -inline SgErrLabelExp::SgErrLabelExp(SgExprListExp &exp):SgControlExp(ERR_LABEL) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgErrLabelExp::~SgErrLabelExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgEndLabelExp--inlines - -inline SgEndLabelExp::SgEndLabelExp(SgExprListExp &exp):SgControlExp(END_LABEL) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgEndLabelExp::~SgEndLabelExp() -{ RemoveFromTableLlnd((void *) this); } - - - -// SgDataImpliedDoExp--inlines - -inline SgDataImpliedDoExp::SgDataImpliedDoExp(SgExprListExp &dlist, - SgSymbol &iname, - SgExprListExp &ilist) - :SgExpression(DATA_IMPL_DO) -{ - NODE_OPERAND0(thellnd) = dlist.thellnd; - NODE_SYMB(thellnd) = iname.thesymb; - NODE_OPERAND1(thellnd) = ilist.thellnd; -} - -inline SgDataImpliedDoExp::~SgDataImpliedDoExp() -{ RemoveFromTableLlnd((void *) this); } - -inline void SgDataImpliedDoExp::addDataelt(SgExpression &data) -{ NODE_OPERAND0(thellnd) = addToList(NODE_OPERAND0(thellnd),data.thellnd); } - -inline void SgDataImpliedDoExp::addIconexpr(SgExpression &icon) -{ NODE_OPERAND1(thellnd) = addToList(NODE_OPERAND1(thellnd),icon.thellnd); } - -inline SgSymbol *SgDataImpliedDoExp::iname() -{ return SymbMapping(NODE_SYMB(thellnd)); } - -inline int SgDataImpliedDoExp::numberOfDataelt() -{ return exprListLength(NODE_OPERAND0(thellnd)); } - -inline SgExprListExp *SgDataImpliedDoExp::dataelts() -{ return (SgExprListExp *) LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression *SgDataImpliedDoExp::dataelt(int i) -{ return LlndMapping(getPositionInList(NODE_OPERAND0(thellnd),i)); } - -inline SgExprListExp *SgDataImpliedDoExp::iconexprs() -{ return (SgExprListExp *) LlndMapping(NODE_OPERAND1(thellnd)); } - -inline SgExpression *SgDataImpliedDoExp::init() -{ return LlndMapping(getPositionInList(NODE_OPERAND1(thellnd),0)); } - -inline SgExpression *SgDataImpliedDoExp::limit() -{ return LlndMapping(getPositionInList(NODE_OPERAND1(thellnd),1)); } - -inline SgExpression *SgDataImpliedDoExp::increment() -{ return LlndMapping(getPositionInList(NODE_OPERAND1(thellnd),2)); } - - - -// SgDataEltExp--inlines - -inline SgDataEltExp::SgDataEltExp(SgExpression &dataimplieddo) - :SgExpression(DATA_ELT) -{ NODE_OPERAND0(thellnd) = dataimplieddo.thellnd; } - -inline SgDataEltExp::SgDataEltExp(SgSymbol &name, SgExpression &datasubs, - SgExpression &datarange) - :SgExpression(DATA_ELT) -{ - NODE_SYMB(thellnd) = name.thesymb; - NODE_OPERAND1(datasubs.thellnd) = datarange.thellnd; - NODE_OPERAND0(thellnd) = datasubs.thellnd; -} - -inline SgDataEltExp::~SgDataEltExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgSymbol *SgDataEltExp::name() -{ return SymbMapping(NODE_SYMB(thellnd)); } - -inline SgExpression *SgDataEltExp::dataimplieddo() -{ - if (NODE_SYMB(thellnd) == NULL) - return LlndMapping(NODE_OPERAND0(thellnd)); - else - return NULL; -} - -inline SgExpression *SgDataEltExp::datasubs() -{ - if (NODE_SYMB(thellnd) != NULL) - if (NODE_CODE(NODE_OPERAND0(thellnd)) == DATA_SUBS) - return LlndMapping(NODE_OPERAND0(thellnd)); - else - return (SgExpression *) NULL; - else - return (SgExpression *) NULL; -} - -inline SgExpression *SgDataEltExp::datarange() -{ - if (NODE_SYMB(thellnd) != NULL) - if (NODE_CODE(NODE_OPERAND0(thellnd)) == DATA_RANGE) - return LlndMapping(NODE_OPERAND0(thellnd)); - else - if (NODE_OPERAND1(NODE_OPERAND0(thellnd)) != NULL) - return LlndMapping(NODE_OPERAND1(NODE_OPERAND0(thellnd))); - else - return (SgExpression *) NULL; - else - return (SgExpression *) NULL; -} - - - -// SgDataSubsExp--inlines - -inline SgDataSubsExp::SgDataSubsExp(SgExprListExp &iconexprlist) - :SgExpression(DATA_SUBS) -{ NODE_OPERAND0(thellnd) = iconexprlist.thellnd; } - -inline SgDataSubsExp::~SgDataSubsExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgExprListExp *SgDataSubsExp::iconexprlist() -{ return (SgExprListExp *) LlndMapping(NODE_OPERAND0(thellnd)); } - - - -// SgDataRangeExp--inlines - -inline SgDataRangeExp::SgDataRangeExp(SgExpression &iconexpr1, - SgExpression &iconexpr2) - :SgExpression(DATA_RANGE) -{ - NODE_OPERAND0(thellnd) = iconexpr1.thellnd; - NODE_OPERAND1(thellnd) = iconexpr2.thellnd; -} - -inline SgDataRangeExp::~SgDataRangeExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgExpression *SgDataRangeExp::iconexpr1() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - -inline SgExpression *SgDataRangeExp::iconexpr2() -{ return LlndMapping(NODE_OPERAND1(thellnd)); } - - - -// SgIconExprExp--inlines - -inline SgIconExprExp::SgIconExprExp(SgExpression &exp):SgExpression(ICON_EXPR) -{ NODE_OPERAND0(thellnd) = exp.thellnd; } - -inline SgIconExprExp::~SgIconExprExp() -{ RemoveFromTableLlnd((void *) this); } - -inline SgExpression *SgIconExprExp::expr() -{ return LlndMapping(NODE_OPERAND0(thellnd)); } - - - -// SgIOStmt--inlines -inline SgIOStmt::SgIOStmt(int variant):SgExecutableStatement(variant) -{} - - -// SgInputOutputStmt--inlines - -inline SgInputOutputStmt::SgInputOutputStmt(int variant, SgExpression &specList, SgExpression &itemList): SgIOStmt(variant) -{ - if (variant != READ_STAT && variant != WRITE_STAT && variant != PRINT_STAT) - { - Message("illegal variant for SgInputOutputStmt", 0); -#ifdef __SPF - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); - addToGlobalBufferAndPrint(buf); - } - throw -1; -#endif - } - BIF_LL1(thebif) = itemList.thellnd; - BIF_LL2(thebif) = specList.thellnd; -} - -inline SgExpression * SgInputOutputStmt::specList() -{ return LlndMapping(BIF_LL2(thebif)); } - -inline void SgInputOutputStmt::setSpecList(SgExpression &specList) -{ BIF_LL2(thebif) = specList.thellnd; } - -inline SgExpression * SgInputOutputStmt::itemList() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline void SgInputOutputStmt::setItemList(SgExpression &itemList) -{ BIF_LL1(thebif) = itemList.thellnd; } - -inline SgInputOutputStmt::~SgInputOutputStmt() -{ RemoveFromTableBfnd((void *) this); } - - - -// SgIOControlStmt--inlines - -inline SgExpression * SgIOControlStmt::controlSpecList() -{ return LlndMapping(BIF_LL2(thebif)); } - -inline void SgIOControlStmt::setControlSpecList(SgExpression &controlSpecList) -{ BIF_LL2(thebif) = controlSpecList.thellnd; } - -inline SgIOControlStmt::~SgIOControlStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgDeclarationStatement--inlines -inline SgDeclarationStatement::SgDeclarationStatement(int variant):SgStatement(variant) -{} - -inline SgDeclarationStatement::~SgDeclarationStatement() -{ RemoveFromTableBfnd((void *) this); } - -inline SgExpression * SgDeclarationStatement::varList() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline int SgDeclarationStatement::numberOfVars() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgExpression * SgDeclarationStatement::var(int i) -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } - -inline void SgDeclarationStatement::deleteVar(int i) -{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); } - -inline void SgDeclarationStatement::deleteTheVar(SgExpression &var) -{ - BIF_LL1(thebif) = deleteNodeWithItemInExprList(BIF_LL1(thebif),var.thellnd); -} - -inline void SgDeclarationStatement::addVar(SgExpression &exp) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), exp.thellnd); } - - - -// SgVarDeclStmt--inlines - -inline SgVarDeclStmt::SgVarDeclStmt(SgExpression &varRefValList, SgExpression &attributeList, SgType &type):SgDeclarationStatement(VAR_DECL) -{ - if ( CurrentProject->Fortranlanguage() ) - { - BIF_LL1(thebif) = varRefValList.thellnd; - BIF_LL2(thebif) = (PTR_LLND) newNode(TYPE_OP); - NODE_TYPE(BIF_LL2(thebif)) = type.thetype; - BIF_LL3(thebif) = attributeList.thellnd; - } - else /* C or C++ */ - { - BIF_LL1(thebif) = varRefValList.thellnd; - NODE_TYPE(BIF_LL1(thebif)) = type.thetype; - } -} - -inline SgVarDeclStmt::SgVarDeclStmt(SgExpression &varRefValList, SgType &type):SgDeclarationStatement(VAR_DECL) -{ - if ( CurrentProject->Fortranlanguage ()) - { - BIF_LL1(thebif) = varRefValList.thellnd; - BIF_LL2(thebif) = newExpr(TYPE_OP,type.thetype); - BIF_LL3(thebif) = LLNULL; - } - else /* C or C++ */ - { - BIF_LL1(thebif) = varRefValList.thellnd; - NODE_TYPE(BIF_LL1(thebif)) = type.thetype; - } -} - -inline SgVarDeclStmt::SgVarDeclStmt(SgExpression &varRefValList) - :SgDeclarationStatement(VAR_DECL) -{ - if ( CurrentProject->Fortranlanguage ()) - { - BIF_LL1(thebif) = varRefValList.thellnd; - BIF_LL2(thebif) = LLNULL; - BIF_LL3(thebif) = LLNULL; - } - else /* C or C++ */ - { - BIF_LL1(thebif) = varRefValList.thellnd; - NODE_TYPE(BIF_LL1(thebif)) = TYNULL; - } -} - -inline SgVarDeclStmt::~SgVarDeclStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgType * SgVarDeclStmt::type() // the type -{ - SgType *x; - - if ( CurrentProject->Fortranlanguage() ) - { - if (BIF_LL2(thebif)) - x = TypeMapping(NODE_TYPE(BIF_LL2(thebif))); - else - x = NULL; - } - else /* C or C++ */ - { - if (BIF_LL1(thebif)) - x = TypeMapping(NODE_TYPE(BIF_LL1(thebif))); - else - x = NULL; - } - return x; -} - - -// the number of F90 attributes -inline int SgVarDeclStmt::numberOfAttributes() -{ return exprListLength(BIF_LL3(thebif)); } - -// the number of variables declared -inline int SgVarDeclStmt::numberOfSymbols() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgSymbol * SgVarDeclStmt::symbol(int i) -{ - PTR_LLND pt; - PTR_SYMB symb = NULL; - SgSymbol *x; - - pt = getPositionInExprList(BIF_LL1(thebif),i); - if (pt) - pt = giveLlSymbInDeclList(pt); - if (pt && (symb= NODE_SYMB(pt))) - { - x = SymbMapping(symb); - } - else - x = NULL; - - return x; -} - -inline void SgVarDeclStmt::deleteSymbol(int i) -{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif),i); } - -#ifdef NOT_YET_IMPLEMENTED -inline void SgVarDeclStmt::deleteTheSymbol(SgSymbol &symbol) -{ SORRY; } -#endif - -// the initial value ofthe i-th variable -inline SgExpression * SgVarDeclStmt::initialValue(int i) -{ - PTR_LLND varRefExp; - SgExpression *x; - - varRefExp = getPositionInExprList(BIF_LL1(thebif),i); - if (varRefExp == LLNULL) - x = NULL; - else if (NODE_CODE(varRefExp) == ASSGN_OP) - x = LlndMapping(NODE_OPERAND1(varRefExp)); - else - x = NULL; - - return x; -} - - -// SgIntentStmt--inlines - -inline SgIntentStmt::SgIntentStmt(SgExpression &varRefValList, - SgExpression &attribute) - :SgDeclarationStatement(INTENT_STMT) -{ - BIF_LL1(thebif) = varRefValList.thellnd; - BIF_LL2(thebif) = attribute.thellnd; -} - -inline SgIntentStmt::~SgIntentStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline int SgIntentStmt::numberOfArgs() // the number of arguement expressions -{ return exprListLength(BIF_LL1(thebif)); } - -inline void SgIntentStmt::addArg(SgExpression &arg) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } - -inline SgExpression * SgIntentStmt::args() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline SgExpression * SgIntentStmt::arg(int i) // the i-th argument expression -{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } - -inline SgExpression * SgIntentStmt::attribute() -{ return LlndMapping(BIF_LL2(thebif)); } - - -// SgVarListDeclStmt--inlines - -inline SgVarListDeclStmt::~SgVarListDeclStmt() -{ RemoveFromTableBfnd((void *) this); } - -// the number of variables declared -inline int SgVarListDeclStmt::numberOfSymbols() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgSymbol * SgVarListDeclStmt::symbol(int i) // the i-th variable -{ - PTR_LLND pt; - SgSymbol *x; - pt = getPositionInExprList(BIF_LL1(thebif),i); - if (pt) - x = SymbMapping(NODE_SYMB(pt)); - else - x = NULL; - - return x; -} - -inline void SgVarListDeclStmt::appendSymbol(SgSymbol &symbol) -{ - BIF_LL1(thebif) = addSymbRefToExprList(BIF_LL1(thebif), symbol.thesymb); -} - -inline void SgVarListDeclStmt::deleteSymbol(int i) -{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); } - -#ifdef NOT_YET_IMPLEMENTED -inline void SgVarListDeclStmt::deleteTheSymbol(SgSymbol &symbol) -{ SORRY; } -#endif - - -// SgStructureDeclStmt--inlines - -inline SgStructureDeclStmt::SgStructureDeclStmt(SgSymbol &name, SgExpression &attributes, SgStatement &body):SgDeclarationStatement(STRUCT_DECL) -{ - BIF_SYMB(thebif) = name.thesymb; - BIF_LL1(thebif) = attributes.thellnd; - insertBfndListIn(body.thebif,thebif,thebif); -} - -inline SgStructureDeclStmt::~SgStructureDeclStmt() -{ RemoveFromTableBfnd((void *) this); } - - -// SgNestedVarListDeclStmt--inlines - - -// varList must be of low-level variant appropriate to variant. For example, -// if the variant is COMM_STAT, listOfVarList must be of variant COMM_LIST. - -inline SgNestedVarListDeclStmt::~SgNestedVarListDeclStmt() -{ RemoveFromTableBfnd((void *) this); } - -inline SgExpression * SgNestedVarListDeclStmt::lists() -{ return LlndMapping(BIF_LL1(thebif)); } - -inline int SgNestedVarListDeclStmt::numberOfLists() -{ return exprListLength(BIF_LL1(thebif)); } - -inline SgExpression * SgNestedVarListDeclStmt::list(int i) -{ return LlndMapping(getPositionInExprList( BIF_LL1(thebif),i)); } - -inline void SgNestedVarListDeclStmt::addList(SgExpression &list) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), list.thellnd); } - -inline void SgNestedVarListDeclStmt::addVarToList(SgExpression &varRef) -{ - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),varRef.thellnd); -} - -inline void SgNestedVarListDeclStmt::deleteList(int i) -{ - BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); -} - -#ifdef NOT_YET_IMPLEMENTED -inline void SgNestedVarListDeclStmt::deleteTheList(SgExpression &list) -{ - // deleteNodeWithItemInExprList(BIF_LL1(thebif), list.thellnd); - SORRY; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline void SgNestedVarListDeclStmt::deleteVarInList(int i, SgExpression &varRef) -{ - SORRY; -} -#endif - -#ifdef NOT_YET_IMPLEMENTED -inline void SgNestedVarListDeclStmt::deleteVarInTheList(SgExpression &list, SgExpression &varRef) -{ - SORRY; -} -#endif - - -// SgParameterStmt--inlines - -#ifdef NOT_YET_IMPLEMENTED -inline SgParameterStmt::SgParameterStmt(SgExpression &constants, SgExpression &values):SgDeclarationStatement(PARAM_DECL) -{ - // PTR_LLND constantWithValues; - - // constantWithValues = stringConstantsWithTheirValues(constants.thellnd, values.thellnd); - // BIF_LL1(thebif) = LlndMapping(constantWithValues); - SORRY; -} -#endif - -inline SgParameterStmt::SgParameterStmt(SgExpression &constantsWithValues):SgDeclarationStatement(PARAM_DECL) -{ BIF_LL1(thebif) = constantsWithValues.thellnd; } - -inline SgParameterStmt::~SgParameterStmt() -{ RemoveFromTableBfnd((void *) this); } - -// the number of constants declared -inline int SgParameterStmt::numberOfConstants() -{ return exprListLength(BIF_LL1(thebif)); } - -// the i-th variable -inline SgSymbol * SgParameterStmt::constant(int i) -{ return SymbMapping(NODE_SYMB(getPositionInExprList(BIF_LL1(thebif),i))); } - -// the value of i-th variable -inline SgExpression * SgParameterStmt::value(int i) -{ return LlndMapping(SYMB_VAL(NODE_SYMB(getPositionInExprList(BIF_LL1(thebif),i)))); } - -inline void SgParameterStmt::addConstant(SgSymbol *constant) -{ - SgRefExp constNode(CONST_REF, *constant); - BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), constNode.thellnd); -} - - -inline void SgParameterStmt::deleteConstant(int i) -{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); } - -#ifdef NOT_YET_IMPLEMENTED -inline void SgParameterStmt::deleteTheConstant(SgSymbol &constant) -{ - // deleteNodeWithSymbolInExprList(i, BIF_LL1(thebif)); - SORRY; -} -#endif - - -// SgImplicitStmt--inlines - -inline SgImplicitStmt::SgImplicitStmt(SgExpression &implicitLists):SgDeclarationStatement(IMPL_DECL) -{ BIF_LL1(thebif) = implicitLists.thellnd; } - -inline SgImplicitStmt::SgImplicitStmt(SgExpression *implicitLists):SgDeclarationStatement(IMPL_DECL) -{ - if (implicitLists) - BIF_LL1(thebif) = implicitLists->thellnd; -} - -inline SgImplicitStmt::~SgImplicitStmt() -{ RemoveFromTableBfnd((void *) this); } - -// the number of implicit types declared -inline int SgImplicitStmt::numberOfImplicitTypes() -{ return exprListLength(BIF_LL1(thebif)); } - -// the i-th implicit type -inline SgType * SgImplicitStmt::implicitType(int i) -{ - PTR_LLND pt; - SgType *x; - - if ( (pt = getPositionInList(BIF_LL1(thebif),i)) && - NODE_OPERAND0(pt)) - x = TypeMapping(NODE_TYPE(NODE_OPERAND0(pt))); - else - x = NULL; - - return x; -} - -// the i-th implicit type's range list eg. (A-E, G) -inline SgExpression * SgImplicitStmt::implicitRangeList(int i) -{ - PTR_LLND pt; - SgExpression *x; - - if ( (pt = getPositionInExprList(BIF_LL1(thebif),i)) && - NODE_OPERAND0(pt)) - x = LlndMapping(NODE_OPERAND0(pt)); - else - x = NULL; - - return x; -} - -inline void SgImplicitStmt::appendImplicitNode(SgExpression &impNode) -{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), impNode.thellnd); } - - - -// SgVariableSymb--inlines - - -inline SgVariableSymb::SgVariableSymb(char *identifier, SgType &t, SgStatement &scope):SgSymbol(VARIABLE_NAME,identifier) -{ - SYMB_SCOPE(thesymb) = scope.thebif; - SYMB_TYPE(thesymb) = t.thetype; -} - -inline SgVariableSymb::SgVariableSymb(char *identifier, SgType *t, SgStatement *scope):SgSymbol(VARIABLE_NAME,identifier) -{ - if (scope) - SYMB_SCOPE(thesymb) = scope->thebif; - if (t) - SYMB_TYPE(thesymb) = t->thetype; -} - -inline SgVariableSymb::SgVariableSymb(char *identifier, - SgType &t):SgSymbol(VARIABLE_NAME,identifier) -{ SYMB_TYPE(thesymb) = t.thetype; } - - -inline SgVariableSymb::SgVariableSymb(char *identifier, - SgStatement &scope):SgSymbol(VARIABLE_NAME,identifier) -{ SYMB_SCOPE(thesymb) = scope.thebif;} - - -inline SgVariableSymb::SgVariableSymb(char *identifier, - SgStatement *scope):SgSymbol(VARIABLE_NAME,identifier) -{ SYMB_SCOPE(thesymb) = scope->thebif;} - - -inline SgVariableSymb::SgVariableSymb(char *identifier): - SgSymbol(VARIABLE_NAME,identifier) -{} - -inline SgVariableSymb::SgVariableSymb(const char *identifier, SgType &t, SgStatement &scope) : SgSymbol(VARIABLE_NAME, identifier) -{ - SYMB_SCOPE(thesymb) = scope.thebif; - SYMB_TYPE(thesymb) = t.thetype; -} - -inline SgVariableSymb::SgVariableSymb(const char *identifier, SgType *t, SgStatement *scope) :SgSymbol(VARIABLE_NAME, identifier) -{ - if (scope) - SYMB_SCOPE(thesymb) = scope->thebif; - if (t) - SYMB_TYPE(thesymb) = t->thetype; -} - -inline SgVariableSymb::SgVariableSymb(const char *identifier, - SgType &t) :SgSymbol(VARIABLE_NAME, identifier) -{ - SYMB_TYPE(thesymb) = t.thetype; -} - - -inline SgVariableSymb::SgVariableSymb(const char *identifier, - SgStatement &scope) :SgSymbol(VARIABLE_NAME, identifier) -{ - SYMB_SCOPE(thesymb) = scope.thebif; -} - - -inline SgVariableSymb::SgVariableSymb(const char *identifier, - SgStatement *scope) :SgSymbol(VARIABLE_NAME, identifier) -{ - SYMB_SCOPE(thesymb) = scope->thebif; -} - - -inline SgVariableSymb::SgVariableSymb(const char *identifier) : -SgSymbol(VARIABLE_NAME, identifier) -{} - -inline SgVariableSymb::~SgVariableSymb() -{ RemoveFromTableSymb((void *) this); } - -/* ajm */ -inline SgVarRefExp *SgVariableSymb::varRef(void) -{ - return new SgVarRefExp (*this); -} - - -// SgConstantSymb--inlines - -inline SgConstantSymb::SgConstantSymb(char *identifier, SgStatement &scope, - SgExpression &value):SgSymbol(CONST_NAME,identifier, scope) -{ SYMB_VAL(thesymb) = value.thellnd; } - -inline SgConstantSymb::SgConstantSymb(const char *identifier, SgStatement &scope, - SgExpression &value):SgSymbol(CONST_NAME,identifier, scope) -{ SYMB_VAL(thesymb) = value.thellnd; } - -inline SgConstantSymb::~SgConstantSymb() -{ RemoveFromTableSymb((void *) this); } - -inline SgExpression * SgConstantSymb::constantValue() -{ return LlndMapping(SYMB_VAL(thesymb)); } - - -// SgFunctionSymb--inlines - -inline SgFunctionSymb::~SgFunctionSymb() -{ RemoveFromTableSymb((void *) this); } - -inline void SgFunctionSymb::addParameter(int, SgSymbol ¶meters) -{ - SgSymbol *copy_symb = &(parameters.copy()); - SYMB_NEXT_DECL(copy_symb->thesymb) = 0; - appendSymbToArgList (thesymb,copy_symb->thesymb); -} - -inline void SgFunctionSymb::insertParameter(int position, SgSymbol &symb) -{ insertSymbInArgList (this->thesymb, position, symb.thesymb); } - -inline int SgFunctionSymb::numberOfParameters() -{ return lenghtOfParamList(thesymb); } - -inline SgSymbol * SgFunctionSymb::parameter(int i) -{ return SymbMapping(GetThParam(thesymb,i)); } - -inline SgSymbol * SgFunctionSymb::result() -{ return SymbMapping(SYMB_DECLARED_NAME(thesymb)); } - -inline void SgFunctionSymb::setResult(SgSymbol &symbol) -{ SYMB_DECLARED_NAME(thesymb) = symbol.thesymb; } - - -// SgMemberFuncSymb--inlines -// status = MEMB_; -inline SgMemberFuncSymb::SgMemberFuncSymb(char *identifier, SgType &t, - SgStatement &cla, int status): - SgFunctionSymb(MEMBER_FUNC, identifier, t, cla) -{ - SYMB_ATTR(thesymb) = status; - SYMB_MEMBER_BASENAME(thesymb) = BIF_SYMB(cla.thebif); -} - -inline SgMemberFuncSymb::~SgMemberFuncSymb() -{ RemoveFromTableSymb((void *) this); } - -inline int SgMemberFuncSymb::isMethodOfElement() -{ - int x; - if ((int) SYMB_ATTR(thesymb) & (int) ELEMENT_FIELD) - x = TRUE; - else - x = FALSE; - - return x; -} - -// name of containing class; -inline SgSymbol * SgMemberFuncSymb::className() -{ - return SymbMapping(SYMB_MEMBER_BASENAME(thesymb)); -} - -// name of containing class -inline void SgMemberFuncSymb::setClassName(SgSymbol &symb) -{ - SYMB_MEMBER_BASENAME(thesymb) = symb.thesymb; -} - - -// SgFieldSymb--inlines - -inline SgFieldSymb::SgFieldSymb(char *identifier, SgType &t, - SgSymbol &structureName):SgSymbol(FIELD_NAME,identifier) -{ - SYMB_TYPE(thesymb) = t.thetype; - SYMB_FIELD_BASENAME(thesymb) = structureName.thesymb; -} - -inline SgFieldSymb::SgFieldSymb(const char *identifier, SgType &t, - SgSymbol &structureName) :SgSymbol(FIELD_NAME, identifier) -{ - SYMB_TYPE(thesymb) = t.thetype; - SYMB_FIELD_BASENAME(thesymb) = structureName.thesymb; -} - -inline SgFieldSymb::~SgFieldSymb() -{ RemoveFromTableSymb((void *) this); } - -// position in the structure -#ifdef NOT_YET_IMPLEMENTED -inline int SgFieldSymb::offset() -{ - // return positionOfFieldInStruct(thesymb, SYMB_BASE_NAME(thesymb)); - SORRY; - return 0; -} -#endif - -// parent structure -inline SgSymbol * SgFieldSymb::structureName() -{ return SymbMapping(SYMB_FIELD_BASENAME(thesymb)); } - -inline SgSymbol * SgFieldSymb::nextField() -{ return SymbMapping(getClassNextFieldOrMember(thesymb)); } - -inline int SgFieldSymb::isMethodOfElement() -{ - int x; - - if ((int) SYMB_ATTR(thesymb) & (int) ELEMENT_FIELD) - x = TRUE; - else - x = FALSE; - - return x; -} - - -// SgClassSymb--inlines - -inline SgClassSymb::SgClassSymb(int variant, char *name, - SgStatement &scope):SgSymbol(variant, name, scope) -{} - -inline SgClassSymb::~SgClassSymb() -{ RemoveFromTableSymb((void *) this); } - -// number of fields and member functions. -inline int SgClassSymb::numberOfFields() -{ return lenghtOfFieldList(thesymb);} - -// the i-th field or member function. -inline SgSymbol * SgClassSymb::field(int i) -{ return SymbMapping(GetThOfFieldList(thesymb,i)); } - - -// SgLabelSymb--inlines - -#ifdef NOT_YET_IMPLEMENTED -inline SgLabelSymb::SgLabelSymb(char *name):SgSymbol(LABEL_NAME) -{ - SORRY; -} -#endif - -inline SgLabelSymb::~SgLabelSymb() -{ RemoveFromTableSymb((void *) this); } - - -inline SgLabelVarSymb::SgLabelVarSymb(char *name, SgStatement &scope):SgSymbol(LABEL_NAME, name, scope) -{} - -inline SgLabelVarSymb::~SgLabelVarSymb() -{ RemoveFromTableSymb((void *) this); } - - -// SgExternalSymb--inlines -inline SgExternalSymb::SgExternalSymb(char *name, SgStatement &scope):SgSymbol(ROUTINE_NAME, name, scope) -{} - -inline SgExternalSymb::~SgExternalSymb() -{ RemoveFromTableSymb((void *) this); } - - -// SgConstructSymb--inlines - -inline SgConstructSymb::SgConstructSymb(char *name, SgStatement &scope):SgSymbol(CONSTRUCT_NAME, name, scope) -{} - -inline SgConstructSymb::~SgConstructSymb() -{ RemoveFromTableSymb((void *) this); } - - -// SgInterfaceSymb--inlines - -inline SgInterfaceSymb::SgInterfaceSymb(char *name, SgStatement &scope):SgSymbol(INTERFACE_NAME, name, scope) -{} - -inline SgInterfaceSymb::~SgInterfaceSymb() -{ RemoveFromTableSymb((void *) this); } - - -// SgModuleSymb--inlines -inline SgModuleSymb::SgModuleSymb(char *name):SgSymbol(MODULE_NAME, name, *BfndMapping(getFirstStmt())) -{} - -inline SgModuleSymb::~SgModuleSymb() -{ RemoveFromTableSymb((void *) this); } - - -// SgArrayType--inlines - -inline SgArrayType::SgArrayType(SgType &base_type):SgType(T_ARRAY) -{ TYPE_BASE(thetype) = base_type.thetype; } - -inline int SgArrayType::dimension() -{ return exprListLength(TYPE_RANGES(thetype)); } - -inline SgExpression * SgArrayType::sizeInDim(int i) -{ return LlndMapping(getPositionInExprList(TYPE_RANGES(thetype),i)); } - -inline SgType * SgArrayType::baseType() -{ - return TypeMapping(lookForInternalBasetype(thetype)); - // perhaps should be return TYPE_BASE(thetype); -} - -inline void SgArrayType::setBaseType(SgType &bt) -{ TYPE_BASE(thetype) = bt.thetype; } - -inline void SgArrayType::addDimension(SgExpression *e) -{ - if(!e){ - SgExprListExp *l = new SgExprListExp(); - TYPE_RANGES(thetype) = l->thellnd; - } - else - TYPE_RANGES(thetype) = addToExprList(TYPE_RANGES(thetype),e->thellnd); -} -inline SgExpression * SgArrayType::getDimList() -{ - return LlndMapping(TYPE_RANGES(thetype)); -} -inline void SgArrayType::addRange(SgExpression &e) -{ - TYPE_RANGES(thetype) = addToExprList(TYPE_RANGES(thetype),e.thellnd); - // For C when adding range adding one level of pointer in basetype. - // This routine should only be used to build a dereferencing expression - // like x[i][j] and not a declaration. use addDimension for that. - if (!CurrentProject->Fortranlanguage()) - { - PTR_TYPE type; - type = (PTR_TYPE) newNode(T_POINTER); - TYPE_BASE(type) = TYPE_BASE(thetype); - TYPE_BASE(thetype) = type; - } -} - -inline SgArrayType::~SgArrayType() -{ RemoveFromTableType((void *) this); } - - -// SgPointerType--inlines - -inline SgType * SgPointerType::baseType() -{ return TypeMapping(TYPE_BASE(thetype)); } - -inline void SgPointerType::setBaseType(SgType &baseType) -{ TYPE_BASE(thetype) = baseType.thetype; } - -inline int SgPointerType::indirection() -{ return TYPE_TEMPLATE_DUMMY1(thetype); } - -inline void SgPointerType::setIndirection(int i) -{ TYPE_TEMPLATE_DUMMY1(thetype) = i; } - -inline SgPointerType::~SgPointerType() -{ RemoveFromTableType((void *) this); } - -inline int SgPointerType::modifierFlag() -{ return TYPE_TEMPLATE_DUMMY5(thetype); } - -inline void SgPointerType::setModifierFlag(int flag) -{ TYPE_TEMPLATE_DUMMY5(thetype) = TYPE_TEMPLATE_DUMMY5(thetype) | flag; } - - -// SgFunctionType-- inlines - -inline SgFunctionType::SgFunctionType(SgType &ret_val):SgType(T_FUNCTION) -{ TYPE_BASE(thetype) = ret_val.thetype; } - -inline SgType * SgFunctionType::returnedValue() -{ return TypeMapping(TYPE_BASE(thetype)); } - -inline void SgFunctionType::changeReturnedValue(SgType &ret_val) -{ TYPE_BASE(thetype) = ret_val.thetype; } - -inline SgFunctionType::~SgFunctionType() -{ RemoveFromTableType((void *) this); } - -// SgReferenceType--inlines - -inline SgReferenceType::SgReferenceType(SgType &base_type):SgType(T_REFERENCE) -{ TYPE_BASE(thetype) = base_type.thetype; } - -inline SgType * SgReferenceType::baseType() -{ return TypeMapping(TYPE_BASE(thetype)); } - -inline void SgReferenceType::setBaseType(SgType &baseType) -{ TYPE_BASE(thetype) = baseType.thetype; } - -inline SgReferenceType::~SgReferenceType() -{ RemoveFromTableType((void *) this); } - -inline int SgReferenceType::modifierFlag() -{ return TYPE_TEMPLATE_DUMMY5(thetype); } - -inline void SgReferenceType::setModifierFlag(int flag) -{ TYPE_TEMPLATE_DUMMY5(thetype) = TYPE_TEMPLATE_DUMMY5(thetype) | flag; } - - -// SgDerivedType--inlines - -inline SgDerivedType::SgDerivedType(SgSymbol &type_name):SgType(T_DERIVED_TYPE) -{ TYPE_SYMB_DERIVE(thetype) = type_name.thesymb; } - -inline SgSymbol * SgDerivedType::typeName() -{ return SymbMapping(TYPE_SYMB_DERIVE(thetype)); } - -inline SgDerivedType::~SgDerivedType() -{ RemoveFromTableType((void *) this); } - - -// SgDerivedClassType--inlines - -inline SgDerivedClassType::SgDerivedClassType(SgSymbol &type_name):SgType(T_DERIVED_CLASS) -{ TYPE_SYMB_DERIVE(thetype) = type_name.thesymb; } - -inline SgSymbol * SgDerivedClassType::typeName() -{ return SymbMapping(TYPE_SYMB_DERIVE(thetype)); } - -inline SgDerivedClassType::~SgDerivedClassType() -{ RemoveFromTableType((void *) this); } - - -// SgDescriptType--inlines - - -inline SgDescriptType::SgDescriptType(SgType &base_type, int bit_flag):SgType(T_DESCRIPT) -{ - TYPE_LONG_SHORT(thetype) = bit_flag; - TYPE_BASE(thetype) = base_type.thetype; -} - -inline int SgDescriptType::modifierFlag() -{ return TYPE_LONG_SHORT(thetype); } - -inline void SgDescriptType::setModifierFlag(int flag) -{ TYPE_LONG_SHORT(thetype) = TYPE_LONG_SHORT(thetype) | flag; } - -inline SgDescriptType::~SgDescriptType() -{ RemoveFromTableType((void *) this); } - - - -// SgDerivedCollectionType--inlines - -inline SgDerivedCollectionType::SgDerivedCollectionType(SgSymbol &s, SgType &t):SgType(T_DERIVED_COLLECTION) -{ - TYPE_COLL_BASE(thetype) = t.thetype; - TYPE_SYMB_DERIVE(thetype) = s.thesymb; -} - -inline SgType * SgDerivedCollectionType::elementClass() -{ return TypeMapping(TYPE_COLL_BASE(thetype)); } - -inline void SgDerivedCollectionType::setElementClass(SgType &ty) -{ TYPE_COLL_BASE(thetype) = ty.thetype; } - -inline SgSymbol * SgDerivedCollectionType::collectionName() -{ return SymbMapping(TYPE_SYMB_DERIVE(thetype)); } - -inline SgStatement * SgDerivedCollectionType::createCollectionWithElemType() -{ - return BfndMapping(LibcreateCollectionWithType(thetype,TYPE_COLL_BASE(thetype))); -} - -inline SgDerivedCollectionType::~SgDerivedCollectionType() -{ RemoveFromTableType((void *) this); } - -void InitializeTable(); - -#ifdef USER - -SgType *SgTypeInt(); -SgType *SgTypeChar(); -SgType *SgTypeFloat(); -SgType *SgTypeDouble(); -SgType *SgTypeVoid(); -SgType *SgTypeBool(); -SgType *SgTypeDefault(); - -SgUnaryExp & SgDerefOp(SgExpression &e); -SgUnaryExp & SgAddrOp(SgExpression &e); -SgUnaryExp & SgUMinusOp(SgExpression &e); -SgUnaryExp & SgUPlusOp(SgExpression &e); -SgUnaryExp & SgPrePlusPlusOp(SgExpression &e); -SgUnaryExp & SgPreMinusMinusOp(SgExpression &e); -SgUnaryExp & SgPostPlusPlusOp(SgExpression &e); -SgUnaryExp & SgPostMinusMinusOp(SgExpression &e); -SgUnaryExp & SgBitCompfOp(SgExpression &e); -SgUnaryExp & SgNotOp(SgExpression &e); -SgUnaryExp & SgSizeOfOp(SgExpression &e); -SgUnaryExp & makeAnUnaryExpression(int code,PTR_LLND ll1); - - -SgValueExp * isSgValueExp(SgExpression *pt); -SgKeywordValExp * isSgKeywordValExp(SgExpression *pt); -SgUnaryExp * isSgUnaryExp(SgExpression *pt); -SgCastExp * isSgCastExp(SgExpression *pt); -SgDeleteExp * isSgDeleteExp(SgExpression *pt); -SgNewExp * isSgNewExp(SgExpression *pt); -SgExprIfExp * isSgExprIfExp(SgExpression *pt); -SgFunctionCallExp * isSgFunctionCallExp(SgExpression *pt); -SgFuncPntrExp * isSgFuncPntrExp(SgExpression *pt); -SgExprListExp * isSgExprListExp(SgExpression *pt); -SgRefExp * isSgRefExp (SgExpression *pt); -SgVarRefExp * isSgVarRefExp (SgExpression *pt); -SgThisExp * isSgThisExp (SgExpression *pt); -SgArrayRefExp * isSgArrayRefExp (SgExpression *pt); -SgPntrArrRefExp * isSgPntrArrRefExp(SgExpression *pt); -SgPointerDerefExp * isSgPointerDerefExp (SgExpression *pt); -SgRecordRefExp * isSgRecordRefExp (SgExpression *pt); -SgStructConstExp* isSgStructConstExp (SgExpression *pt); -SgConstExp* isSgConstExp (SgExpression *pt); -SgVecConstExp * isSgVecConstExp (SgExpression *pt); -SgInitListExp * isSgInitListExp (SgExpression *pt); -SgObjectListExp * isSgObjectListExp (SgExpression *pt); -SgAttributeExp * isSgAttributeExp (SgExpression *pt); -SgKeywordArgExp * isSgKeywordArgExp (SgExpression *pt); -SgSubscriptExp* isSgSubscriptExp (SgExpression *pt); -SgUseOnlyExp * isSgUseOnlyExp (SgExpression *pt); -SgUseRenameExp * isSgUseRenameExp (SgExpression *pt); -SgSpecPairExp * isSgSpecPairExp (SgExpression *pt); -SgIOAccessExp * isSgIOAccessExp (SgExpression *pt); -SgImplicitTypeExp * isSgImplicitTypeExp (SgExpression *pt); -SgTypeExp * isSgTypeExp (SgExpression *pt); -SgSeqExp * isSgSeqExp (SgExpression *pt); -SgStringLengthExp * isSgStringLengthExp (SgExpression *pt); -SgDefaultExp * isSgDefaultExp (SgExpression *pt); -SgLabelRefExp * isSgLabelRefExp (SgExpression *pt); -SgProgHedrStmt * isSgProgHedrStmt (SgStatement *pt); -SgProcHedrStmt * isSgProcHedrStmt (SgStatement *pt); -SgFuncHedrStmt * isSgFuncHedrStmt (SgStatement *pt); -SgClassStmt * isSgClassStmt (SgStatement *pt); -SgStructStmt * isSgStructStmt (SgStatement *pt); -SgUnionStmt * isSgUnionStmt (SgStatement *pt); -SgEnumStmt * isSgEnumStmt (SgStatement *pt); -SgCollectionStmt * isSgCollectionStmt (SgStatement *pt); -SgBasicBlockStmt * isSgBasicBlockStmt (SgStatement *pt); -SgForStmt * isSgForStmt (SgStatement *pt); -SgWhileStmt * isSgWhileStmt (SgStatement *pt); -SgDoWhileStmt * isSgDoWhileStmt (SgStatement *pt); -SgLogIfStmt * isSgLogIfStmt (SgStatement *pt); -SgIfStmt * isSgIfStmt (SgStatement *pt); -SgArithIfStmt * isSgArithIfStmt (SgStatement *pt); -SgWhereStmt * isSgWhereStmt (SgStatement *pt); -SgWhereBlockStmt * isSgWhereBlockStmt (SgStatement *pt); -SgSwitchStmt * isSgSwitchStmt (SgStatement *pt); -SgCaseOptionStmt * isSgCaseOptionStmt (SgStatement *pt); -SgExecutableStatement * isSgExecutableStatement (SgStatement *pt); -SgAssignStmt * isSgAssignStmt (SgStatement *pt); -SgCExpStmt * isSgCExpStmt (SgStatement *pt); -SgPointerAssignStmt * isSgPointerAssignStmt (SgStatement *pt); -SgHeapStmt * isSgHeapStmt (SgStatement *pt); -SgNullifyStmt * isSgNullifyStmt (SgStatement *pt); -SgContinueStmt * isSgContinueStmt (SgStatement *pt); -SgControlEndStmt * isSgControlEndStmt (SgStatement *pt); -SgBreakStmt * isSgBreakStmt (SgStatement *pt); -SgCycleStmt * isSgCycleStmt (SgStatement *pt); -SgReturnStmt * isSgReturnStmt (SgStatement *pt); -SgExitStmt * isSgExitStmt (SgStatement *pt); -SgGotoStmt * isSgGotoStmt (SgStatement *pt); -SgLabelListStmt * isSgLabelListStmt (SgStatement *pt); -SgAssignedGotoStmt * isSgAssignedGotoStmt (SgStatement *pt); -SgComputedGotoStmt * isSgComputedGotoStmt (SgStatement *pt); -SgStopOrPauseStmt * isSgStopOrPauseStmt (SgStatement *pt); -SgCallStmt* isSgCallStmt (SgStatement *pt); -SgProsHedrStmt * isSgProsHedrStmt (SgStatement *pt); /* Fortran M */ -SgProcessDoStmt * isSgProcessDoStmt (SgStatement *pt); /* Fortran M */ -SgProsCallStmt* isSgProsCallStmt (SgStatement *pt); /* Fortran M */ -SgProsCallLctn* isSgProsCallLctn (SgStatement *pt); /* Fortran M */ -SgProsCallSubm* isSgProsCallSubm (SgStatement *pt); /* Fortran M */ -SgInportStmt * isSgInportStmt (SgStatement *pt); /* Fortran M */ -SgOutportStmt * isSgOutportStmt (SgStatement *pt); /* Fortran M */ -SgIntentStmt * isSgIntentStmt (SgStatement *pt); /* Fortran M */ -SgChannelStmt * isSgChannelStmt (SgStatement *pt); /* Fortran M */ -SgMergerStmt * isSgMergerStmt (SgStatement *pt); /* Fortran M */ -SgMoveportStmt * isSgMoveportStmt (SgStatement *pt); /* Fortran M */ -SgSendStmt * isSgSendStmt (SgStatement *pt); /* Fortran M */ -SgReceiveStmt * isSgReceiveStmt (SgStatement *pt); /* Fortran M */ -SgEndchannelStmt * isSgEndchannelStmt (SgStatement *pt); /* Fortran M */ -SgProbeStmt * isSgProbeStmt (SgStatement *pt); /* Fortran M */ -SgProcessorsRefExp * isSgProcessorsRefExp(SgExpression *pt); /* Fortran M */ -SgPortTypeExp * isSgPortTypeExp (SgExpression *pt); /* Fortran M */ -SgInportExp * isSgInportExp (SgExpression *pt); /* Fortran M */ -SgOutportExp * isSgOutportExp (SgExpression *pt); /* Fortran M */ -SgFromportExp * isSgFromportExp (SgExpression *pt); /* Fortran M */ -SgToportExp * isSgToportExp (SgExpression *pt); /* Fortran M */ -SgIO_statStoreExp * isSgIO_statStoreExp (SgExpression *pt); /* Fortran M */ -SgEmptyStoreExp * isSgEmptyStoreExp (SgExpression *pt); /* Fortran M */ -SgErrLabelExp * isSgErrLabelExp (SgExpression *pt); /* Fortran M */ -SgEndLabelExp * isSgEndLabelExp (SgExpression *pt); /* Fortran M */ -SgDataImpliedDoExp * isSgDataImpliedDoExp (SgExpression *pt);/* Fortran M */ -SgDataEltExp * isSgDataEltExp (SgExpression *pt); /* Fortran M */ -SgDataSubsExp * isSgDataSubsExp (SgExpression *pt); /* Fortran M */ -SgDataRangeExp * isSgDataRangeExp (SgExpression *pt); /* Fortran M */ -SgIconExprExp * isSgIconExprExp (SgExpression *pt); /* Fortran M */ -SgIOStmt * isSgIOStmt (SgStatement *pt); -SgInputOutputStmt * isSgInputOutputStmt (SgStatement *pt); -SgIOControlStmt * isSgIOControlStmt (SgStatement *pt); -SgDeclarationStatement * isSgDeclarationStatement (SgStatement *pt); -SgVarDeclStmt * isSgVarDeclStmt (SgStatement *pt); -SgVarListDeclStmt * isSgVarListDeclStmt (SgStatement *pt); -SgStructureDeclStmt * isSgStructureDeclStmt (SgStatement *pt); -SgNestedVarListDeclStmt* isSgNestedVarListDeclStmt (SgStatement *pt); -SgParameterStmt * isSgParameterStmt (SgStatement *pt); -SgImplicitStmt * isSgImplicitStmt (SgStatement *pt); -SgVariableSymb * isSgVariableSymb (SgSymbol *pt); -SgConstantSymb * isSgConstantSymb (SgSymbol *pt); -SgFunctionSymb * isSgFunctionSymb (SgSymbol *pt); -SgMemberFuncSymb * isSgMemberFuncSymb (SgSymbol *pt); -SgFieldSymb * isSgFieldSymb (SgSymbol *pt); -SgClassSymb * isSgClassSymb (SgSymbol *pt); -SgLabelSymb * isSgLabelSymb (SgSymbol *pt); -SgLabelVarSymb * isSgLabelVarSymb (SgSymbol *pt); -SgExternalSymb * isSgExternalSymb (SgSymbol *pt); -SgConstructSymb * isSgConstructSymb (SgSymbol *pt); -SgInterfaceSymb * isSgInterfaceSymb (SgSymbol *pt); -SgModuleSymb * isSgModuleSymb (SgSymbol *pt); -SgArrayType * isSgArrayType (SgType *pt); -SgPointerType * isSgPointerType (SgType *pt); -SgFunctionType * isSgFunctionType (SgType *pt); -SgReferenceType * isSgReferenceType (SgType *pt); -SgDerivedType * isSgDerivedType (SgType *pt); -SgDerivedClassType * isSgDerivedClassType (SgType *pt); -SgDescriptType * isSgDescriptType (SgType *pt); -SgDerivedCollectionType* isSgDerivedCollectionType (SgType *pt); -#endif - -#endif /* ndef LIBSAGEXX_H */ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/macro.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/macro.h deleted file mode 100644 index b08876e..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/macro.h +++ /dev/null @@ -1,434 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* declaration pour la toolbox 19/12/91 */ - -/* The following include files are sigma include files */ -#include "defs.h" -#include "bif.h" -#include "ll.h" -#include "symb.h" -#include "sets.h" -#include "db.h" -#include "vparse.h" - -#ifdef CPLUS_ -extern "C" PTR_FILE pointer_on_file_proj; -#else -extern PTR_FILE pointer_on_file_proj; -#endif -/* the following are names of constants used by the C parser to */ -/* add attributed to symbol table entries. */ -/* For symbptr->attr access with SYMB_ATTR(..) */ -/* note these are ALSO IN FILE vpc.h and we should find a single spot for them!! */ -#define ATT_CLUSTER 0 -#define ATT_GLOBAL 1 -#define PURE 8 -#define PRIVATE_FIELD 16 -#define PROTECTED_FIELD 32 -#define PUBLIC_FIELD 64 -#define ELEMENT_FIELD 128 -#define COLLECTION_FIELD 256 -#define CONSTRUCTOR 512 -#define DESTRUCTOR 1024 -#define PCPLUSPLUS_DOSUBSET 2048 -#define INVALID 4096 -#define SUBCOLLECTION 4096*2 -#define OVOPERATOR 4096*4 - - -/* - * There are 3 types of macros: - * the first type deals with bif nodes and are named BIF_XXX - * the second type deals with symbol nodes and are named SYMB_XXX - * the last type deasl with low level nodes and are named NODE_XXX - */ - -/* Macros for BIF NODE */ -#define DECL_SOURCE_LINE(FUNC) ((FUNC)->g_line) -#define DECL_SOURCE_FILE(FUNC) (default_filename) -/* give the code of a node */ -#define BIF_CODE(NODE) ((NODE)->variant) -#define BIF_LINE(NODE) ((NODE)->g_line) -#define BIF_LOCAL_LINE(NODE) ((NODE)->l_line) -#define BIF_DECL_SPECS(NODE) ((NODE)->decl_specs) -#define BIF_INDEX(NODE) ((NODE)->index) -/* give the identifier */ -#define BIF_ID(NODE) ((NODE)->id) -#define BIF_NEXT(NODE) ((NODE)->thread) -#define BIF_CP(NODE) ((NODE)->control_parent) -#define BIF_LABEL(NODE) ((NODE)->label) -#define BIF_LL1(NODE) ((NODE)->entry.Template.ll_ptr1) -#define BIF_LL2(NODE) ((NODE)->entry.Template.ll_ptr2) -#define BIF_LL3(NODE) ((NODE)->entry.Template.ll_ptr3) -#define BIF_SYMB(NODE) ((NODE)->entry.Template.symbol) -#define BIF_BLOB1(NODE) ((NODE)->entry.Template.bl_ptr1) -#define BIF_BLOB2(NODE) ((NODE)->entry.Template.bl_ptr2) -#define BIF_FLOW(NODE) ((NODE)->entry.Template.bl_ptr1->ref) -#define BIF_FLOW_TRUE(NODE) ((NODE)->entry.Template.bl_ptr1->ref) -#define BIF_FLOW_FALSE_EXIST(NODE) ((NODE)->entry.Template.bl_ptr2) -#define BIF_FLOW_FALSE(NODE) ((NODE)->entry.Template.bl_ptr2->ref) -#define BIF_FILE_NAME(NODE) ((NODE)->filename) -#define BIF_CMNT(NODE) ((NODE)->entry.Template.cmnt_ptr) -#define BIF_LABEL_USE(NODE) ((NODE)->entry.Template.lbl_ptr) -#define BIF_SETS(NODE) ((NODE)->entry.Template.sets) -#define BIF_PROPLIST(NODE) ((NODE)->prop_list) -/* seems to be useless not used that way???????*/ -#define BIF_PROPLIST_NAME(NODE) ((NODE)->prop_list.prop_name) -#define BIF_PROPLIST_VAL(NODE) ((NODE)->prop_list.prop_val) -#define BIF_PROPLIST_NEXT(NODE) ((NODE)->prop_list.next) - -/* Macros for LOW LEVEL NODE*/ - -/* Give the code of the node */ -#define NODE_CODE(NODE) ((NODE)->variant) -/* give the identifier */ -#define NODE_ID(NODE) ((NODE)->id) -#define NODE_NEXT(NODE) ((NODE)->thread) -#define NODE_CHAIN(NODE) ((NODE)->thread) -#define NODE_TYPE(NODE) ((NODE)->type) -#define NODE_STR(NODE) ((NODE)->entry.string_val) -#define NODE_STRING_POINTER(NODE) ((NODE)->entry.string_val) -#define NODE_IV(NODE) ((NODE)->entry.ival) - -/* use for integer constant - the boolean value is use if the constante is big - (two integers) */ -#define NODE_INT_CST_LOW(NODE) ((NODE)->entry.ival) -#define NODE_DOUBLE_CST(NODE) ((NODE)->entry.string_val) -#define NODE_FLOAT_CST(NODE) ((NODE)->entry.string_val) -#define NODE_CHAR_CST(NODE) ((NODE)->entry.cval) -#define NODE_BOOL_CST(NODE) ((NODE)->entry.bval) -/* la partie haute est dans les noeuds info - A modifier par la suite */ - - -#define NODE_CV(NODE) ((NODE)->entry.cval) -#define NODE_DV(NODE) ((NODE)->entry.dval) -#define NODE_REAL_CST(NODE) ((NODE)->entry.dval) -#define NODE_BV(NODE) ((NODE)->entry.bval) -#define NODE_ARRAY_OP(NODE) ((NODE)->entry.array_op) -#define NODE_TEMPLATE(NODE) ((NODE)->entry.Template) -#define NODE_SYMB(NODE) ((NODE)->entry.Template.symbol) -#define NODE_TEMPLATE_LL1(NODE) ((NODE)->entry.Template.ll_ptr1) -#define NODE_TEMPLATE_LL2(NODE) ((NODE)->entry.Template.ll_ptr2) -#define NODE_OPERAND0(NODE) ((NODE)->entry.Template.ll_ptr1) -#define NODE_PURPOSE(NODE) ((NODE)->entry.Template.ll_ptr1) -#define NODE_OPERAND1(NODE) ((NODE)->entry.Template.ll_ptr2) -#define NODE_OPERAND2(NODE) bif_sorry("OPERAND2") -#define NODE_VALUE(NODE) ((NODE)->entry.Template.ll_ptr2) -#define NODE_STRING_LENGTH(NODE) (strlen((NODE)->entry.string_val)) -#define NODE_LABEL(NODE) ((NODE)->entry.label_list.lab_ptr) -#define NODE_LIST_ITEM(NODE) ((NODE)->entry.list.item) -#define NODE_LIST_NEXT(NODE) ((NODE)->entry.list.next) - -/* For symbole NODE */ -#define SYMB_VAL(NODE) ((NODE)->entry.const_value) -#define SYMB_DECLARED_NAME(NODE) ((NODE)->entry.member_func.declared_name) -#define SYMB_CODE(NODE) ((NODE)->variant) -#define SYMB_ID(NODE) ((NODE)->id) -#define SYMB_IDENT(NODE) ((NODE)->ident) -#define SYMB_PARENT(NODE) ((NODE)->parent) -#define SYMB_DECL(NODE) ((NODE)->decl) -#define SYMB_ATTR(NODE) ((NODE)->attr) -#define SYMB_DOVAR(NODE) ((NODE)->dovar) -#define SYMB_BLOC_NEXT(NODE) ((NODE)->next_symb) -#define SYMB_NEXT(NODE) ((NODE)->thread) -#define SYMB_LIST(NODE) ((NODE)->id_list) -#define SYMB_TYPE(NODE) ((NODE)->type) -#define SYMB_SCOPE(NODE) ((NODE)->scope) -#define SYMB_UD_CHAIN(NODE) ((NODE)->ud_chain) -#define SYMB_ENTRY(NODE) ((NODE)->entry) -#define SYMB_NEXT_DECL(NODE) ((NODE)->entry.var_decl.next_in) -#define SYMB_NEXT_FIELD(NODE) ((NODE)->entry.field.next) -#define SYMB_RESTRICTED_BIT(NODE) ((NODE)->entry.field.restricted_bit) -#define SYMB_BASE_NAME(NODE) ((NODE)->entry.Template.base_name) -#define SYMB_FUNC_HEDR(NODE) ((NODE)->entry.func_decl.func_hedr) -#define SYMB_FUNC_PARAM(NODE) ((NODE)->entry.proc_decl.in_list) -#define SYMB_FUNC_NB_PARAM(NODE) ((NODE)->entry.proc_decl.num_input) -#define SYMB_FUNC_OUTPUT(NODE) ((NODE)->entry.proc_decl.num_output) -#define SYMB_FIELD_BASENAME(NODE) ((NODE)->entry.field.base_name) -#define SYMB_FIELD_TAG(NODE) ((NODE)->entry.field.tag) -#define SYMB_FIELD_DECLARED_NAME(NODE) ((NODE)->entry.field.declared_name) -#define SYMB_FIELD_OFFSET(NODE) ((NODE)->entry.field.offset) -#define SYMB_MEMBER_BASENAME(NODE) ((NODE)->entry.member_func.base_name) -#define SYMB_MEMBER_NEXT(NODE) ((NODE)->entry.member_func.next) -#define SYMB_MEMBER_HEADER(NODE) ((NODE)->entry.member_func.func_hedr) -#define SYMB_MEMBER_LIST(NODE) ((NODE)->entry.member_func.symb_list) -#define SYMB_MEMBER_PARAM(NODE) ((NODE)->entry.member_func.in_list) -#define SYMB_MEMBER_TAG(NODE) ((NODE)->entry.member_func.tag) -#define SYMB_MEMBER_OFFSET(NODE) ((NODE)->entry.member_func.offset) -#define SYMB_MEMBER_DECLARED_NAME(NODE) ((NODE)->entry.member_func.declared_name) -#define SYMB_MEMBER_OUTLIST(NODE) ((NODE)->entry.member_func.out_list) -#define SYMB_MEMBER_NB_OUTPUT(NODE) ((NODE)->entry.member_func.num_output) -#define SYMB_MEMBER_NB_IO(NODE) ((NODE)->entry.member_func.num_io) - -/* for Template */ -#define SYMB_TEMPLATE_DUMMY1(NODE) ((NODE)->entry.Template.seen) -#define SYMB_TEMPLATE_DUMMY2(NODE) ((NODE)->entry.Template.num_input) -#define SYMB_TEMPLATE_DUMMY3(NODE) ((NODE)->entry.Template.num_output) -#define SYMB_TEMPLATE_DUMMY4(NODE) ((NODE)->entry.Template.num_io) -#define SYMB_TEMPLATE_DUMMY5(NODE) ((NODE)->entry.Template.in_list) -#define SYMB_TEMPLATE_DUMMY6(NODE) ((NODE)->entry.Template.out_list) -#define SYMB_TEMPLATE_DUMMY7(NODE) ((NODE)->entry.Template.symb_list) -#define SYMB_TEMPLATE_DUMMY8(NODE) ((NODE)->entry.Template.local_size) -#define SYMB_TEMPLATE_DUMMY9(NODE) ((NODE)->entry.Template.label_list) -#define SYMB_TEMPLATE_DUMMY10(NODE) ((NODE)->entry.Template.func_hedr) -#define SYMB_TEMPLATE_DUMMY11(NODE) ((NODE)->entry.Template.call_list) -#define SYMB_TEMPLATE_DUMMY12(NODE) ((NODE)->entry.Template.tag) -#define SYMB_TEMPLATE_DUMMY13(NODE) ((NODE)->entry.Template.offset) -#define SYMB_TEMPLATE_DUMMY14(NODE) ((NODE)->entry.Template.declared_name) -#define SYMB_TEMPLATE_DUMMY15(NODE) ((NODE)->entry.Template.next) -#define SYMB_TEMPLATE_DUMMY16(NODE) ((NODE)->entry.Template.base_name) - - -/* for BLOB NODE */ - -#define BLOB_NEXT(NODE) ((NODE)->next) -#define BLOB_VALUE(NODE) ((NODE)->ref) -#define HEAD_BLOB(NODE) ((NODE)->head_blob) - -/* for type node */ -#define TYPE_CODE(NODE) ((NODE)->variant) -#define TYPE_ID(NODE) ((NODE)->id) -#define TYPE_SYMB(NODE) ((NODE)->name) -#define TYPE_UD_CHAIN(NODE) ((NODE)->ud_chain) -#define TYPE_LENGTH(NODE) ((NODE)->length) -#define TYPE_BASE(NODE) ((NODE)->entry.Template.base_type) -#define TYPE_RANGES(NODE) ((NODE)->entry.Template.ranges) -#define TYPE_KIND_LEN(NODE) ((NODE)->entry.Template.kind_len) -#define TYPE_QUOTE(NODE) ((NODE)->entry.Template.dummy1) -#define TYPE_DIM(NODE) ((NODE)->entry.ar_decl.num_dimensions) -#define TYPE_DECL_BASE(NODE) ((NODE)->entry.ar_decl.base_type) -#define TYPE_DECL_RANGES(NODE) ((NODE)->entry.ar_decl.ranges) -#define TYPE_NEXT(NODE) ((NODE)->thread) -#define TYPE_DESCRIP(NODE) ((NODE)->entry.descriptive) -#define TYPE_DESCRIP_BASE_TYPE(NODE) ((NODE)->entry.descriptive.base_type) -#define TYPE_FIRST_FIELD(NODE) ((NODE)->entry.re_decl.first) -#define TYPE_UNSIGNED(NODE) ((NODE)->entry.descriptive.signed_flag) -#define TYPE_LONG_SHORT(NODE) ((NODE)->entry.descriptive.long_short_flag) -#define TYPE_MODE_FLAG(NODE) ((NODE)->entry.descriptive.mod_flag) -#define TYPE_STORAGE_FLAG(NODE) ((NODE)->entry.descriptive.storage_flag) -#define TYPE_ACCESS_FLAG(NODE) ((NODE)->entry.descriptive.access_flag) -#define TYPE_SYMB_DERIVE(NODE) ((NODE)->entry.derived_type.symbol) -#define TYPE_SCOPE_SYMB_DERIVE(NODE) ((NODE)->entry.derived_type.scope_symbol) -#define TYPE_COLL_BASE(NODE) ((NODE)->entry.col_decl.base_type) -#define TYPE_COLL_ORI_CLASS(NODE) ((NODE)->entry.derived_class.original_class) -#define TYPE_COLL_NUM_FIELDS(NODE) ((NODE)->entry.derived_class.num_fields) -#define TYPE_COLL_RECORD_SIZE(NODE) ((NODE)->entry.derived_class.record_size) -#define TYPE_COLL_FIRST_FIELD(NODE) ((NODE)->entry.derived_class.first) -#define TYPE_COLL_NAME(NODE) ((NODE)->entry.col_decl.collection_name) -#define TYPE_TEMPL_NAME(NODE) ((NODE)->entry.templ_decl.templ_name) -#define TYPE_TEMPL_ARGS(NODE) ((NODE)->entry.templ_decl.args) -/* sepcial case for enumeral type */ -#define TYPE_VALUES(NODE) ((NODE)->entry.Template.ranges) /* wrong, to verify */ - -/* To allow copies of type */ -#define TYPE_TEMPLATE_BASE(NODE) ((NODE)->entry.Template.base_type) -#define TYPE_TEMPLATE_DUMMY1(NODE) ((NODE)->entry.Template.dummy1) -#define TYPE_TEMPLATE_RANGES(NODE) ((NODE)->entry.Template.ranges) -#define TYPE_TEMPLATE_DUMMY2(NODE) ((NODE)->entry.Template.dummy2) -#define TYPE_TEMPLATE_DUMMY3(NODE) ((NODE)->entry.Template.dummy3) -#define TYPE_TEMPLATE_DUMMY4(NODE) ((NODE)->entry.Template.dummy4) -#define TYPE_TEMPLATE_DUMMY5(NODE) ((NODE)->entry.Template.dummy5) -/* Other */ -#define FILE_OF_CURRENT_PROJ(PROJ) ((PROJ)->proj_name) -#define FUNCT_NAME(FUNC) ((FUNC)->entry.Template.symbol->ident) -#define FUNCT_SYMB(FUNC) ((FUNC)->entry.Template.symbol) -#define FUNCT_FIRST_PAR(FUNC) ((FUNC)->entry.Template.symbol->entry.func_decl.in_list) - - -#define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) -#define MAX(X,Y) ((X) > (Y) ? (X) : (Y)) -#define CEIL(x,y) (((x) + (y) - 1) / (y)) - -/* extern pour Bif */ - -/* other type of low level node and decl */ -#define CEIL_DIV_EXPR 1000 -#define MAX_OP 1001 -#define BIF_PARM_DECL 1002 -#define BIF_SAVE_EXPR 1003 -#define MIN_OP 1004 -#define BIF_ADDR_EXPR 1005 -#define BIF_NOP_EXPR 1006 -#define BIF_RTL_EXPR 1007 -/* #define TRUNC_MOD_EXPR 1008 killed by dbg because in rid enum*/ -/* #define TRUNC_DIV_EXPR 1009 killed by dbg because in rid enum*/ -#define FLOOR_DIV_EXPR 1010 -#define FLOOR_MOD_EXPR 1011 -#define CEIL_MOD_EXPR 1012 -#define ROUND_DIV_EXPR 1013 -#define ROUND_MOD_EXPR 1014 -#define RDIV_EXPR 1015 -#define EXACT_DIV_EXPR 1016 -#define COND_EXPR EXPR_IF -#define CONVERT_EXPR 1017 -/*#define MINUS_EXPR SUBT_OP removed by Beckman*/ -#define CONST_DECL 1018 /* to be modify */ -#define ABS_EXPR 1019 -#define BIT_NOT_EXPR BIT_COMPLEMENT_OP -#define NEGATE_EXPR MINUS_OP -#define TRUTH_ANDIF_EXPR 1020 -#define TRUTH_AND_EXPR 1021 -#define TRUTH_NOT_EXPR 1022 -#define TRUTH_ORIF_EXPR 1023 -#define POSTINCREMENT_EXPR PLUSPLUS_OP -#define PREINCREMENT_EXPR 1024 -#define PREDECREMENT_EXPR 1025 -#define COMPOUND_EXPR 1026 -#define ENUMERAL_TYPE T_ENUM -#define FLOAT_EXPR 1027 -/*#define RSHIFT_EXPR RSHIFT_OP - #define LSHIFT_EXPR LSHIFT_OP removed by Pete Beckman*/ -/* #define BIT_IOR_EXPR 1028 killed by dbg because in rid enum*/ -/* #define BIT_XOR_EXPR 1029 killed by dbg because in rid enum*/ -#define BIT_ANDTC_EXPR 1030 -#define ERROR_MARK NULL -#define TRUTH_OR_EXPR 1031 -#define FIX_TRUNC_EXPR 1032 -#define RROTATE_EXPR 1033 -#define LROTATE_EXPR 1034 -#define RANGE_EXPR 1035 -#define POSTDECREMENT_EXPR 1036 -#define COMPONENT_REF RECORD_REF /* NODE SYMB define for this node */ -#define INDIRECT_REF DEREF_OP -#define REFERENCE_TYPE 1037 -/* #define CONSTRUCTOR 1038*/ -#define FIX_FLOOR_EXPR 1039 -#define FIX_ROUND_EXPR 1040 -#define FIX_CEIL_EXPR 1041 -#define FUNCTION_DECL 1042 -#define MODIFY_EXPR 1043 -#define REFERENCE_EXPR 1044 -#define RESULT_DECL 1045 -#define PARM_DECL 1046 /* not used */ -#define CALL_EXPR 1047 -#define INIT_EXPR 1048 - - -/* other type for type node */ -#define T_LITERAL 1100 /* not use */ -#define T_SIZE 1101 -#define LAST_CODE T_SIZE -/* end other type of node */ - -/* definition for project */ - -#define PROJ_FIRST_SYMB() (pointer_on_file_proj->head_symb) -#define PROJ_FIRST_TYPE() (pointer_on_file_proj->head_type) -#define PROJ_FIRST_LLND() (pointer_on_file_proj->head_llnd) -#define PROJ_FIRST_BIF() (pointer_on_file_proj->head_bfnd) -#define PROJ_FIRST_CMNT() (pointer_on_file_proj->head_cmnt) -#define PROJ_FIRST_LABEL() (pointer_on_file_proj->head_lab) - -#define CUR_FILE_NUM_BIFS() (pointer_on_file_proj->num_bfnds) -#define CUR_FILE_NUM_LLNDS() (pointer_on_file_proj->num_llnds) -#define CUR_FILE_NUM_SYMBS() (pointer_on_file_proj->num_symbs) -#define CUR_FILE_NUM_TYPES() (pointer_on_file_proj->num_types) -#define CUR_FILE_NUM_LABEL() (pointer_on_file_proj->num_label) -#define CUR_FILE_NUM_BLOBS() (pointer_on_file_proj->num_blobs) -#define CUR_FILE_NUM_CMNT() (pointer_on_file_proj->num_cmnt) -#define CUR_FILE_CUR_BFND() (pointer_on_file_proj->cur_bfnd) -#define CUR_FILE_CUR_LLND() (pointer_on_file_proj->cur_llnd) -#define CUR_FILE_CUR_SYMB() (pointer_on_file_proj->cur_symb) -#define CUR_FILE_CUR_TYPE() (pointer_on_file_proj->cur_type) -#define CUR_FILE_GLOBAL_BFND() (pointer_on_file_proj->global_bfnd) -#define CUR_FILE_NAME() (pointer_on_file_proj->filename) -#define CUR_FILE_HEAD_FILE() (pointer_on_file_proj->head_file) - - -#define FILE_GLOBAL_BFND(FIL) ((FIL)->global_bfnd) -#define FILE_FILENAME(FIL) ((FIL)->filename) -#define FILE_LANGUAGE(FIL) ((FIL)->lang) - - -#define CUR_PROJ_FILE_CHAIN() (cur_proj->file_chain) /* modified by Pete */ -#define CUR_PROJ_NAME() (cur_proj->proj_name) /* modified by Pete */ - -#define PROJ_FILE_CHAIN(PROJ) ((PROJ)->file_chain) - -/* use as a general pointer */ - -typedef char *POINTER; -enum typenode { BIFNODE, LLNODE, SYMBNODE, TYPENODE, BLOBNODE, - BLOB1NODE, LABEL, FILENODE}; //add LABEL (Kataev 21.03.2013), FILE (Kataev 15.07.2013 - - -#define MAXTILE 10 /* nombre maximum de boucle que l'on peut tiler */ -#define MAX_STMT 100 /* nombre d'instruction d'une boucle */ - - -/**************** For Comment Nodes *****************************/ - - -#define CMNT_ID(NODE) ((NODE)->id) -#define CMNT_TYPE(NODE) ((NODE)->type) -#define CMNT_STRING(NODE) ((NODE)->string) -#define CMNT_NEXT(NODE) ((NODE)->thread) -#define CMNT_NEXT_ATTACH(NODE) ((NODE)->next) - - -/**************** For LABEL NODES *****************************/ - -#define LABEL_ID(NODE) ((NODE)->id) -#define LABEL_NEXT(NODE) ((NODE)->next) -#define LABEL_UD_CHAIN(NODE) ((NODE)->ud_chain) -#define LABEL_USED(NODE) ((NODE)->labused) -#define LABEL_ILLEGAL(NODE) ((NODE)->labinacc) -#define LABEL_DEFINED(NODE) ((NODE)->labdefined) -#define LABEL_SCOPE(NODE) ((NODE)->scope) -#define LABEL_BODY(NODE) ((NODE)->statbody) -#define LABEL_SYMB(NODE) ((NODE)->label_name) -#define LABEL_TYPE(NODE) ((NODE)->labtype) -#define LABEL_STMTNO(NODE) ((NODE)->stateno) - - -/**************** Misceallous ***********************************/ - -#define LABEL_KIND 100000 /* bigger than the variant of all kind of node*/ -#define BLOB_KIND 100001 -#define CMNT_KIND 100002 - -/************** For Sets Node ********************************/ - -#define SETS_GEN(NODE) ((NODE)->gen) -#define SETS_INDEF(NODE) ((NODE)->in_def) -#define SETS_USE(NODE) ((NODE)->use) -#define SETS_INUSE(NODE) ((NODE)->in_use) -#define SETS_OUTDEF(NODE) ((NODE)->out_def) -#define SETS_OUTUSE(NODE) ((NODE)->out_use) -#define SETS_ARRAYEF(NODE) ((NODE)->arefl) - -#define SETS_REFL_SYMB(NODE) ((NODE)->id) -#define SETS_REFL_NEXT(NODE) ((NODE)->next) -#define SETS_REFL_NODE(NODE) ((NODE)->node) -#define SETS_REFL_REF(NODE) ((NODE)->node->refer) -#define SETS_REFL_STMT(NODE) ((NODE)->node->stmt) - -/************** For HASH NODE ********************************/ -#define HASH_IDENT(NODE) ((NODE)->ident) - -/************** For Special malloc ********************************/ - - -/* pour la gestion memoire */ -struct chaining -{ - char *zone; - struct chaining *list; -}; - -typedef struct chaining *ptchaining; -struct stack_chaining -{ - ptchaining first; - ptchaining last; - struct stack_chaining *prev; - struct stack_chaining *next; - int level; -}; -typedef struct stack_chaining *ptstack_chaining; diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++callgraph.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++callgraph.h deleted file mode 100644 index 1e20c10..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++callgraph.h +++ /dev/null @@ -1,123 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/*******************************************************************/ -/* A class for creating a static call tree for C++ and pC++ */ -/* functions. usage: */ -/* include "sage++user.h" */ -/* include "sage++callgraph.h" */ -/* main(){ */ -/* SgProject project("myfile") */ -/* SgCallGraph CG; */ -/* Cg.GenCallTree(&(project->file(0))); */ -/* CG.computeClosures(); */ -/* the object then contains call info for that file. */ -/* see the public functions for data that can be extracted */ -/*******************************************************************/ -#define SGMOE_FUN 1 -#define SGNORMAL_FUN 0 -#define SGMOC_FUN 2 -#define SGMAX_HASH 541 - -class SgCallGraphFunRec; - -typedef struct _SgCallSiteList{ - SgStatement *stmt; - SgExpression *expr; - struct _SgCallSiteList *next; -}SgCallSiteList; - -typedef struct _SgCallGraphFunRecList{ - SgStatement *stmt; - SgExpression *expr; - SgCallGraphFunRec *fr; - struct _SgCallGraphFunRecList *next; -}SgCallGraphFunRecList; - -class SgCallGraphFunRec{ - public: - int type; // either moe, normal or moc. - SgStatement *body; - SgCallSiteList *callSites; // pointer to tail of circular linked list - SgSymbol *s; - int Num_Call_Sites; - SgCallGraphFunRecList *callList; // pointer to tail of circular linked list - int Num_Call_List; - int isCollection; // = 1 if this is a method of a collection - int calledInPar; // = 1 if called in a parallel section - int calledInSeq; // = 1 if called in sequentail main thread - SgSymbol *className; // for member functions. - int flag; // used for traversals. - - int id; // serial number - SgCallGraphFunRec *next; // used for linked list - SgCallGraphFunRec *next_hash; // used for hash table collisions - // used for next* functions - SgCallSiteList *currentCallSite; - SgCallSiteList *currentCallExpr; - SgCallGraphFunRecList *currentFunCall; -}; - -class SgCallGraph{ - - public: - SgCallGraph(void) {}; // constructor - void GenCallTree(SgFile *); // initialize and build the call tree - void printFunctionEntry(SgSymbol *fname); // print info about fname - int numberOfFunctionsInGraph(); // number of functions in the table. - int numberOfCallSites(SgSymbol *fname); // number of call sites for funame - int numberOfFunsCalledFrom(SgSymbol *fname); // how many call sites in fname - - int isAMethodOfElement(SgSymbol* fname); // 1 if fname is a method of an element of a coll. - int isACollectionFunc(SgSymbol* fname); // 1 if fname is a method of a collection (not MOE) - int isCalledInSeq(SgSymbol* fname); // 1 if fname is called in a sequential sect. - int isCalledInPar(SgSymbol* fname); // 1 if fname is called in parallel code - void computeClosures(); - - SgSymbol *firstFunction(); // first function in callgraph - SgSymbol *nextFunction(); // next function in callgraph - int functionId(SgSymbol *fname); // id of fname - SgStatement *functionBody(SgSymbol *fname); // body of fname - SgStatement *firstCallSiteStmt(SgSymbol *fname); // stmt of first call of fname - SgStatement *nextCallSiteStmt(SgSymbol *fname); // stmt of next call of fname - SgExpression *firstCallSiteExpr(SgSymbol *fname); // expression of first call - SgExpression *nextCallSiteExpr(SgSymbol *fname); // expression of next call - SgSymbol *firstCalledFunction(SgSymbol *fname); // first function called in fname - SgSymbol *nextCalledFunction(SgSymbol *fname); // next function called in fname - SgStatement *SgCalledFunctionStmt(SgSymbol *fname); // get statement of current called function - SgExpression *SgCalledFunctionExpr(SgSymbol *fname); // get expression of current called function - - // obsolete functions: - SgSymbol *function(int i); // i-th function in table (0 = first) - SgStatement *functionBody(int i); // i-th function in table (0 = first) - void printTableEntry(int); // print the i-th table entry. - - SgStatement *callSiteStmt(SgSymbol *fname, int i); // stmt of i-th call of fname - SgExpression *callSiteExpr(SgSymbol *fname, int i); // expression of i-th call - SgSymbol *calledFunction(SgSymbol *fname, int i); // i-th function called in fname - // end obsolete - protected: - SgCallGraphFunRec *FunListHead; - int num_funs_in_table; - SgCallGraphFunRec *hash_table[SGMAX_HASH]; - SgCallGraphFunRec *locateFunctionInTable(SgSymbol *); - SgCallGraphFunRec *lookForFunctionOpForClass(SgSymbol *); - void updateFunctionTableConnections(SgCallGraphFunRec *, SgStatement *, SgExpression *); - void findFunctionCalls(SgStatement *, SgExpression *); - void init(); - - void insertInHashTable(SgSymbol *, SgCallGraphFunRec *); - unsigned long int hashSymbol(SgSymbol *); - SgCallGraphFunRec *currentFun; -}; - -SgType *findTrueType(SgExpression *); -SgType *makeReducedType(SgType *); - SgSymbol *firstFunction(); - SgSymbol *nextFunction(); - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h deleted file mode 100644 index caf7fe2..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h +++ /dev/null @@ -1,216 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -// ---------------------------------- -// Darryl Brown -// University of Oregon pC++/Sage++ -// -// sage++classhierarchy.h - the header file for the class classHierarchy. -// -// a class(es) for inspecting the class hierarchy -// of a sage++ project. -// -// ---------------------------------- - -// ---------------------------------- -// To traverse the hierarcy of classes, the most obvious approach is -// in the following example. This example searches the tree for a given -// class name and a hierarchy to search. Note that this searches the whole -// tree, not just the immediate children. -// -// classHierarchy *findHierarchy(char *name, classHierarchy *h) { -// classHierarchy *tmp, *depth; -// -// // initialize searchlist of hierarchy immediate children...; -// // this returns the first hierarchy in the child list...; -// tmp = (classHierarchy *) h->children->searchList(); -// -// while (tmp) { -// -// // if they are the same, return the current hierarchy...; -// if (strcmp(name, tmp->className) == 0) { -// return tmp; -// } else { -// // search tmps children recursively, if not NULL, return that value...; -// if (depth = findHierarchy(name, tmp)) { -// return depth; -// } -// } -// // get next item in list; -// tmp = (classHierarchy *) h->children->nextItem(); -// } -// // if weve made it to here, it is not anywhere in the hierarchy, -// // so return NULL; -// return NULL; -// } -// -// ------------------------------------------------------- -// There is also a list of the classMembers for each class. To traverse -// that list, it is very similar, but more simple than the above example. -// Here is an example of printing out each class member of a specific -// member type (e.g. public function). -// -// virtual void printMemberType(memberType mt, classHierarchy *h) { -// classMember *tmp; -// -// tmp = (classMember *) h->classMembers->searchList(); -// -// while (tmp) { -// if (tmp->typeVariant == mt) { -// tmp->print(); -// } -// tmp = (classMember *) h->classMembers->nextItem(); -// } -// } -// - - -// ------------------------------------------------------------- -// Forward declarations; -// -class relationList; - -// ------------------------------------------------------------- -// Extern declarations -// -// -extern int strToType(char *s); -extern char *typeToStr(int ty); - - -// -------------------- -// type of class members...; -typedef enum { - UNKNOWN_FUNC, - PRIVATE_FUNC, - PUBLIC_FUNC, - PROTECTED_FUNC, - ELEMENT_FUNC, - UNKNOWN_VAR, - PRIVATE_VAR, - PUBLIC_VAR, - PROTECTED_VAR, - ELEMENT_VAR - } memberType; - -// ------------------------------------------------------------- -// the main class for accessing the class hierarchy within a sage++ -// file. -class classHierarchy : public brk_basePtr { - - private: - - // private functions - virtual classHierarchy *findClassHierarchy(char *cl); - //returns the hierarchy of the class with className cl; - classHierarchy *pushOnTop(SgClassStmt *clSt); - // creates a new hierarchy for clSt (a class declarative statement); - // and puts it at the highest level of the hierarchy (exclusively ; - // for classes with no superclasses) ; - virtual classHierarchy * storeInClassHierarchy (SgClassStmt *clSt); - // creates a new hierarchy for the class declarative statement clSt; - // and stores it where it fits in the hierarchy of classes. It makes - // use of the above two functions pushOnTop and findHierarchy.; - void determineMembers(SgFile *aFile); - // finds all members in a class, initializing publicVars, protectedVars, - // privateVars, publicFuncs, protectedFuncs, and privateFuncs; - void allocateLists(); - // allocates new relationList instances for member fields.; - - public: - - // members; - relationList *parents; // linked list of parents ; - relationList *children; // linked list of children ; - relationList *classMembers; // linked list of class vars and funcs ; - char *className; // contains the class name ; - SgSymbol *classSymbol; // contains the Sage symbol for the name; - SgClassStmt *declaration; // contains the Sage declaration of the class; - - // constructors; - classHierarchy(void); - classHierarchy(char * cn); - classHierarchy(SgSymbol * cs); - classHierarchy(SgClassStmt * clSt); - - // access functions; - virtual void print(int tabs); // prints out this class after tabs.; - virtual void print(); // prints out this class after 0 tabs.; - virtual void printAll(int tabs); - // prints out this class after tabs, as well as all descendants; - virtual void printAllCollections(int tabs); - // prints out this class if it is a collection ; - // after tabs, as well as all descendants; - virtual void printAll(); - // prints out this class after 0 tabs, as well as all descendants; - virtual void printMemberType(memberType mt); - // prints out all member field/functions of type mt; - classHierarchy *findMember (brk_basePtr *); // look for this element and - // return the ptrNode that points to it; - int numParents(); // returns the number of parents; - int numChildren(); // returns the number of children ; - void determineClassHierarchy(SgFile *aFile); - // finds all classes in a file and stores them in a hierarchy. It makes - // use of private functions. Typically, this is the only necessary - // function to call when trying to find out a class hierarchy for a file. - int numberOfDescendants (void); - // returns the total number of all descendants; - int numberOfParents (void); - // returns the number of parents of this class; - int numberOfChildren (void); - // returns the number of direct children of this class; - int isCollection(); - // returns true if it is a collection, false if not a collection, - // or if it is not known.; - char *fileName(); // returns file name where this class is defined if known, - // NULL if not known.; - int lineNumber(); // returns line number where this class is defined if known, - // -1 if not known.; - virtual int compare(brk_basePtr *); - // compares this heirarchy with another alphabetically using className; - void sort (); // sorts the list, elements must have compare function.,; - void sort(int (* compareFunc) (brk_basePtr *, brk_basePtr *)); - -}; - -// ------------------------------------------------------------- -// the class implementing the linked list for -class relationList : public brk_linkedList { - - public: - - // constructor; - relationList(); - - // access functions; - virtual void printAll(int tNum); // print all elements in list preceded by - // tNum tabs AND print all descendants, incrementing tNum with each - // generation; - virtual void printAll(); // as above, with tNum = 0; -}; - - -// -------------------------------------------------------------; -// For class variables & functions..; -class classMember : public brk_basePtr { - - public: - - // class vars - memberType typeVariant; - SgStatement * declaration; - SgSymbol * symbol; - char * name; - char * typeOf; - SgType *memType; - - // access functions - classMember(SgSymbol *sym, memberType tv); - classMember(SgStatement *decl, memberType tv); - virtual void print(); - virtual void print(int); -}; - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++extern.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++extern.h deleted file mode 100644 index ebfa275..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++extern.h +++ /dev/null @@ -1,34 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -extern void **tablebfnd[]; -extern void **tablellnd[]; -extern void **tabletype[]; -extern void **tablesymbol[]; -extern void **tablelabel[]; - -extern int numtablebfnd[]; -extern int numtablellnd[]; -extern int numtabletype[]; -extern int numtablesymbol[]; -extern int numtablelabel[]; - - -extern void **fileTableClass; -extern int allocatedForfileTableClass; -extern void **bfndTableClass; -extern int allocatedForbfndTableClass; -extern void **llndTableClass; -extern int allocatedForllndTableClass; -extern void **typeTableClass; -extern int allocatedFortypeTableClass; -extern void **symbolTableClass; -extern int allocatedForsymbolTableClass; -extern void **labelTableClass; -extern int allocatedForlabelTableClass; - -extern SgProject *CurrentProject; - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++proto.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++proto.h deleted file mode 100644 index 39ade30..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++proto.h +++ /dev/null @@ -1,40 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - -void SwitchToFile(int i); -void ReallocatefileTableClass(); -void ReallocatebfndTableClass(); -void ResetbfndTableClass(); -void ReallocatellndTableClass(); -void ReallocatesymbolTableClass(); -void ReallocatelabelTableClass(); -void ReallocatetypeTableClass(); -void RemoveFromTableType(void * pt); -void RemoveFromTableSymb(void * pt); -void RemoveFromTableBfnd(void * pt); -void RemoveFromTableFile(void * pt); -void RemoveFromTableLlnd(void * pt); -void RemoveFromTableLabel(void * pt); -void SetMappingInTableForBfnd(PTR_BFND bif, void *pt); -void SetMappingInTableForType(PTR_TYPE type, void *pt); -void SetMappingInTableForSymb(PTR_SYMB symb, void *pt); -void SetMappingInTableForLabel(PTR_LABEL lab, void *pt); -void SetMappingInTableForLlnd(PTR_LLND ll, void *pt); -void SetMappingInTableForFile(PTR_FILE file, void *pt); -SgSymbol *GetMappingInTableForSymbol(PTR_SYMB symb); -SgLabel *GetMappingInTableForLabel(PTR_LABEL lab); -SgStatement *GetMappingInTableForBfnd(PTR_BFND bf); -SgStatement *GetMappingInTableForBfnd(PTR_BFND bf); -SgType *GetMappingInTableForType(PTR_TYPE t); -SgExpression *GetMappingInTableForLlnd(PTR_LLND ll); -SgFile *GetMappingInTableForFile(PTR_FILE file); -SgStatement * BfndMapping(PTR_BFND bif); -SgExpression * LlndMapping(PTR_LLND llin); -SgSymbol * SymbMapping(PTR_SYMB symb); -SgType * TypeMapping(PTR_TYPE ty); -SgLabel * LabelMapping(PTR_LABEL label); - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++user.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++user.h deleted file mode 100644 index 2ccd555..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/sage++user.h +++ /dev/null @@ -1,45 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -#ifndef SAGEXXUSER_H -#define SAGEXXUSER_H 1 - -#include "macro.h" - -// For C/C++ parser internals -#include "vpc.h" - -// For the fortran parser internals -#include "f90.h" - -// All the "C" functions from the Rennes toolbox -#include "extcxx_low.h" - -class SgProject; -class SgFile; -class SgStatement; -class SgExpression; -class SgLabel; -class SgSymbol; -class SgType; -class SgUnaryExp; -class SgClassSymb; -class SgVarDeclStmt; -class SgVarRefExp; /* ajm: I think they should all be here! @$!@ */ - -// All the externs (from libSage++.C) used in libSage++.h -#include "sage++extern.h" - -#define SORRY Message("Sorry, not implemented yet",0) - -// Prototype definitions for all the functions in libSage++.C -#include "sage++proto.h" - - -// dont delete needed in libSage++.h -#define USER -#include "libSage++.h" - -#endif /* ndef SAGEXXUSER_H */ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/symb.def b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/symb.def deleted file mode 100644 index df72b8b..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/symb.def +++ /dev/null @@ -1,30 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -DEFNODECODE(BIF_PARM_DECL,'_','_','_','_','_') -DEFNODECODE(CONST_NAME,'_','_','_','_','_') -DEFNODECODE(ENUM_NAME,'_','_','_','_','_') -DEFNODECODE(FIELD_NAME,'_','_','_','_','_') -DEFNODECODE(VARIABLE_NAME,'_','_','_','_','_') -DEFNODECODE(TYPE_NAME,'_','_','_','_','_') -DEFNODECODE(PROGRAM_NAME,'_','_','_','_','_') -DEFNODECODE(PROCEDURE_NAME,'_','_','_','_','_') -DEFNODECODE(PROCESS_NAME,'_','_','_','_','_') -DEFNODECODE(VAR_FIELD,'_','_','_','_','_') -DEFNODECODE(LABEL_VAR,'_','_','_','_','_') -DEFNODECODE(FUNCTION_NAME,'_','_','_','_','_') -DEFNODECODE(MEMBER_FUNC,'_','_','_','_','_') -DEFNODECODE(CLASS_NAME,'_','_','_','_','_') -DEFNODECODE(TECLASS_NAME,'_','_','_','_','_') -DEFNODECODE(UNION_NAME,'_','_','_','_','_') -DEFNODECODE(STRUCT_NAME,'_','_','_','_','_') -DEFNODECODE(LABEL_NAME,'_','_','_','_','_') -DEFNODECODE(COLLECTION_NAME,'_','_','_','_','_') -DEFNODECODE(ROUTINE_NAME,'_','_','_','_','_') -DEFNODECODE(CONSTRUCT_NAME,'_','_','_','_','_') -DEFNODECODE(INTERFACE_NAME,'_','_','_','_','_') -DEFNODECODE(MODULE_NAME,'_','_','_','_','_') -DEFNODECODE(COMMON_NAME,'_','_','_','_','_') - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/type.def b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/type.def deleted file mode 100644 index f7534e4..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/type.def +++ /dev/null @@ -1,69 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* format is the following variant 'a'|'s'|'u'|'t'|'e'|'p'|'d'|'D'|'_', - 's'|'_', 'b'|'_','c'|'C'|'_', 'f'|'_' - - _ stands for no ------------------------ - a stands for atomic type (T_INT and so on) - u stands for union - t stands for array - s stands for structure (first field structure) - e stands for enumeration - p stands for pointer or reference - d stands for derived - D stands for descript type ------------------- - s stands for symbol ------------------- - b stands for bastype ------------------- - c stands for class type - C stand for collection type ------------------- - f stands have a list of fields (should go to symbol also) - -*/ -DEFNODECODE(DEFAULT, 'a','_','_','_','_') -DEFNODECODE(T_INT, 'a','_','_','_','_') -DEFNODECODE(T_FLOAT, 'a','_','_','_','_') -DEFNODECODE(T_DOUBLE, 'a','_','_','_','_') -DEFNODECODE(T_CHAR, 'a','_','_','_','_') -DEFNODECODE(T_BOOL, 'a','_','_','_','_') -DEFNODECODE(T_STRING, 'a','_','_','_','_') -DEFNODECODE(T_COMPLEX, 'a','_','_','_','_') -DEFNODECODE(T_DCOMPLEX, 'a','_','_','_','_') -DEFNODECODE(T_GATE, 'a','_','_','_','_') -DEFNODECODE(T_EVENT, 'a','_','_','_','_') -DEFNODECODE(T_SEQUENCE, 'a','_','_','_','_') - -DEFNODECODE(T_ENUM, 'e','_','_','_','f') -DEFNODECODE(T_SUBRANGE, '_','_','_','_','_') -DEFNODECODE(T_LIST, '_','_','_','_','_') -DEFNODECODE(T_ARRAY, 't','_','b','_','_') -DEFNODECODE(T_RECORD, 's','_','_','_','f') -DEFNODECODE(T_ENUM_FIELD, '_','_','_','_','_') -DEFNODECODE(T_UNKNOWN, 'a','_','_','_','_') -DEFNODECODE(T_VOID, 'a','_','_','_','_') -DEFNODECODE(T_DESCRIPT, 'D','_','b','_','_') -DEFNODECODE(T_FUNCTION, '_','_','b','_','_') -DEFNODECODE(T_POINTER, 'p','_','b','_','_') -DEFNODECODE(T_UNION, 'u','_','_','_','f') -DEFNODECODE(T_STRUCT, 's','_','_','_','f') -DEFNODECODE(T_CLASS, 's','_','_','_','f') -DEFNODECODE(T_TECLASS, 's','_','_','_','f') -DEFNODECODE(T_DERIVED_CLASS, 'd','s','_','_','_') -DEFNODECODE(T_DERIVED_TYPE, 'd','s','_','_','_') -DEFNODECODE(T_COLLECTION, 's','_','_','_','f') -DEFNODECODE(T_DERIVED_COLLECTION, 'd','s','_','_','_') -DEFNODECODE(T_DERIVED_TEMPLATE, 'd','s','_','_','_') -DEFNODECODE(T_REFERENCE, 'p','_','b','_','_') - -DEFNODECODE(LOCAL, '_','_','_','_','_') -DEFNODECODE(INPUT, '_','_','_','_','_') -DEFNODECODE(OUTPUT, '_','_','_','_','_') -DEFNODECODE(IO, '_','_','_','_','_') - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparse.def b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparse.def deleted file mode 100644 index 8cd382d..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparse.def +++ /dev/null @@ -1,1060 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/*****************************************************************************/ -/*****************************************************************************/ -/***** *****/ -/***** UNPARSE.DEF: Gregory HOGDAL / Eric MARCHAND July 1992 *****/ -/***** Bodin Francois August 1992 *****/ -/***** *****/ -/*****************************************************************************/ -/*****************************************************************************/ - -/* - The following types exist: BIFNODE, LLNODE, SYMBNODE and TYPENODE - - Any erroneous construct is parsed into a node of this type. - This type of node is accepted without complaint in all contexts - by later parsing activities, to avoid multiple error messages - for one error. - No fields in these nodes are used except the NODE_CODE. -*/ - -/* exemple -DEFNODECODE (ERROR_MARK, "error_mark", "x", 0, LLNODE) -*/ - -/***** List of commands for BIF NODES *****/ - /* %ERROR : Error ; syntax : %ERROR'message' */ - /* %CMNT : the comment attached to a bif node */ - /* %NL : NewLine */ - /* %% : '%' (Percent Sign) */ - /* %TAB : Tab */ - /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - /* %ELSE : Else */ - /* %ENDIF : End of If */ - /* %SYMBID : Symbol identifier */ - /* %LL1 : Low Level Node 1 */ - /* %LL2 : Low Level Node 2 */ - /* %LL3 : Low Level Node 3 */ - /* %L2L2 : Low Level Node 2 of Low Level Node 2 */ - /* %BLOB1 : All Blob 1 */ - /* %BLOB2 : All Blob 2 */ - /* %STATENO : Statement number */ - /* %L1SYMBID : pbf->entry.Template.ll_ptr1->entry.Template.symbol->ident; */ - /* %INWRITEON : In_Write_Statement Flag ON */ - /* %INWRITEOFF : In_Write_Statement Flag OFF */ - /* %INPARAMON : In_Param_Statement Flag ON */ - /* %INPARAMOFF : In_Param_Statement Flag OFF */ - /* %INIMPLION : In_Impli_Statement Flag ON */ - /* %INIMPLIOFF : In_Impli_Statement Flag OFF */ - /* SYMBTYPE : Type of Symbol */ - /* %VARLIST : list of variables / parameters */ -/******************************************/ - -/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for BIF NODE *****/ - /* %RECURSBIT : int constant RECURSIVE_BIT (integer) */ - /* %EXPR_LIST : int constant EXPR_LIST code for Low Level Node (integer) */ - /* %SPEC_PAIR : int constant SPEC_PAIR code for Low Level Node (integer) */ - /* %IOACCESS : int constant IOACCESS code for Low Level Node (integer) */ - /* %SATTR : Symbol Attribut (integer) */ - /* %STRCST : String Constant in '' */ - /* %SYMBID : Symbol Identifier (string) */ - /* %SYMBOL : Symbol node (integer) */ - /* == : Equal (operation) */ - /* != : Different (operation) */ - /* %NULL : 0, Integer Constant (or false boolean) */ - /* %LL1 : Low Level Node 1 (integer) */ - /* %LL2 : Low Level Node 2 (integer) */ - /* %LL3 : Low Level Node 3 (integer) */ - /* %LABUSE : Label ptr (do end) (integer) */ - /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ - /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ - /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ - /* %L1L2*L1CODE : Code (variant) of Low Level Node 1 of (Low Level Node 2)* of Low Level Node 1 (integer) follow L2*/ - /* %L2L1STR : String (string_val) of Low Level Node 1 of Low Level Node 2 (string) */ -/*****************************************************************************************/ - -/* -DEFNODECODE(GLOBAL, "%CMNT%SETFLAG(QUOTE)%INCTAB%BLOB1%DECTAB%UNSETFLAG(QUOTE)", -'s',0,BIFNODE) -*/ -DEFNODECODE(GLOBAL, "%CMNT%SETFLAG(QUOTE)%BLOB1%UNSETFLAG(QUOTE)", -'s',0,BIFNODE) - -DEFNODECODE(PROG_HEDR, "%CMNT%IF(%SYMBID != %STRCST'_MAIN')%PUTTABprogram %SYMBID%NL%ENDIF%BLOB1", -'s',0,BIFNODE) -DEFNODECODE(PROC_HEDR, "%CMNT%PUTTAB%IF(%LL3 != %NULL)%LL3 %ENDIFsubroutine %SYMBID (%VARLIST)%NL%BLOB1", -'s',0,BIFNODE) -DEFNODECODE(PROS_HEDR, "%CMNT%PUTTAB%IF(%LL3 != %NULL)%LL3 %ENDIFsubroutine %SYMBID (%LL1)%NL%BLOB1", -'s',0,BIFNODE) -/*DEFNODECODE(PROS_HEDR, "%CMNT%PUTTABprocess %SYMBID (%VARLIST)%NL%BLOB1", -'s',0,BIFNODE) */ -DEFNODECODE(BASIC_BLOCK, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(PROCESSES_STAT, "%CMNT%PUTTABprocesses%NL%INCTAB%BLOB1", -'s',0,BIFNODE) -DEFNODECODE(INPORT_DECL, "%CMNT%PUTTABinport (%LL2) %LL1%NL", -'s',2,BIFNODE) -DEFNODECODE(OUTPORT_DECL, "%CMNT%PUTTABoutport (%LL2) %LL1%NL", -'s',2,BIFNODE) -DEFNODECODE(CHANNEL_STAT, "%CMNT%PUTTABchannel(%LL1)%NL", -'s',1,BIFNODE) -DEFNODECODE(MERGER_STAT, "%CMNT%PUTTABmerger(%LL1)%NL", -'s',1,BIFNODE) -DEFNODECODE(MOVE_PORT, "%CMNT%PUTTABmoveport(%LL1)%NL", -'s',1,BIFNODE) -DEFNODECODE(SEND_STAT, "%CMNT%PUTTABsend%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT) %IF ( %LL2 != %NULL )%LL2%NL", -'s',2,BIFNODE) -DEFNODECODE(RECEIVE_STAT, "%CMNT%PUTTABreceive%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT) %IF ( %LL2 != %NULL )%LL2%NL", -'s',2,BIFNODE) -DEFNODECODE(ENDCHANNEL_STAT, "%CMNT%PUTTABendchannel%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT)%NL", -'s',1,BIFNODE) -DEFNODECODE(PROBE_STAT, "%CMNT%PUTTABprobe%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT)%NL", -'s',1,BIFNODE) -DEFNODECODE(INTENT_STMT, "%CMNT%PUTTAB%LL2 %LL1%NL", -'s',2,BIFNODE) -DEFNODECODE(ALLOCATE_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABallocate(%LL1%IF(%LL2 != %NULL), %LL2%ENDIF)%NL", -'s',0,BIFNODE) -DEFNODECODE(DEALLOCATE_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABdeallocate(%LL1%IF(%LL2 != %NULL), %LL2%ENDIF)%NL", -'s',0,BIFNODE) -DEFNODECODE(NULLIFY_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABnullify(%LL1)%NL", -'s',0,BIFNODE) - -/* 107 is value for FOR_NODE -DEFNODECODE(CONTROL_END, "%CMNT%IF ( %VALINT107 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABenddo %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT102 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%NL%ENDIF%IF ( %VALINT101 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%ENDIF%IF ( %VALINT130 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%NL%ENDIF%IF ( %VALINT124 == %BIFCP)%DECTAB%PUTTABenddo%INCTAB%NL%ENDIF", -'s',0,BIFNODE) */ - -DEFNODECODE(CONTROL_END, "%CMNT%IF ( %VALINT107 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABenddo %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT102 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%IF ( %VALINT100 != %CPBIF) subroutine %SYMBID%ELSE%NL%ENDIF%NL%ENDIF%IF ( %VALINT101 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%NL%ENDIF%IF ( %VALINT130 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%IF ( %VALINT100 != %CPBIF) function %SYMBID%ELSE%NL%ENDIF%NL%ENDIF%IF ( %VALINT124 == %BIFCP)%DECTAB%PUTTABenddo%INCTAB%NL%ENDIF%IF ( %VALINT109 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABenddo %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT285 == %BIFCP)%DECTAB%PUTTABendprocessdo%INCTAB%NL%ENDIF%IF ( %VALINT279 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABend subroutine%NL%NL%NL%ENDIF%IF ( %VALINT175 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABend select %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT108 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABend forall %SYMBID%INCTAB%NL%ENDIF%IF (%VALINT105 == %BIFCP)%SAVENAME%ENDIF%IF (%VALINT137 == %BIFCP)%SAVENAME%ENDIF%IF (%VALINT194 == %BIFCP)%SAVENAME%ENDIF%IF (%VALINT264 == %BIFCP)%SAVENAME%ENDIF", - 's',0,BIFNODE) -DEFNODECODE(PROCESSES_END, "%CMNT%DECTAB%PUTTABendprocesses%NL", - 's',0,BIFNODE) -DEFNODECODE(IF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF(%LL3 != %NULL)%LL3: %ENDIFif (%LL1) then%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSIFBLOB2 == %NULL)%PUTTABelse %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendif %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendif %CNTRNAME%NL%ENDIF", -'s',0,BIFNODE) -DEFNODECODE(WHERE_BLOCK_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF(%LL3 != %NULL)%LL3: %ENDIFwhere (%LL1)%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSWHBLOB2 == %NULL)%PUTTABelsewhere %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ENDIF", -'s',0,BIFNODE) -DEFNODECODE(ARITHIF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABif (%LL1) %LL2%NL", -'s',0,BIFNODE) -DEFNODECODE(LOGIF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABif (%LL1) %TABOFF%BLOB1%TABON", -'s',0,BIFNODE) -DEFNODECODE(FORALL_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABforall (%LL1%IF(%LL2 != %NULL), %LL2%ENDIF) %TABOFF%BLOB1%TABON", -'s',0,BIFNODE) -DEFNODECODE(LOOP_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(FOR_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIF%INIMPLIOFF%INWRITEOFF%SETFLAG(LOOP)do %IF (%LABUSE != %NULL)%STATENO%ENDIF %SYMBID = %LL1%IF (%LL2 != %NULL),%LL2%ENDIF%INCTAB%NL%UNSETFLAG(LOOP)%BLOB1%DECTAB", -'s',0,BIFNODE) - - /* previously : for %SYMBID = %LL1 %NL %INCTAB%BLOB1%DECTAB enddo%NL",*/ -DEFNODECODE(PROCESS_DO_STAT, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 !=%NULL)%LL3: %ENDIF%INIMPLIOFF%INWRITEOFF%SETFLAG(LOOP)processdo %IF (%LABUSE !=%NULL)%STATENO%ENDIF %SYMBID = %LL1%IF (%LL2 !=%NULL),%LL2%ENDIF%INCTAB%NL%UNSETFLAG(LOOP)%BLOB1%DECTAB", -'s',2,BIFNODE) - -/* wrong -DEFNODECODE(WHILE_NODE, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3:%ENDIFdo %IF (%LABUSE !=%NULL)%STATENO%ENDIF while (%LL1)%NL", 's',0,BIFNODE) -*/ -DEFNODECODE(WHILE_NODE, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIFdo %IF (%LABUSE !=%NULL)%STATENO %ENDIF%IF(%LL1 != %NULL)while (%LL1)%ENDIF%NL%INCTAB%BLOB1%DECTAB", -'s',0,BIFNODE) -DEFNODECODE(FORALL_NODE, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIFforall (%LL1%IF(%LL2 != %NULL), %LL2%ENDIF)%NL%INCTAB%BLOB1%DECTAB", -'s',0,BIFNODE) - -/* DEFNODECODE(CDOALL_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcdoall %IF (%LABUSE != %NULL)%STATENO%ENDIF%SYMBID = %LL1, %LL2%IF (%LL2 != %NULL) , %LL2%ENDIF%NL", -'s',0,BIFNODE) */ - -DEFNODECODE(CDOALL_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3:%ENDIF%INIMPLIOFF%INWRITEOFF%SETFLAG(LOOP)cdoall %IF (%LABUSE != %NULL)%STATENO%ENDIF %SYMBID = %LL1%IF (%LL2 != %NULL),%LL2%ENDIF%INCTAB%NL%UNSETFLAG(LOOP)%BLOB1%DECTAB", -'s',0,BIFNODE) - -DEFNODECODE(SDOALL_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(DOACROSS_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CDOACROSS_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(EXIT_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABexit %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(CYCLE_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcycle %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(GOTO_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABgoto %LL3%NL", -'s',0,BIFNODE) -DEFNODECODE(ASSGOTO_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABgoto %SYMBID %IF (%LL1 != %NULL)(%LL1)%ENDIF%NL", -'s',0,BIFNODE) -DEFNODECODE(COMGOTO_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABgoto (%LL1), %LL2%NL", -'s',0,BIFNODE) -DEFNODECODE(PAUSE_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABpause%NL", -'s',0,BIFNODE) -DEFNODECODE(CONTAINS_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcontains%NL%NL", -'s',0,BIFNODE) -DEFNODECODE(STOP_NODE, "%ERROR", -'s',0,BIFNODE) - -DEFNODECODE(ASSIGN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1 = %LL2%NL", -'s',0,BIFNODE) -DEFNODECODE(POINTER_ASSIGN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1 => %LL2%NL", -'s',0,BIFNODE) -DEFNODECODE(M_ASSIGN_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(PROC_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcall %SYMBID(%LL1)%NL", -'s',0,BIFNODE) -/*ACC*/ -DEFNODECODE(ACC_CALL_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcall %SYMBID<<<%LL2>>>(%LL1)%NL", -'s',0,BIFNODE) -DEFNODECODE(PROS_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprocess call %SYMBID(%LL1)%NL", -'s',1,BIFNODE) -DEFNODECODE(PROS_STAT_LCTN, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprocess call %SYMBID(%LL1) location%LL2%NL", -'s',2,BIFNODE) -DEFNODECODE(PROS_STAT_SUBM, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprocess call %SYMBID(%LL1) submachine%LL2%NL", -'s',2,BIFNODE) -DEFNODECODE(ASSLAB_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABassign %LL1 to %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(SUM_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(MULT_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(MAX_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(MIN_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CAT_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(OR_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(AND_ACC, "%ERROR", -'s',0,BIFNODE) - -/*DEFNODECODE(READ_STAT, "%CMNTread %IF (%L2CODE == %EXPR_LIST)(%LL2) %ELSE%IF (%L2CODE == %SPEC_PAIR)%IF (%L2L1STR == %STRCST 'fmt')(%LL2) %ELSE%L2L2%IF (%LL1 != %NULL), %ENDIF%ENDIF%ELSE%L2L2%IF (%LL1 != %NULL), %ENDIF%ENDIF%ENDIF%LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(READ_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIFread %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%INWRITEON%IF (%L1L2*L1CODE == %IOACCESS)(%ENDIF%LL1%IF (%L1L2*L1CODE == %IOACCESS))%ENDIF%INWRITEOFF%NL", -'s',0,BIFNODE) */ - -/* this is OK but WRITE NODE differ for what reason????????, Should be the same*/ -DEFNODECODE(READ_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABread %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE%IF (%LL2 != %NULL)(%LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%ENDIF%INWRITEON %LL1%INWRITEOFF%NL", -'s',0,BIFNODE) - -/* -DEFNODECODE(WRITE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABwrite %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%INWRITEON%IF (%L1L2*L1CODE == %IOACCESS)(%ENDIF%LL1%IF (%L1L2*L1CODE == %IOACCESS))%ENDIF%INWRITEOFF%NL", -'s',0,BIFNODE) */ - - -DEFNODECODE(WRITE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABwrite %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE%IF (%LL2 != %NULL)(%LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%ENDIF%INWRITEON %LL1%INWRITEOFF%NL", -'s',0,BIFNODE) - -DEFNODECODE(PRINT_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprint %IF (%LL2 != %NULL)%SETFLAG(PRINT)%LL2%UNSETFLAG(PRINT)%IF (%LL1!= %NULL),%ENDIF%ENDIF%INWRITEON %LL1%INWRITEOFF%NL", -'s',0,BIFNODE) - - - -DEFNODECODE(OTHERIO_STAT, "%CMNT%PUTTAB%LL1%NL", -'s',0,BIFNODE) - -DEFNODECODE(BLOB, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(SIZES, "%ERROR", -'s',0,BIFNODE) - - -/* -DEFNODECODE(FUNC_HEDR, "%CMNT%PUTTAB%IF(%SATTR == %RECURSBIT)recursive %ENDIF%SYMBTYPE function %SYMBID (%VARLIST) %NL%BLOB1", -*/ -DEFNODECODE(FUNC_HEDR, "%CMNT%PUTTAB%IF(%LL3 != %NULL)%LL3 %ENDIF%IF(%LL2 != %NULL)%LL2 %ENDIFfunction %SYMBID (%VARLIST)%IF(%LL1 != %NULL) result(%LL1)%ENDIF %NL%BLOB1", -'s',0,BIFNODE) -DEFNODECODE(WHERE_NODE, "%CMNT%IF (%LABEL != %NULL)%LABEL%ENDIF%PUTTABwhere (%LL1) %LL2 = %LL3%NL", -'s',0,BIFNODE) -DEFNODECODE(ALLDO_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(IDENTIFY, "%CMNT%PUTTABidentify %LL1 %LL2%NL", -'s',0,BIFNODE) -DEFNODECODE(FORMAT_STAT, "%CMNT%IF (%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(STOP_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABstop%IF (%LL1 != %NULL)%LL1%ENDIF%NL", -'s',0,BIFNODE) -DEFNODECODE(RETURN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABreturn %LL1%NL", -'s',0,BIFNODE) -/* -DEFNODECODE(ELSEIF_NODE, " (%LL1) then%NL%INCTAB%BLOB1%DECTAB %IF (%BLOB2 != %NULL) %IF (%ELSIFBLOB2 == %NULL)%PUTTABelse%NL%ELSE%PUTTABelse if%ENDIF%BLOB2%IF (%BLOB2 != %NULL)%NL%ENDIF%ELSE%NL%ENDIF", -'s',0,BIFNODE) -*/ -DEFNODECODE(ELSEIF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABelse if (%LL1) then %SYMBID%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSIFBLOB2 == %NULL)%PUTTABelse %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendif %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendif %CNTRNAME%NL%ENDIF", -'s',0,BIFNODE) -DEFNODECODE(ELSEWH_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABelsewhere (%LL1) %SYMBID%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSWHBLOB2 == %NULL)%PUTTABelsewhere %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ENDIF", -'s',0,BIFNODE) - -/*NO_OPnodes*/ -DEFNODECODE(COMMENT_STAT, "%CMNT%NL", -'s',0,BIFNODE) -/* -DEFNODECODE(CONT_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABcontinue%NL", -'s',0,BIFNODE) -*/ -DEFNODECODE(CONT_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcontinue%NL", -'s',0,BIFNODE) -DEFNODECODE(VAR_DECL, "%CMNT%PUTTAB%SETFLAG(VARLEN)%TYPEDECLON%LL2%IF (%LL3 != %NULL),%LL3:: %SETFLAG(VARDECL)%SETFLAG(PARAM)%LL1%UNSETFLAG(VARDECL)%UNSETFLAG(PARAM)%ELSE%SETFLAG(VARDECL) %LL1%UNSETFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARLEN) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%TYPEDECLOF%NL", -'s',0,BIFNODE) -DEFNODECODE(VAR_DECL_90, "%CMNT%PUTTAB%SETFLAG(VARLEN)%TYPEDECLON%LL2%IF (%LL3 != %NULL),%LL3:: %SETFLAG(VARDECL)%SETFLAG(PARAM)%LL1%UNSETFLAG(VARDECL)%UNSETFLAG(PARAM)%ELSE:: %SETFLAG(VARDECL) %LL1%UNSETFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARLEN) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%TYPEDECLOF%NL", -'s',0,BIFNODE) -/* -ALLOCATABLE_STMT, ALLOCATE_STMT, CONTAINS_STMT, CYCLE_STMT, DEALLOCATE_STMT, - EXIT_STMT, INTENT_STMT, INTERFACE_STMT, MODULE_PROC_STMT, MODULE_STMT, - NULLIFY_STMT, OPTIONAL_STMT, POINTER_STMT, PRIVATE_STMT, PUBLIC_STMT, - SEQUENCE_STMT, TARGET_STMT, USE_STMT, -*/ -DEFNODECODE(PARAM_DECL, "%CMNT%PUTTABparameter (%INPARAMON%SETFLAG(PARAM)%LL1%UNSETFLAG(PARAM)%INPARAMOFF)%NL", -'s',0,BIFNODE) -DEFNODECODE(COMM_STAT, "%CMNT%PUTTABcommon %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(PROS_COMM, "%CMNT%PUTTABprocess common %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(EQUI_STAT, "%CMNT%PUTTABequivalence %LL1%NL", -'s',0,BIFNODE) -/* -DEFNODECODE(IMPL_DECL, "%CMNT%PUTTABimplicit %IF (%LL1 != %NULL)%IF (%LL2 != %NULL)%ERROR'IMPLICIT Error'%ELSE%INIMPLION%LL1%INIMPLIOFF%ENDIF%ELSE%INIMPLION%LL2%INIMPLIOFF%ENDIF%NL", -'s',0,BIFNODE) -*/ - -DEFNODECODE(IMPL_DECL, "%CMNT%PUTTABimplicit %IF (%LL1 != %NULL)%SETFLAG(RANGEPRINT)%INIMPLION%LL1%INIMPLIOFF%UNSETFLAG(RANGEPRINT)%ELSEnone%ENDIF%NL", -'s',0,BIFNODE) - - -DEFNODECODE(DATA_DECL, "%CMNT%PUTTAB%LL1%NL", -'s',0,BIFNODE) -/* DEFNODECODE(SAVE_DECL, "%CMNT%PUTTABsave %IF (%LL1 != %NULL)%LL1%ELSEall%ENDIF%NL", -'s',0,BIFNODE) */ -DEFNODECODE(SAVE_DECL, "%CMNT%PUTTABsave %IF (%LL1 != %NULL)%LL1%ENDIF%NL", -'s',0,BIFNODE) -DEFNODECODE(STMTFN_STAT, "%CMNT%PUTTAB%LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(DIM_STAT, "%CMNT%PUTTABdimension %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(PROCESSORS_STAT, "%CMNT%PUTTABprocessors %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(ALLOCATABLE_STMT, "%CMNT%PUTTABallocatable:: %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(OPTIONAL_STMT, "%CMNT%PUTTABoptional:: %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(EXTERN_STAT, "%CMNT%PUTTABexternal %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(INTRIN_STAT, "%CMNT%PUTTABintrinsic %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(PRIVATE_STMT, "%CMNT%PUTTABprivate %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(PUBLIC_STMT, "%CMNT%PUTTABpublic %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(POINTER_STMT, "%CMNT%PUTTABpointer:: %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(TARGET_STMT, "%CMNT%PUTTABtarget:: %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(STATIC_STMT, "%CMNT%PUTTABstatic:: %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(SEQUENCE_STMT, "%CMNT%PUTTABsequence%NL", -'s',0,BIFNODE) -DEFNODECODE(INTERFACE_STMT, "%CMNT%PUTTABinterface %SYMBID%NL%INCTAB%BLOB1%DECTAB%PUTTABend interface%NL", -'s',0,BIFNODE) -DEFNODECODE(INTERFACE_ASSIGNMENT, "%CMNT%PUTTABinterface assignment (=)%NL%INCTAB%BLOB1%DECTAB%PUTTABend interface%NL", -'s',0,BIFNODE) -DEFNODECODE(INTERFACE_OPERATOR, "%CMNT%PUTTABinterface operator (%SYMBID)%NL%INCTAB%BLOB1%DECTAB%PUTTABend interface%NL", -'s',0,BIFNODE) - -DEFNODECODE(ENUM_DECL, "%ERROR", -'d',0,BIFNODE) -DEFNODECODE(CLASS_DECL, "%ERROR", -'d',0,BIFNODE) -DEFNODECODE(UNION_DECL, "%ERROR", -'d',0,BIFNODE) -DEFNODECODE(STRUCT_DECL, "%CMNT%PUTTABtype %IF (%LL1 != %NULL),%LL1:: %ENDIF%SYMBID%NL%INCTAB%BLOB1%DECTAB%PUTTABend type%NL", -'d',0,BIFNODE) -DEFNODECODE(DERIVED_CLASS_DECL, "%ERROR", -'d',0,BIFNODE) -DEFNODECODE(EXPR_STMT_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(DO_WHILE_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CASE_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABcase (%LL1) %SYMBID%INCTAB%NL", -'s',0,BIFNODE) -DEFNODECODE(SWITCH_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIFselect case (%LL1)%NL%INCTAB%BLOB1%DECTAB", -'s',0,BIFNODE) -DEFNODECODE(DEFAULT_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABcase default %SYMBID%INCTAB%NL", -'s',0,BIFNODE) -DEFNODECODE(BREAK_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CONTINUE_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(RETURN_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(ASM_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(LABEL_STAT, "%ERROR", -'s',0,BIFNODE) -/* -DEFNODECODE(PROC_COM, "%ERROR", -'s',0,BIFNODE) -*/ -DEFNODECODE(ATTR_DECL, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(NAMELIST_STAT, "%CMNT%PUTTABnamelist %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(OPEN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABopen (%LL2)%NL", -'s',0,BIFNODE) -DEFNODECODE(CLOSE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABclose (%LL2)%NL", -'s',0,BIFNODE) -DEFNODECODE(ENDFILE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABendfile (%LL2)%NL", -'s',0,BIFNODE) -DEFNODECODE(BACKSPACE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABbackspace (%LL2)%NL", -'s',0,BIFNODE) -DEFNODECODE(INQUIRE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABinquire (%LL2)%IF(%LL1 != %NULL) %LL1%ENDIF%NL", -'s',0,BIFNODE) -DEFNODECODE(REWIND_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABrewind (%LL2)%NL", -'s',0,BIFNODE) -/* DEFNODECODE(ENTRY_STAT, "%CMNT%PUTTABentry %SYMBID(%VARLIST)%NL", -'s',0,BIFNODE) */ -DEFNODECODE(ENTRY_STAT, "%CMNT%PUTTABentry %SYMBID%IF(%LL1 != %NULL)(%LL1)%ENDIF%IF(%LL2 != %NULL) result(%LL2)%ENDIF%NL", -'s',0,BIFNODE) -DEFNODECODE(MODULE_PROC_STMT, "%CMNT%PUTTABmodule procedure %LL1%NL", -'s',0,BIFNODE) - -DEFNODECODE(BLOCK_DATA, "%CMNT%PUTTABblock data%IF(%SYMBID != %STRCST'_BLOCK') %SYMBID%ENDIF%NL%BLOB1%NL%PUTTABend%NL", -'s',0,BIFNODE) -/*DEFNODECODE(BLOCK_DATA, "%CMNT%PUTTABblock data %SYMBID%NL%BLOB1%NL%PUTTABend%NL", -'s',0,BIFNODE) -*/ -DEFNODECODE(MODULE_STMT, "%CMNT%PUTTABmodule %SYMBID%NL%BLOB1%PUTTABend module %NL%NL", -'s',0,BIFNODE) -DEFNODECODE(USE_STMT, "%CMNT%PUTTABuse %SYMBID%IF(%LL1 != %NULL), %LL1%ENDIF%NL", -'s',0,BIFNODE) -DEFNODECODE(INCLUDE_LINE, "%CMNT%PUTTABinclude %LL1%NL", -'s',0,BIFNODE) - -/*****************variant tags for low level nodes********************/ - -/***** List of commands for LOW LEVEL NODES *****/ - /* %ERROR : Error ; syntax : %ERROR'message' */ - /* %NL : NewLine */ - /* %% : '%' (Percent Sign) */ - /* %TAB : Tab */ - /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - /* %ELSE : Else */ - /* %ENDIF : End of If */ - /* %LL1 : Low Level Node 1 */ - /* %LL2 : Low Level Node 2 */ - /* %SYMBID : Symbol identifier */ - /* %TYPE : Type */ - /* %L1SYMBCST : Constant Value of Low Level Node Symbol */ - /* %INTVAL : Integer Value */ - /* %STATENO : Statement Number */ - /* %STRVAL : String Value */ - /* %BOOLVAL : Boolean Value */ - /* %CHARVAL : Char Value */ - /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ - /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ - /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ - /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ -/***********************************************/ - -/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for LOW LEVEL NODE *****/ - /* %STRCST : String Constant in '' */ - /* %SYMBID : Symbol Identifier (string) */ - /* %SYMBOL : Symbol node (integer) */ - /* == : Equal (operation) */ - /* != : Different (operation) */ - /* %NULL : 0, Integer Constant (or false boolean) */ - /* %LL1 : Low Level Node 1 (integer) */ - /* %LL2 : Low Level Node 2 (integer) */ - /* %LABUSE : Label ptr (do end) (integer) */ - /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ - /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ - /* %INWRITE : In_Write_Statement (integer / boolean flag) */ - /* %INPARAM : In_Param_Statement (integer / boolean flag) */ - /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ -/************************************************************************************************/ - - -DEFNODECODE(LEN_OP, "%IF (%LL1 != %NULL)%IF(%LL2 != %NULL)*(%LL1)%ELSE*%LL1%ENDIF%IF (%CHECKFLAG(STYPE) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%ENDIF",'e',0,LLNODE) -DEFNODECODE(INT_VAL, "%INTKIND", -'c',0,LLNODE) -DEFNODECODE(FLOAT_VAL, "%STRVAL%KIND", -'c',0,LLNODE) -DEFNODECODE(DOUBLE_VAL, "%STRVAL%KIND", -'c',0,LLNODE) -DEFNODECODE(BOOL_VAL, "%BOOLVAL%KIND", -'c',0,LLNODE) -DEFNODECODE(CHAR_VAL, "%IF (%INIMPLI == %NULL)\\%ENDIF%CHARVAL%IF (%INIMPLI == %NULL)\\%ENDIF", -'c',0,LLNODE) -/* -DEFNODECODE(STRING_VAL, "%IF (%CHECKFLAG(QUOTE) != %NULL)'%STRVAL'%ELSE\\%STRVAL\\%ENDIF", -'c',0,LLNODE) -*/ -DEFNODECODE(STRING_VAL, "%STRKIND%SYMQUOTE%STRVAL%SYMQUOTE", -'c',0,LLNODE) -DEFNODECODE(KEYWORD_VAL, "%STRVAL", -'c',0,LLNODE) -DEFNODECODE(COMPLEX_VAL, "%SETFLAG(CMPLXCONST)(%LL1, %LL2)%UNSETFLAG(CMPLXCONST)", -'c',0,LLNODE) - -DEFNODECODE(CONST_REF, "%SYMBID", -'r',2,LLNODE) -/* -DEFNODECODE(VAR_REF, "%SYMBID%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%CHECKFLAG(VARLEN) != %NULL)%STRINGLEN%ENDIF%ENDIF", -'r',0,LLNODE) -*/ -DEFNODECODE(VAR_REF, "%SYMBID%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%TYPEDECL != %NULL)%IF (%TYPEDECL != %TYPEBASE)%STRINGLEN%ENDIF%ENDIF", -'r',0,LLNODE) -/* -DEFNODECODE(ARRAY_REF, "%SYMBID%IF (%LL1 != %NULL)%PUSHFLAG(VARDECL)%SETFLAG(ARRAYOP)(%LL1)%POPFLAG(VARDECL)%UNSETFLAG(ARRAYOP)%ENDIF%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%CHECKFLAG(VARLEN) != %NULL)%STRINGLEN%ENDIF%ENDIF", -'r',1,LLNODE) -*/ -DEFNODECODE(ARRAY_REF, "%SYMBID%IF (%LL1 != %NULL)%PUSHFLAG(VARDECL)%PUSHFLAG(PARAM)%SETFLAG(ARRAYOP)(%LL1)%POPFLAG(VARDECL)%POPFLAG(PARAM)%UNSETFLAG(ARRAYOP)%ENDIF%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%TYPEDECL != %NULL)%IF (%TYPEDECL != %TYPEBASE)%STRINGLEN%ENDIF%ENDIF%ENDIF", -'r',1,LLNODE) -DEFNODECODE(PROCESSORS_REF, "%IF (%LL1 != %NULL)%PUSHFLAG(VARDECL)%IF(%CHECKFLAG(NOARRAY) == %NULL)(%LL1)%ENDIF%POPFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARDECL) != %NULL)%STRINGLEN%ENDIF", -'r',1,LLNODE) -DEFNODECODE(RECORD_REF, "%LL1%%%LL2", -'r',2,LLNODE) -DEFNODECODE(STRUCTURE_CONSTRUCTOR, "%SYMBID(%LL1)", -'r',1,LLNODE) -DEFNODECODE(CONSTRUCTOR_REF, "(/%LL1/)", -'r',2,LLNODE) -DEFNODECODE(TYPE_REF, "%SYMBID", -'r',2,LLNODE) - -DEFNODECODE(ENUM_REF, "%SYMBID", -'r',2,LLNODE) - -DEFNODECODE(LABEL_REF, "%STATENO", -'r',0,LLNODE) -DEFNODECODE(TYPE_OP, "%TYPE", -'e',1,LLNODE) -DEFNODECODE(DIMENSION_OP, "dimension(%LL1)", -'e',1,LLNODE) -DEFNODECODE(ALLOCATABLE_OP, "allocatable", -'e',1,LLNODE) -DEFNODECODE(PARAMETER_OP, "parameter", -'e',1,LLNODE) -DEFNODECODE(TARGET_OP, "target", -'e',1,LLNODE) -DEFNODECODE(STATIC_OP, "static", -'e',1,LLNODE) -DEFNODECODE(SAVE_OP, "save", -'e',1,LLNODE) -DEFNODECODE(POINTER_OP, "pointer", -'e',1,LLNODE) -DEFNODECODE(INTRINSIC_OP, "intrinsic", -'e',1,LLNODE) -DEFNODECODE(OPTIONAL_OP, "optional", -'e',1,LLNODE) -DEFNODECODE(EXTERNAL_OP, "external", -'e',1,LLNODE) -DEFNODECODE(PRIVATE_OP, "private", -'e',1,LLNODE) -DEFNODECODE(PUBLIC_OP, "public", -'e',1,LLNODE) -DEFNODECODE(IN_OP, "intent(in)", -'e',1,LLNODE) -DEFNODECODE(OUT_OP, "intent(out)", -'e',1,LLNODE) -DEFNODECODE(INOUT_OP, "intent(inout)", -'e',1,LLNODE) -DEFNODECODE(OPERATOR_OP, "operator(%SYMBID)", -'e',1,LLNODE) -DEFNODECODE(ASSIGNMENT_OP, "assignment(=)", -'e',1,LLNODE) -DEFNODECODE(KIND_OP, "kind=%LL1", -'e',1,LLNODE) -DEFNODECODE(LENGTH_OP, "len=%LL1", -'e',1,LLNODE) -DEFNODECODE(RECURSIVE_OP, "recursive", -'e',0,LLNODE) -DEFNODECODE(ELEMENTAL_OP, "elemental", -'e',0,LLNODE) -DEFNODECODE(PURE_OP, "pure", -'e',0,LLNODE) - -DEFNODECODE(ACC_DEVICE_OP, "device", -'e',0,LLNODE) -DEFNODECODE(ACC_VALUE_OP, "value", -'e',0,LLNODE) -DEFNODECODE(ACC_SHARED_OP, "shared", -'e',0,LLNODE) -DEFNODECODE(ACC_CONSTANT_OP, "constant", -'e',0,LLNODE) -DEFNODECODE(ACC_HOST_OP, "host", -'e',0,LLNODE) -DEFNODECODE(ACC_GLOBAL_OP, "global", -'e',0,LLNODE) -DEFNODECODE(ACC_ATTRIBUTES_OP, "attributes(%LL1)", -'e',1,LLNODE) - - -DEFNODECODE(VAR_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(PORT_TYPE_OP, "%TYPE%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(INPORT_TYPE_OP, "inport ( %TYPE%SETFLAG(RECPORT)%LL1%IF (%LL2 != %NULL), %LL2%ENDIF%IF(%CHECKFLAG(RECPORT) != %NULL))%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(OUTPORT_TYPE_OP, "outport( %TYPE%SETFLAG(RECPORT)%LL1%IF (%LL2 != %NULL), %LL2%ENDIF%IF(%CHECKFLAG(RECPORT) != %NULL))%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(INPORT_NAME, "%IF(%CHECKFLAG(PORT) != %NULL)PORT=%ELSEIN=%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(OUTPORT_NAME, "%IF(%CHECKFLAG(PORT) != %NULL)PORT=%ELSEOUT=%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(FROMPORT_NAME, "FROM=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(TOPORT_NAME, "TO=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(IOSTAT_STORE, "IOSTAT=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(EMPTY_STORE, "EMPTY=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(ERR_LABEL, "ERR=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(END_LABEL, "END=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(DATA_IMPL_DO, "(%LL1, %SYMBID=%LL2)", -'e',2,LLNODE) - -DEFNODECODE(DATA_ELT, "%IF (%SYMBOL == %NULL)%LL1%ELSE%SYMBID%LL1%ENDIF%IF (%LL2 != %NULL),%LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(DATA_SUBS, "(%LL1)%IF (%LL2 != %NULL)%LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(DATA_RANGE, "(%IF (%LL1 != %NULL)%LL1%ENDIF:%IF (%LL2 != %NULL)%LL2%ENDIF)", -'e',2,LLNODE) - -DEFNODECODE(ICON_EXPR, "%LL1%IF (%LL2 != %NULL),%LL2%ENDIF", -'e',2,LLNODE) - -/* Probablement faux BODIN -DEFNODECODE(EXPR_LIST, "%LL1%IF (%INPARAM != %NULL) = %L1SYMBCST%ENDIF%IF (%LL2 != %NULL),%LL2%ENDIF", -'e',2,LLNODE) */ - -DEFNODECODE(EXPR_LIST, "%LL1%IF (%CHECKFLAG(PARAM) != %NULL)%IF (%VALUE != %NULL) = %PUSHFLAG(PARAM)%PUSHFLAG(VARDECL)%L1SYMBCST%POPFLAG(PARAM)%POPFLAG(VARDECL)%ENDIF%ENDIF%ENDIF%IF (%LL2 != %NULL),%LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(RANGE_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(CASE_CHOICE, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(DEF_CHOICE, "%LL1%IF (%LL2 != %NULL):%LL2", -'e',2,LLNODE) -DEFNODECODE(VARIANT_CHOICE, "%ERROR", -'e',2,LLNODE) -/* -DEFNODECODE(DDOT, "%LL1%IF (%INWRITE != %NULL),%ELSE%IF (%INIMPLI != %NULL)-%ELSE%IF (%CHECKFLAG(LOOP) != %NULL),%ELSE:%ENDIF%ENDIF%ENDIF%LL2", -*/ -DEFNODECODE(DDOT, "%LL1%IF (%CHECKFLAG(ARRAYOP) != %NULL):%ELSE%IF (%INWRITE != %NULL),%ELSE%IF (%INIMPLI != %NULL)-%ELSE%IF (%CHECKFLAG(LOOP) != %NULL),%ELSE:%ENDIF%ENDIF%ENDIF%ENDIF%LL2", -'e',2,LLNODE) -DEFNODECODE(RANGE_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FORALL_OP, "%SYMBID=%LL1", -'e',2,LLNODE) -DEFNODECODE(UPPER_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(LOWER_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(EQ_OP, "%ORBPL1%LL1%CRBPL1 .eq. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(LT_OP, "%ORBPL1%LL1%CRBPL1 .lt. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(GT_OP, "%ORBPL1%LL1%CRBPL1 .gt. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(NOTEQL_OP, "%ORBPL1%LL1%CRBPL1 .ne. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(LTEQL_OP, "%ORBPL1%LL1%CRBPL1 .le. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(GTEQL_OP, "%ORBPL1%LL1%CRBPL1 .ge. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) - -DEFNODECODE(ADD_OP, "%ORBPL1%LL1%CRBPL1 + %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(SUBT_OP, "%ORBPL1%LL1%CRBPL1 - %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(OR_OP, "%ORBPL1%LL1%CRBPL1 .or. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) - -DEFNODECODE(MULT_OP, "%ORBPL1%LL1%CRBPL1 * %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(DIV_OP, "%ORBPL1%LL1%CRBPL1 / %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(MOD_OP, "%ORBPL1%LL1%CRBPL1%% %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(AND_OP, "%ORBPL1%LL1%CRBPL1 .and. %ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) - -DEFNODECODE(EXP_OP, "%ORBPL1EXP%LL1%CRBPL1EXP** %ORBPL2EXP%LL2%CRBPL2EXP", -'e',2,LLNODE) -DEFNODECODE(ARRAY_MULT, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(CONCAT_OP, "%ORBPL1%LL1%CRBPL1//%ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(XOR_OP, "%ORBPL1%LL1%CRBPL1.xor.%ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(EQV_OP, "%ORBPL1%LL1%CRBPL1.eqv.%ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(NEQV_OP, "%ORBPL1%LL1%CRBPL1.neqv.%ORBPL2%LL2%CRBPL2", -'e',2,LLNODE) -DEFNODECODE(MINUS_OP, "%IF (%CHECKFLAG(CMPLXCONST) != %NULL)-%LL1%ELSE(-(%LL1))%ENDIF", -'e',1,LLNODE) -DEFNODECODE(NOT_OP, ".not.(%LL1)", -'e',2,LLNODE) -DEFNODECODE(ASSGN_OP, "%LL1=%PUSHFLAG(VARDECL)%PUSHFLAG(PARAM)%LL2%POPFLAG(VARDECL)%POPFLAG(PARAM)", -'e',2,LLNODE) -DEFNODECODE(RENAME_NODE, "%LL1%IF(%LL2 != %NULL)=>%LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(KEYWORD_ARG, "%LL1=%LL2", -'e',2,LLNODE) -DEFNODECODE(LABEL_ARG, "*%LL1", -'e',1,LLNODE) -DEFNODECODE(ONLY_NODE, "only: %LL1", -'e',1,LLNODE) -DEFNODECODE(DEREF_OP, "%LL1", -'e',1,LLNODE) -DEFNODECODE(POINTST_OP, "%LL1=>%LL2", -'e',2,LLNODE) -DEFNODECODE(FUNCTION_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(MINUSMINUS_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(PLUSPLUS_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BITAND_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BITOR_OP, "%ERROR", -'e',2,LLNODE) - - - -DEFNODECODE(STAR_RANGE, "*", -'e',2,LLNODE) - -DEFNODECODE(PROC_CALL, "%SYMBID (%LL1)", -'e',2,LLNODE) -DEFNODECODE(PROS_CALL, "%SYMBID (%LL1)", -'e',1,LLNODE) -DEFNODECODE(FUNC_CALL, "%SYMBID (%LL1)", -'e',1,LLNODE) -DEFNODECODE(OVERLOADED_CALL, "%LL1", -'e',1,LLNODE) - - -DEFNODECODE(ACCESS_REF, "%LL1%IF (%LL2 != %NULL) (%LL2)%ENDIF", -'e',2,LLNODE) -DEFNODECODE(CONS, "%LL1, %LL2", -'e',2,LLNODE) -DEFNODECODE(ACCESS, "%LL1, FORALL = (%SYMBID = %LL2)", -'e',2,LLNODE) -DEFNODECODE(IOACCESS, "%IF (%LL1 != %NULL)(%LL1, %ENDIF%SYMBID = %LL2%IF (%LL1 != %NULL))%ENDIF", -'e',2,LLNODE) -DEFNODECODE(CONTROL_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(SEQ, "%LL1%IF (%LL2 != %NULL),%LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(SPEC_PAIR, "%IF (%CHECKFLAG(PRINT) != %NULL)%LL2%ELSE%LL1 = %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(COMM_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(STMT_STR, "%STMTSTR", -'e',2,LLNODE) -DEFNODECODE(EQUI_LIST, "(%LL1)%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(IMPL_TYPE, "%TYPE %IF (%LL1 != %NULL)(%LL1)", -'e',2,LLNODE) -DEFNODECODE(STMTFN_DECL, "%SYMBID (%VARLIST) = %LL1", -'e',2,LLNODE) -DEFNODECODE(DEFINED_OP, "%IF(%LL2 != %NULL)(%LL1 %SYMBID %LL2)%ELSE%SYMBID(%LL1)%ENDIF", -'e',2,LLNODE) - - -DEFNODECODE(BIT_COMPLEMENT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(EXPR_IF, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(EXPR_IF_BODY, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FUNCTION_REF, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(LSHIFT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RSHIFT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(UNARY_ADD_OP, "%IF (%CHECKFLAG(CMPLXCONST) != %NULL)+%LL1%ELSE(+(%LL1))%ENDIF", -'e',2,LLNODE) -DEFNODECODE(SIZE_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(INTEGER_DIV_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(SUB_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(LE_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(GE_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(NE_OP, "%ERROR", -'e',2,LLNODE) - -DEFNODECODE(CLASSINIT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(CAST_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ADDRESS_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(POINSTAT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(COPY_NODE, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(INIT_LIST, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(VECTOR_CONST, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIT_NUMBER, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ARITH_ASSGN_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ARRAY_OP, "%LL1%SETFLAG(ARRAYOP)(%LL2)%UNSETFLAG(ARRAYOP)", -'e',2,LLNODE) -DEFNODECODE(NEW_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(DELETE_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(NAMELIST_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -/* new tag for some expression */ - -DEFNODECODE(CEIL_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(MAX_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIF_SAVE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(MIN_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIF_ADDR_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(BIF_NOP_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(BIF_RTL_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUNC_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUNC_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FLOOR_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FLOOR_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(CEIL_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ROUND_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ROUND_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RDIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(EXACT_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(CONVERT_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(CONST_DECL, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ABS_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_ANDIF_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_AND_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_NOT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_ORIF_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(PREINCREMENT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(PREDECREMENT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(COMPOUND_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FLOAT_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(BIT_IOR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIT_XOR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIT_ANDTC_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_OR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_TRUNC_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(RROTATE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(LROTATE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RANGE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(POSTDECREMENT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(REFERENCE_TYPE, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_FLOOR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_ROUND_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_CEIL_EXPR , "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FUNCTION_DECL , "%ERROR", -'d',2,LLNODE) -DEFNODECODE(MODIFY_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(REFERENCE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RESULT_DECL, "%ERROR", -'d',2,LLNODE) -DEFNODECODE(PARM_DECL, "%ERROR", -'d',2,LLNODE) - - -/*****************variant tags for symbol table entries********************/ - -DEFNODECODE(BIF_PARM_DECL, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(CONST_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(ENUM_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(FIELD_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(VARIABLE_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(TYPE_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(PROGRAM_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(PROCEDURE_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(PROCESS_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(VAR_FIELD, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(LABEL_VAR, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(FUNCTION_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(MEMBER_FUNC, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(CLASS_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(UNION_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(STRUCT_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(LABEL_NAME, "%ERROR", -'r',0,SYMBNODE) - -/*****************variant tags for type nodes********************/ - -/***** List of commands for TYPE NODES *****/ - /* %ERROR : Error ; syntax : %ERROR'message' */ - /* %NL : NewLine */ - /* %% : '%' (Percent Sign) */ - /* %TAB : Tab */ - /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - /* %ELSE : Else */ - /* %ENDIF : End of If */ - /* %BASETYPE : Base Type Name Identifier */ - /* %NAMEID : Name Identifier */ - /* %TABNAME : Self Name from Table */ - /* %RANGES : Ranges */ - /* %RANGLL1 : Low Level Node 1 of Ranges */ -/*******************************************/ - -/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for TYPE NODE *****/ - /* %STRCST : String Constant in '' */ - /* == : Equal (operation) */ - /* != : Different (operation) */ - /* %NULL : 0, Integer Constant (or false boolean) */ - /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ -/******************************************************************************************/ - -/* CODES AYANT DISPARU : - T_SEQUENCE, T_EVENT, T_GATE, -*/ - -DEFNODECODE(DEFAULT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_INT, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) -DEFNODECODE(T_FLOAT, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) -DEFNODECODE(T_DOUBLE, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) -DEFNODECODE(T_CHAR, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) -DEFNODECODE(T_BOOL, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) -DEFNODECODE(T_STRING, "%TABNAME%SETFLAG(STYPE)%SETFLAG(TSRIN)%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF%UNSETFLAG(TSRIN)%UNSETFLAG(STYPE) ", -'t',0,TYPENODE) -DEFNODECODE(T_COMPLEX, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) -DEFNODECODE(T_DCOMPLEX, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", -'t',0,TYPENODE) - - - -DEFNODECODE(T_ENUM, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_SUBRANGE, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_LIST, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_ARRAY, "%BASETYPE %RANGES", -'t',0,TYPENODE) -DEFNODECODE(T_RECORD, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_ENUM_FIELD, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_UNKNOWN, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_VOID, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_DESCRIPT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_FUNCTION, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_POINTER, "%BASETYPE", -'t',0,TYPENODE) -DEFNODECODE(T_UNION, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_STRUCT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_CLASS, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_DERIVED_CLASS, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_DERIVED_TYPE, "type (%NAMEID)", -'t',0,TYPENODE) - - -DEFNODECODE(LOCAL, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(INPUT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(OUTPUT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(IO, "%ERROR", -'t',0,TYPENODE) - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseC++.def b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseC++.def deleted file mode 100644 index ef81403..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseC++.def +++ /dev/null @@ -1,833 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/*****************************************************************************/ -/*****************************************************************************/ -/***** *****/ -/***** UNPARSE.DEF: Bodin Francois Sepetmber 1992 *****/ -/***** with major changes by d. gannon summer 1993 *****/ -/***** Version C++ *****/ -/***** *****/ -/*****************************************************************************/ -/*****************************************************************************/ - - -DEFNODECODE(GLOBAL, "%SETFLAG(ARRAYREF)%UNSETFLAG(ARRAYREF)%SETFLAG(CLASSDECL)%UNSETFLAG(CLASSDECL)%SETFLAG(PAREN)%UNSETFLAG(PAREN)%SETFLAG(ELIST)%UNSETFLAG(ELIST)%SETFLAG(QUOTE)%BLOB1%UNSETFLAG(QUOTE)", -'s',0,BIFNODE) -DEFNODECODE(PROG_HEDR, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(PROC_HEDR, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(BASIC_BLOCK, "%CMNT%PUTTAB{%NL%INCTAB%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) - -DEFNODECODE(MODULE_STMT, "%CMNT%PUTTAB%NL%INCTAB%BLOB1%DECTAB%PUTTAB%NL", -'s',0,BIFNODE) - -/* 107 is value for FOR_NODE */ -DEFNODECODE(CONTROL_END, "", -'s',0,BIFNODE) -DEFNODECODE(IF_NODE, "%CMNT%PUTTABif (%LL1) %NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL%IF (%BLOB2 != %NULL)%PUTTABelse %NL%PUTTAB{%INCTAB%NL%BLOB2%DECTAB%PUTTAB}%NL%ENDIF", -'s',0,BIFNODE) -DEFNODECODE(ARITHIF_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(LOGIF_NODE, "%CMNT%PUTTABif (%LL1) %NL%PUTTAB%INCTAB%BLOB1%DECTAB%PUTTAB%NL", -'s',0,BIFNODE) - -DEFNODECODE(LOOP_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(FOR_NODE, "%CMNT%PUTTABfor (%LL1 ; %LL2 ; %LL3)%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -DEFNODECODE(FORALL_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(WHILE_NODE, "%CMNT%PUTTABwhile (%LL1)%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -DEFNODECODE(TRY_STAT, "%CMNT%PUTTABtry {%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -DEFNODECODE(CATCH_STAT, "%CMNT%PUTTABcatch (%SETFLAG(VARDECL)%TMPLARGS%UNSETFLAG(VARDECL)){%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) - -DEFNODECODE(SDOALL_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(DOACROSS_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CDOACROSS_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(EXIT_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(GOTO_NODE, "%CMNT%PUTTABgoto %LL3;%NL", -'s',0,BIFNODE) -DEFNODECODE(ASSGOTO_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(COMGOTO_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(PAUSE_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(STOP_NODE, "%ERROR", -'s',0,BIFNODE) - -DEFNODECODE(ASSIGN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1 = %LL2;%NL", -'s',0,BIFNODE) -/* -DEFNODECODE(ASSIGN_STAT, "%ERROR", -'s',0,BIFNODE) */ -DEFNODECODE(M_ASSIGN_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(PROC_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(ASSLAB_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(SUM_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(MULT_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(MAX_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(MIN_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CAT_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(OR_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(AND_ACC, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(READ_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(WRITE_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(PRINT_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(OTHERIO_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(BLOB, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(SIZES, "%ERROR", -'s',0,BIFNODE) -/* podd 12.01.12 %CONSTRU deleted -DEFNODECODE(FUNC_HEDR, "%CMNT%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUTTAB%DECLSPEC%SYMBTYPE %IF (%CHECKFLAG(CLASSDECL) == %NULL)%SYMBSCOPE%IF(%LL3 != %NULL)<%TMPLARGS >%ENDIF%SYMBDC%ENDIF %SETFLAG(VARDECL)%FUNHD%UNSETFLAG(VARDECL)%CONSTRU%ENDIF%CNSTF{%INCTAB%NL%PUSHFLAG(CLASSDECL)%BLOB1%POPFLAG(CLASSDECL)%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -*/ -DEFNODECODE(FUNC_HEDR, "%CMNT%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUTTAB%DECLSPEC%SYMBTYPE %IF (%CHECKFLAG(CLASSDECL) == %NULL)%SYMBSCOPE%IF(%LL3 != %NULL)<%TMPLARGS >%ENDIF%SYMBDC%ENDIF %SETFLAG(VARDECL)%FUNHD%UNSETFLAG(VARDECL)%ENDIF%CNSTF%NL%PUTTAB{%INCTAB%NL%PUSHFLAG(CLASSDECL)%BLOB1%POPFLAG(CLASSDECL)%DECTAB%PUTTAB}%NL%NL", -'s',0,BIFNODE) - -DEFNODECODE(TEMPLATE_FUNDECL, "%CMNT%PUTTABtemplate <%SETFLAG(VARDECL)%TMPLARGS%UNSETFLAG(VARDECL) > %BLOB1", -'s',0,BIFNODE) - - -DEFNODECODE(WHERE_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(ALLDO_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(IDENTIFY, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(FORMAT_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(STOP_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(RETURN_STAT, "%CMNT%PUTTABreturn%IF (%LL1 != %NULL) %LL1%ENDIF;%NL", -'s',0,BIFNODE) - -DEFNODECODE(ELSEIF_NODE, "%CMNT%DECTAB%PUTTAB}%NL%PUTTABelse if (%LL1) %NL%PUTTAB{%INCTAB%NL", -'s',0,BIFNODE) - -/*NO_OPnodes*/ -DEFNODECODE(COMMENT_STAT, "%CMNT%NL", -'s',0,BIFNODE) -DEFNODECODE(CONT_STAT, "%CMNT%PUTTABcontinue;%NL", -'s',0,BIFNODE) -DEFNODECODE(VAR_DECL, "%CMNT%SETFLAG(VARDECL)%IF (%CHECKFLAG(ENUM) == %NULL)%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUTTAB%DECLSPEC%TYPE %ENDIF%LL1%IF (%CHECKFLAG(ENUM) == %NULL);%ENDIF%UNSETFLAG(VARDECL)%NL", -'s',0,BIFNODE) -DEFNODECODE(PRIVATE_AR_DECL, "%CMNT%PUTTABPrivateArray<%LL1,%LL2> %LL3;%NL", -'s',0,BIFNODE) -DEFNODECODE(PARAM_DECL, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(COMM_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(EQUI_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(IMPL_DECL, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(DATA_DECL, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(SAVE_DECL, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(STMTFN_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(DIM_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(EXTERN_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(INTRIN_STAT, "%ERROR", -'s',0,BIFNODE) - -DEFNODECODE(ENUM_DECL, "%CMNT%PUTTAB%DECLSPEC%SETFLAG(ENUM)enum %SYMBID %IF (%BLOB1 != %NULL){%INCTAB%NL %BLOB1%DECTAB%PUTTAB}%LL1;%NL%ELSE%LL1;%NL%ENDIF%UNSETFLAG(ENUM)", -'d',0,BIFNODE) -/* the public: in the line below is to mask a dep2C++ bug */ -DEFNODECODE(CLASS_DECL, "%CMNT%INCLASSON%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUSHFLAG(CLASSDECL)%PUTTAB%DECLSPEC%RIDPT%SETFLAG(CLASSDECL)class %SYMBID%IF (%LL2 !=%NULL):%SETFLAG(SUBCLASS)%LL2%UNSETFLAG(SUBCLASS)%ENDIF %IF (%BLOB1 != %NULL){%INCTAB%NLpublic:%NL%BLOB1 %NL%DECTAB%PUTTAB}%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF%UNSETFLAG(CLASSDECL)%POPFLAG(CLASSDECL)%IF (%CHECKFLAG(CLASSDECL) == %NULL)%INCLASSOFF", -'d',0,BIFNODE) -DEFNODECODE(TECLASS_DECL, "%CMNT%INCLASSON%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUSHFLAG(CLASSDECL)%PUTTAB%DECLSPEC%RIDPT%SETFLAG(CLASSDECL)TEClass %SYMBID%IF (%LL2 !=%NULL):%SETFLAG(SUBCLASS)%LL2%UNSETFLAG(SUBCLASS)%ENDIF %IF (%BLOB1 != %NULL){%INCTAB%NLpublic:%NL%BLOB1 %NL%DECTAB%PUTTAB}%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF%UNSETFLAG(CLASSDECL)%POPFLAG(CLASSDECL)%INCLASSOFF", -'d',0,BIFNODE) -DEFNODECODE(UNION_DECL, "%CMNT%PUTTAB%DECLSPEC%RIDPTunion %SYMBID %IF (%BLOB1 != %NULL){%INCTAB%NL%BLOB1%NL%DECTAB%PUTTAB} %LL1;%NL%ELSE%LL1;%NL%ENDIF", -'d',0,BIFNODE) -DEFNODECODE(STRUCT_DECL, "%CMNT%PUTTAB%DECLSPEC%RIDPTstruct %SYMBID %IF (%LL2 !=%NULL):%SETFLAG(SUBCLASS)%LL2%UNSETFLAG(SUBCLASS)%ENDIF %IF (%BLOB1!=%NULL){%INCTAB%NL%BLOB1%DECTAB%PUTTAB} %SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF", -'d',0,BIFNODE) -DEFNODECODE(EXTERN_C_STAT, "%CMNT%PUTTABextern \"C\" %IF (%BLOB1!=%NULL){%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL%ENDIF", -'d',0,BIFNODE) -DEFNODECODE(DERIVED_CLASS_DECL, "%ERROR", -'d',0,BIFNODE) -DEFNODECODE(EXPR_STMT_NODE, "%CMNT%PUTTAB%LL1;%NL", -'s',0,BIFNODE) -DEFNODECODE(DO_WHILE_NODE, "%CMNT%PUTTABdo {%NL%INCTAB%NL%BLOB1%DECTAB%PUTTAB} while (%LL1);%NL", -'s',0,BIFNODE) -DEFNODECODE(SWITCH_NODE, "%CMNT%PUTTABswitch (%LL1)%NL%PUTTAB{%NL%INCTAB%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -DEFNODECODE(CASE_NODE, "%CMNT%PUTTABcase %LL1:%NL", -'s',0,BIFNODE) -DEFNODECODE(DEFAULT_NODE, "%CMNT%PUTTABdefault:%NL", -'s',0,BIFNODE) -DEFNODECODE(BREAK_NODE, "%CMNT%PUTTABbreak;%NL", -'s',0,BIFNODE) -DEFNODECODE(CONTINUE_NODE, "%CMNT%PUTTABcontinue;%NL", -'s',0,BIFNODE) -DEFNODECODE(RETURN_NODE, "%CMNT%PUTTABreturn%IF (%LL1 != %NULL) %LL1%ENDIF;%NL", -'s',0,BIFNODE) -DEFNODECODE(ASM_NODE, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(SPAWN_NODE, "%CMNT%PUTTABspawn %LL1;%NL", -'s',0,BIFNODE) -DEFNODECODE(PARFOR_NODE, "%CMNT%PUTTABparfor (%LL1 ; %LL2 ; %LL3)%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -DEFNODECODE(PAR_NODE, "%CMNT%PUTTABpar%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", -'s',0,BIFNODE) -DEFNODECODE(LABEL_STAT, "%CMNT%LABNAME:%NL", -'s',0,BIFNODE) -DEFNODECODE(PROS_COMM, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(ATTR_DECL, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(NAMELIST_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(OPEN_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(CLOSE_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(ENDFILE_STAT, "%ERROR", -'s',0,BIFNODE) -DEFNODECODE(REWIND_STAT, "%ERROR", -'s',0,BIFNODE) -/* DEFNODECODE(ENTRY_STAT, "%ERROR", -'s',0,BIFNODE) */ - DEFNODECODE(ENTRY_STAT, "%ERROR", -'s',0,BIFNODE) - -DEFNODECODE(BLOCK_DATA, "%ERROR", -'s',0,BIFNODE) - -DEFNODECODE(COLLECTION_DECL, "%INCLASSON%CMNT%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUSHFLAG(CLASSDECL)%PUTTAB%RIDPT%SETFLAG(CLASSDECL)Collection %SYMBID%IF (%LL2 !=%NULL):public %LL2%ENDIF %IF (%BLOB1 != %NULL){%INCTAB%NL%BLOB1 %NL%DECTAB%PUTTAB}%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF%UNSETFLAG(CLASSDECL)%POPFLAG(CLASSDECL)%INCLASSOFF", -'s',0,BIFNODE) -DEFNODECODE(INCLUDE_LINE, "%CMNT#include %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(PREPROCESSOR_DIR, "%CMNT%LL1%NL", -'s',0,BIFNODE) - -/*****************variant tags for low level nodes********************/ - -/***** List of commands for LOW LEVEL NODES *****/ - /* %ERROR : Error ; syntax : %ERROR'message' */ - /* %NL : NewLine */ - /* %% : '%' (Percent Sign) */ - /* %TAB : Tab */ - /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - /* %ELSE : Else */ - /* %ENDIF : End of If */ - /* %LL1 : Low Level Node 1 */ - /* %LL2 : Low Level Node 2 */ - /* %SYMBID : Symbol identifier */ - /* %TYPE : Type */ - /* %L1SYMBCST : Constant Value of Low Level Node Symbol */ - /* %INTVAL : Integer Value */ - /* %STATENO : Statement Number */ - /* %STRVAL : String Value */ - /* %BOOLVAL : Boolean Value */ - /* %CHARVAL : Char Value */ - /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ - /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ - /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ - /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ -/***********************************************/ - -/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for LOW LEVEL NODE *****/ - /* %STRCST : String Constant in '' */ - /* %SYMBID : Symbol Identifier (string) */ - /* %SYMBOL : Symbol node (integer) */ - /* == : Equal (operation) */ - /* != : Different (operation) */ - /* %NULL : 0, Integer Constant (or false boolean) */ - /* %LL1 : Low Level Node 1 (integer) */ - /* %LL2 : Low Level Node 2 (integer) */ - /* %LABUSE : Label ptr (do end) (integer) */ - /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ - /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ - /* %INWRITE : In_Write_Statement (integer / boolean flag) */ - /* %INPARAM : In_Param_Statement (integer / boolean flag) */ - /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ -/************************************************************************************************/ - -/* CODES AYANT DISPARU : - RENAME_NODE, ONLY_NODE, DEFAULT, LEN_OP, TARGET_OP, - SAVE_OP, POINTER_OP, INTRINSIC_OP, INOUT_OP, OUT_OP, - IN_OP, OPTIONAL_OP, EXTERNAL_OP, DIMENSION_OP, ALLOCATABLE_OP, - PRIVATE_OP, PUBLIC_OP, PARAMETER_OP, MAXPARALLEL_OP, EXTEND_OP, - ORDERED_OP, PAREN_OP, OVERLOADED_CALL, STRUCTURE_CONSTRUCTOR, INTERFACE_REF, - TYPE_REF, KEYWORD_ARG, -*/ - -DEFNODECODE(LEN_OP, "%IF (%LL1 != %NULL)*(%LL1)%ENDIF", -'e',0,LLNODE) -DEFNODECODE(INT_VAL, "%INTKIND", -'c',0,LLNODE) -DEFNODECODE(FLOAT_VAL, "%STRVAL", -'c',0,LLNODE) -DEFNODECODE(DOUBLE_VAL, "%STRVAL", -'c',0,LLNODE) -DEFNODECODE(BOOL_VAL, "%BOOLVAL", -'c',0,LLNODE) -DEFNODECODE(CHAR_VAL, "%IF (%INIMPLI == %NULL)'%ENDIF%CHARVAL%IF (%INIMPLI == %NULL)'%ENDIF", -'c',0,LLNODE) -DEFNODECODE(STRING_VAL, "%IF (%CHECKFLAG(QUOTE) != %NULL)\"%STRVAL\"%ELSE\"%STRVAL\"%ENDIF", -'c',0,LLNODE) -DEFNODECODE(KEYWORD_VAL, "%STRVAL", -'c',0,LLNODE) -DEFNODECODE(COMPLEX_VAL, "(%LL1, %LL2)", -'c',0,LLNODE) - -DEFNODECODE(CONST_REF, "%SYMBID", -'r',2,LLNODE) -DEFNODECODE(VAR_REF, "%IF(%CHECKFLAG(SUBCLASS) != %NULL)%DOPROC%ENDIF%SYMBID%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)<%LL2 >%POPFLAG(PAREN)%ENDIF", -'r',0,LLNODE) -DEFNODECODE(ARRAY_REF, "%SYMBID%IF (%LL1 != %NULL)%PUSHFLAG(ARRAYREF)%SETFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(ARRAYREF)%UNSETFLAG(PAREN)%POPFLAG(PAREN)%POPFLAG(ARRAYREF)%ENDIF", -'r',1,LLNODE) -DEFNODECODE(RECORD_REF, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1.%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'r',2,LLNODE) -DEFNODECODE(ENUM_REF, "%LL1", -'r',2,LLNODE) -DEFNODECODE(LABEL_REF, "%LABELNAME", -'r',0,LLNODE) -DEFNODECODE(TYPE_REF, "%TYPE", -'r',0,LLNODE) -DEFNODECODE(TYPE_OP, "%TYPE", -'e',1,LLNODE) -DEFNODECODE(THROW_OP, "throw %IF(%LL1 != %NULL)%LL1%ENDIF", -'r',2,LLNODE) - -DEFNODECODE(VAR_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(FORDECL_OP, "%VARLISTTY", -'e',2,LLNODE) - -DEFNODECODE(EXPR_LIST, -"%IF(%CHECKFLAG(PAREN)!=%NULL)%IF(%CHECKFLAG(ARRAYREF)!=%NULL)[%ELSE%IF(%CHECKFLAG(ELIST)==%NULL)(%ELSE, %ENDIF%ENDIF%ELSE%IF(%CHECKFLAG(ELIST) != %NULL), %ENDIF%ENDIF%PUSHFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%PUSHFLAG(ELIST)%LL1%POPFLAG(ELIST)%POPFLAG(ARRAYREF)%POPFLAG(PAREN)%IF(%CHECKFLAG(PARAM)!=%NULL) = %L1SYMBCST%ENDIF%IF(%CHECKFLAG(ARRAYREF)!=%NULL)]%ENDIF%IF(%LL2!=%NULL)%IF(%CHECKFLAG(ELIST)==%NULL)%SETFLAG(ELIST)%ENDIF%LL2%ENDIF%IF(%CHECKFLAG(PAREN) != %NULL)%IF(%LL2 == %NULL)%IF(%CHECKFLAG(ARRAYREF) == %NULL))%ENDIF%ENDIF%ENDIF%IF(%LL2 == %NULL)%IF(%CHECKFLAG(ELIST) != %NULL)%UNSETFLAG(ELIST)%ENDIF", -'e',2,LLNODE) - -/* second way (wrong) -DEFNODECODE(EXPR_LIST, -"%IF (%CHECKFLAG(PAREN) != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)[%ELSE(%ENDIF%ENDIF%PUSHFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%POPFLAG(ARRAYREF)%IF (%CHECKFLAG(PARAM) != %NULL) = %L1SYMBCST%ENDIF%IF (%LL2 != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)][%ELSE,%ENDIF%LL2%ENDIF%POPFLAG(PAREN)%IF (%CHECKFLAG(PAREN) != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)]%ELSE)%ENDIF%ENDIF", -'e',2,LLNODE) -*/ -/* -DEFNODECODE(EXPR_LIST, "%PUSHFLAG(ARRAYREF)%LL1%POPFLAG(ARRAYREF)%IF (%CHECKFLAG(PARAM) != %NULL) = %L1SYMBCST%ENDIF%ENDIF%IF (%LL2 != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)][%ELSE,%ENDIF%LL2%ENDIF", -'e',2,LLNODE) -*/ -DEFNODECODE(RANGE_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(CASE_CHOICE, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(DEF_CHOICE, "%LL1%IF (%LL2 != %NULL):%LL2", -'e',2,LLNODE) -DEFNODECODE(VARIANT_CHOICE, "%ERROR", -'e',2,LLNODE) - -DEFNODECODE(DDOT, "%LL1%IF (%INWRITE != %NULL),%ELSE%IF (%INIMPLI != %NULL)-%ELSE%IF (%CHECKFLAG(LOOP) != %NULL),%ELSE:%ENDIF%ENDIF%ENDIF%LL2", -'e',2,LLNODE) -DEFNODECODE(RANGE_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(UPPER_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(LOWER_OP, "%ERROR", -'e',2,LLNODE) - -DEFNODECODE(EQ_OP, "%ORBCPL1%LL1%CRBCPL1 == %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(LT_OP, "%ORBCPL1%LL1%CRBCPL1 < %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(GT_OP, "%ORBCPL1%LL1%CRBCPL1 > %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(NOTEQL_OP, "%ORBCPL1%LL1%CRBCPL1 != %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(LTEQL_OP, "%ORBCPL1%LL1%CRBCPL1 <= %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(GTEQL_OP, "%ORBCPL1%LL1%CRBCPL1 >= %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) - -DEFNODECODE(ADD_OP, "%ORBCPL1%LL1%CRBCPL1 + %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(SUBT_OP, "%ORBCPL1%LL1%CRBCPL1 - %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(OR_OP, "%ORBCPL1%LL1%CRBCPL1 || %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) - -DEFNODECODE(MULT_OP, "%ORBCPL1%LL1%CRBCPL1 * %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(DIV_OP, "%ORBCPL1%LL1%CRBCPL1 / %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(MOD_OP, "%ORBCPL1%LL1%CRBCPL1 %% %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(AND_OP, "%ORBCPL1%LL1%CRBCPL1 && %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) - -DEFNODECODE(EXP_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ARRAY_MULT, "%ERROR", -'e',2,LLNODE) -/*DEFNODECODE(CONCAT_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1//%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'e',2,LLNODE)*/ -DEFNODECODE(CONCAT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(XOR_OP, "%ORBCPL1%LL1%CRBCPL1 ^ %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(EQV_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(NEQV_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(MINUS_OP, "(-%ORBCPL1%LL1%CRBCPL1)", -'e',1,LLNODE) -DEFNODECODE(NOT_OP, "!%ORBCPL1%LL1%CRBCPL1", -'e',2,LLNODE) - -DEFNODECODE(ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 = %PUSHFLAG(VARDECL)%LL2%POPFLAG(VARDECL)", -'e',2,LLNODE) -/* -DEFNODECODE(DEREF_OP, "%IF (%CHECKFLAG(VARDECL) == %NULL)(*%LL1)%ELSE*%LL1%ENDIF", -'e',1,LLNODE) -*/ -DEFNODECODE(DEREF_OP, "%IF (%CHECKFLAG(VARDECL) == %NULL)*%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE*%CNSTCHK%LL1%ENDIF", -'e',1,LLNODE) -DEFNODECODE(ARROWSTAR_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)->*%LL2", -'e',2,LLNODE) -DEFNODECODE(DOTSTAR_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN).*%LL2", -'e',2,LLNODE) -DEFNODECODE(POINTST_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)->%LL2", -'e',2,LLNODE) -DEFNODECODE(SCOPE_OP, "%LL1::%LL2", -'e',2,LLNODE) - -/* should be -DEFNODECODE(FUNCTION_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%IF (%CHECKFLAG(VARDECL) != %NULL)(%VARLISTTY)%ELSE%LL2%ENDIF%POPFLAG(PAREN)", -'e',2,LLNODE) -but the following works for now */ - -DEFNODECODE(FUNCTION_OP, "%PUSHFLAG(PAREN)(%LL1)%PUSHFLAG(FREF)%SETFLAG(FREF)%IF (%CHECKFLAG(VARDECL) != %NULL)(%VARLISTTY)%ELSE%IF(%LL2 != %NULL)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%ELSE()%ENDIF%ENDIF%UNSETFLAG(FREF)%POPFLAG(FREF)%POPFLAG(PAREN)", -'e',2,LLNODE) - -DEFNODECODE(MINUSMINUS_OP, "%IF (%LL2 != %NULL)%ORBCPL2%LL2%CRBCPL2%ENDIF--%IF (%LL1 != %NULL)%ORBCPL1%LL1%CRBCPL1%ENDIF", -'e',2,LLNODE) -DEFNODECODE(PLUSPLUS_OP, "%IF (%LL2 != %NULL)%ORBCPL2%LL2%CRBCPL2%ENDIF++%IF (%LL1 != %NULL)%ORBCPL1%LL1%CRBCPL1%ENDIF", -'e',2,LLNODE) -DEFNODECODE(BITAND_OP, "%ORBCPL1%LL1%CRBCPL1 & %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(BITOR_OP, "%ORBCPL1%LL1%CRBCPL1 | %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) - -DEFNODECODE(PLUS_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 += %LL2", -'e',2,LLNODE) -DEFNODECODE(MINUS_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 -= %LL2", -'e',2,LLNODE) -DEFNODECODE(AND_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 &= %LL2", -'e',2,LLNODE) -DEFNODECODE(IOR_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 |= %LL2", -'e',2,LLNODE) -DEFNODECODE(MULT_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 *= %LL2", -'e',2,LLNODE) -DEFNODECODE(DIV_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 /= %LL2", -'e',2,LLNODE) -DEFNODECODE(MOD_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 %= %LL2", -'e',2,LLNODE) -DEFNODECODE(XOR_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 ^= %LL2", -'e',2,LLNODE) -DEFNODECODE(LSHIFT_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 <<= %LL2", -'e',2,LLNODE) -DEFNODECODE(RSHIFT_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 >>= %LL2", -'e',2,LLNODE) - - -DEFNODECODE(STAR_RANGE, "*", -'e',2,LLNODE) - -DEFNODECODE(PROC_CALL, "%SYMBID%IF(%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", -'e',2,LLNODE) -DEFNODECODE(FUNC_CALL, "%SYMBID%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)<%LL2 >%POPFLAG(PAREN)%ENDIF%IF(%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", -'e',1,LLNODE) -DEFNODECODE(ACC_CALL_OP, "%SYMBID%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)<<<%LL2>>>%POPFLAG(PAREN)%ENDIF%IF(%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", -'e',1,LLNODE) - -DEFNODECODE(CONSTRUCTOR_REF, "(/%LL1/)", -'e',2,LLNODE) -DEFNODECODE(ACCESS_REF, "%LL1%IF (%LL2 != %NULL) (%LL2)%ENDIF", -'e',2,LLNODE) -DEFNODECODE(CONS, "%LL1, %LL2", -'e',2,LLNODE) -DEFNODECODE(ACCESS, "%LL1, FORALL = (%SYMBID = %LL2)", -'e',2,LLNODE) -DEFNODECODE(IOACCESS, "%IF (%LL1 != %NULL)(%LL1, %ENDIF%SYMBID = %LL2%IF (%LL1 != %NULL))%ENDIF", -'e',2,LLNODE) -DEFNODECODE(CONTROL_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(SEQ, "%LL1%IF (%LL2 != %NULL):%LL2", -'e',2,LLNODE) -DEFNODECODE(SPEC_PAIR, "%IF (%CHECKFLAG(PRINT) != %NULL)%LL2%ELSE%LL1 = %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(COMM_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(STMT_STR, "%STRVAL", -'e',2,LLNODE) -DEFNODECODE(EQUI_LIST, "(%LL1)%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(IMPL_TYPE, "%TYPE %IF (%LL1 != %NULL)(%LL1)%ENDIF", -'e',2,LLNODE) -DEFNODECODE(STMTFN_DECL, "%SYMBID (%VARLIST) = %LL1", -'e',2,LLNODE) -DEFNODECODE(BIT_COMPLEMENT_OP, "~%ORBCPL1%LL1%CRBCPL1", -'e',2,LLNODE) -DEFNODECODE(EXPR_IF, "(%LL1)?%LL2", -'e',2,LLNODE) -DEFNODECODE(EXPR_IF_BODY, "%LL1:%LL2", -'e',2,LLNODE) -DEFNODECODE(FUNCTION_REF, "%SETFLAG(FREF)%SYMBID%IF (%CHECKFLAG(VARDECL) != %NULL)%IF(%CHECKFLAG(TMPLDEC) == %NULL)(%VARLISTTY)%CNSTF%PURE%ENDIF%ENDIF%UNSETFLAG(FREF)", -'e',2,LLNODE) -DEFNODECODE(LSHIFT_OP, "%ORBCPL1%LL1%CRBCPL1 << %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(RSHIFT_OP, "%ORBCPL1%LL1%CRBCPL1 >> %ORBCPL2%LL2%CRBCPL2", -'e',2,LLNODE) -DEFNODECODE(UNARY_ADD_OP, "(+(%LL1))", -'e',2,LLNODE) -/* -DEFNODECODE(SIZE_OP, "%IF(%CHECKFLAG(NEW) != %NULL)sizeof(%LL1)%ELSEsizeof %LL1", -'e',2,LLNODE) -*/ -DEFNODECODE(SIZE_OP, "sizeof(%LL1)", -'e',2,LLNODE) -DEFNODECODE(INTEGER_DIV_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1/%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'e',2,LLNODE) -DEFNODECODE(SUB_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1-%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'e',2,LLNODE) -DEFNODECODE(LE_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1<=%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'e',2,LLNODE) -DEFNODECODE(GE_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1>=%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'e',2,LLNODE) -DEFNODECODE(NE_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1!=%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", -'e',2,LLNODE) - -DEFNODECODE(CLASSINIT_OP, "%LL1%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", -'e',2,LLNODE) -/* -DEFNODECODE(CAST_OP, "%IF(%CHECKFLAG(NEW) != %NULL)%IF (%LL2 != %NULL)%PUSHFLAG(VARDECL)%SETFLAG(VARDECL)(%VARLISTTY)%UNSETFLAG(VARDECL)%POPFLAG(VARDECL)%ELSE%SETFLAG(CASTOP)%TYPE%UNSETFLAG(CASTOP)%ENDIF%IF (%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%ELSE%IF (%LL2 != %NULL)%TYPE%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE%SETFLAG(CASTOP)(%TYPE)%UNSETFLAG(CASTOP)%PUSHFLAG(PAREN)%SETFLAG(PAREN) %LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%ENDIF", -'e',2,LLNODE) -*/ -DEFNODECODE(CAST_OP, "%IF (%LL2 != %NULL)%PUSHFLAG(VARDECL)%SETFLAG(VARDECL)(%VARLISTTY)%UNSETFLAG(VARDECL)%POPFLAG(VARDECL)%ELSE%SETFLAG(CASTOP)%TYPE%UNSETFLAG(CASTOP)%ENDIF%IF (%LL1 != %NULL)%ORBCPL1%LL1%CRBCPL1%ENDIF", -'e',2,LLNODE) -DEFNODECODE(ADDRESS_OP, "%IF (%CHECKFLAG(VARDECL) == %NULL)&%ORBCPL1%LL1%CRBCPL1%ELSE&%CNSTCHK%LL1%ENDIF", -'e',1,LLNODE) -/* -DEFNODECODE(ADDRESS_OP, "&(%LL1)", -'e',2,LLNODE) -*/ -DEFNODECODE(POINSTAT_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(COPY_NODE, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(INIT_LIST, "%PUSHFLAG(PAREN){%LL1}%POPFLAG(PAREN)", -'e',2,LLNODE) -DEFNODECODE(VECTOR_CONST, "[%LL1]", -'e',2,LLNODE) -DEFNODECODE(BIT_NUMBER, "%LL1:%LL2", -'e',2,LLNODE) -DEFNODECODE(ARITH_ASSGN_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ARRAY_OP, "%PUSHFLAG(PAREN)(%LL1)%POPFLAG(PAREN)%PUSHFLAG(ARRAYREF)%SETFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(ARRAYREF)%UNSETFLAG(PAREN)%POPFLAG(PAREN)%POPFLAG(ARRAYREF)", -'e',2,LLNODE) -/* -DEFNODECODE(NEW_OP, "%SETFLAG(NEW)new %LL1 %IF (%LL2 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%UNSETFLAG(NEW)", -'e',2,LLNODE) -*/ -DEFNODECODE(NEW_OP, "%SETFLAG(NEW)new %IF (%LL2 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2 %UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%LL1%UNSETFLAG(NEW)", -'e',2,LLNODE) -DEFNODECODE(DELETE_OP, "%IF (%LL2 != %NULL)%SETFLAG(NEW)%ENDIFdelete %IF(%LL2 != %NULL) %LL2 %ENDIF %LL1%IF(%LL2 != %NULL) %UNSETFLAG(NEW)%ENDIF", -'e',2,LLNODE) -DEFNODECODE(NAMELIST_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", -'e',2,LLNODE) -DEFNODECODE(THIS_NODE, "this %LL1", -'e',2,LLNODE) - -/* new tag for some expression -these are tokens not expressions. -I have killed them. dbg. - -DEFNODECODE(CEIL_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(MAX_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIF_SAVE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(MIN_OP, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIF_ADDR_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(BIF_NOP_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(BIF_RTL_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUNC_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUNC_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FLOOR_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FLOOR_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(CEIL_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ROUND_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ROUND_MOD_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RDIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(EXACT_DIV_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(CONVERT_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(CONST_DECL, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(ABS_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_ANDIF_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_AND_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_NOT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_ORIF_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(PREINCREMENT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(PREDECREMENT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(COMPOUND_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FLOAT_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(BIT_IOR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIT_XOR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(BIT_ANDTC_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(TRUTH_OR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_TRUNC_EXPR, "%ERROR", -'e',1,LLNODE) -DEFNODECODE(RROTATE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(LROTATE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RANGE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(POSTDECREMENT_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(REFERENCE_TYPE, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_FLOOR_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_ROUND_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FIX_CEIL_EXPR , "%ERROR", -'e',2,LLNODE) -DEFNODECODE(FUNCTION_DECL , "%ERROR", -'d',2,LLNODE) -DEFNODECODE(MODIFY_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(REFERENCE_EXPR, "%ERROR", -'e',2,LLNODE) -DEFNODECODE(RESULT_DECL, "%ERROR", -'d',2,LLNODE) -DEFNODECODE(PARM_DECL, "%ERROR", -'d',2,LLNODE) -*/ - -/*****************variant tags for symbol table entries********************/ - -DEFNODECODE(BIF_PARM_DECL, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(CONST_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(ENUM_NAME, "enum %SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(FIELD_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(VARIABLE_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(TYPE_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(PROGRAM_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(PROCEDURE_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(VAR_FIELD, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(LABEL_VAR, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(FUNCTION_NAME, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(MEMBER_FUNC, "%ERROR", -'r',0,SYMBNODE) -DEFNODECODE(CLASS_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(TECLASS_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(UNION_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(STRUCT_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(LABEL_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(COLLECTION_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(ROUTINE_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(CONSTRUCT_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(INTERFACE_NAME, "%SYMBID", -'r',0,SYMBNODE) -DEFNODECODE(MODULE_NAME, "%SYMBID", -'r',0,SYMBNODE) -/*****************variant tags for type nodes********************/ - -/***** List of commands for TYPE NODES *****/ - /* %ERROR : Error ; syntax : %ERROR'message' */ - /* %NL : NewLine */ - /* %% : '%' (Percent Sign) */ - /* %TAB : Tab */ - /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - /* %ELSE : Else */ - /* %ENDIF : End of If */ - /* %BASETYPE : Base Type Name Identifier */ - /* %NAMEID : Name Identifier */ - /* %TABNAME : Self Name from Table */ - /* %RANGES : Ranges */ - /* %RANGLL1 : Low Level Node 1 of Ranges */ -/*******************************************/ - -/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for TYPE NODE *****/ - /* %STRCST : String Constant in '' */ - /* == : Equal (operation) */ - /* != : Different (operation) */ - /* %NULL : 0, Integer Constant (or false boolean) */ - /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ -/******************************************************************************************/ - -/* CODES AYANT DISPARU : - T_SEQUENCE, T_EVENT, T_GATE, -*/ - -DEFNODECODE(DEFAULT, "", -'t',0,TYPENODE) -DEFNODECODE(T_INT, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_FLOAT, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_DOUBLE, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_CHAR, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_BOOL, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_STRING, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_COMPLEX, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_LONG, "%TABNAME", -'t',0,TYPENODE) -DEFNODECODE(T_ENUM, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_SUBRANGE, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_LIST, "%ERROR", -'t',0,TYPENODE) -/* -DEFNODECODE(T_ARRAY, "%IF (%CHECKFLAG(CASTOP) == %NULL)%BASETYPE%ELSE%SUBTYPE [%RANGES]%ENDIF", -'t',0,TYPENODE) -*/ -DEFNODECODE(T_ARRAY, "%IF (%CHECKFLAG(CASTOP) == %NULL)%BASETYPE%ELSE%SUBTYPE %PUSHFLAG(ARRAYREF)%SETFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%PUSHFLAG(CASTOP)%PUSHFLAG(NEW)%RANGES%POPFLAG(NEW)%POPFLAG(CASTOP)%UNSETFLAG(PAREN)%UNSETFLAG(ARRAYREF)%POPFLAG(PAREN)%POPFLAG(ARRAYREF)%ENDIF", -'t',0,TYPENODE) -DEFNODECODE(T_RECORD, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_ENUM_FIELD, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_UNKNOWN, "unknown", -'t',0,TYPENODE) -DEFNODECODE(T_VOID, "void ", -'t',0,TYPENODE) -DEFNODECODE(T_DESCRIPT, "%RIDPT%BASETYPE", -'t',0,TYPENODE) -DEFNODECODE(T_FUNCTION, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_POINTER, "%FBASETYPE %IF (%CHECKFLAG(VARDECL) == %NULL)%STAR%ELSE%IF (%CHECKFLAG(CASTOP) != %NULL)%STAR%ELSE%IF (%CHECKFLAG(FREF) != %NULL)%STAR%ENDIF%ENDIF%ENDIF", -'t',0,TYPENODE) -DEFNODECODE(T_UNION, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_STRUCT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(T_CLASS, "--ERROR--CLASS NAME---", -'t',0,TYPENODE) -DEFNODECODE(T_DERIVED_CLASS, "%SYMBID", -'t',0,TYPENODE) -DEFNODECODE(T_DERIVED_TYPE, "%SYMBID", -'t',0,TYPENODE) -DEFNODECODE(T_COLLECTION, "------ERROR-----T_COLLECTION", -'t',0,TYPENODE) -DEFNODECODE(T_DERIVED_COLLECTION, "%SYMBID<%COLLBASE>", -'t',0,TYPENODE) -/* -DEFNODECODE(T_MEMBER_POINTER, "%COLLBASE %IF (%CHECKFLAG(VARDECL) == %NULL)%SYMBID::*%ELSE%IF (%CHECKFLAG(CASTOP) != %NULL)%SYMBID::*%ELSE%IF (%CHECKFLAG(FREF) != %NULL)%SYMBID::*%ENDIF%ENDIF%ENDIF", -'t',0,TYPENODE) i can't solve the problem with %SYMB. something -to do with %SYMBID getting a T_CLASS where it expects a symbol -*/ - -DEFNODECODE(T_MEMBER_POINTER, "%COLLBASE ", 't',0,TYPENODE) -DEFNODECODE(T_DERIVED_TEMPLATE, "%SYMBID%SETFLAG(TMPLDEC)%PUSHFLAG(PAREN)<%TMPLARGS >%POPFLAG(PAREN)%UNSETFLAG(TMPLDEC)", -'t',0,TYPENODE) -/* -DEFNODECODE(T_REFERENCE, "%BASETYPE %IF (%CHECKFLAG(VARDECL) == %NULL)&%ELSE%IF (%CHECKFLAG(FREF) != %NULL)& %ENDIF%ENDIF", -'t',0,TYPENODE) -*/ -DEFNODECODE(T_REFERENCE, "%FBASETYPE %IF (%CHECKFLAG(VARDECL) == %NULL)%STAR%ELSE%IF (%CHECKFLAG(CASTOP) != %NULL)%STAR%ELSE%IF (%CHECKFLAG(FREF) != %NULL)%STAR%ENDIF%ENDIF%ENDIF", -'t',0,TYPENODE) -DEFNODECODE(LOCAL, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(INPUT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(OUTPUT, "%ERROR", -'t',0,TYPENODE) -DEFNODECODE(IO, "%ERROR", -'t',0,TYPENODE) - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseDVM.def b/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseDVM.def deleted file mode 100644 index 8aa7f6c..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/include/unparseDVM.def +++ /dev/null @@ -1,448 +0,0 @@ -/*****************variant tags for DVM nodes*****************************/ - -DEFNODECODE(BLOCK_OP, "%IF(%LL1!=%NULL)WGT_BLOCK(%SYMBID,%LL1)%ELSE%IF(%LL2!=%NULL)MULT_BLOCK(%LL2)%ELSE%IF(%SYMBOL!=%NULL)GEN_BLOCK(%SYMBID)%ELSEBLOCK%ENDIF%ENDIF%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(INDIRECT_OP, "%IF(%LL1!=%NULL)DERIVED(%LL1)%ELSEINDIRECT(%SYMBID)%ENDIF", -'e',1,LLNODE) - -DEFNODECODE(DERIVED_OP, "(%LL1) WITH %LL2", -'e',2,LLNODE) - -DEFNODECODE(DUMMY_REF, "@%SYMBID%IF(%LL1!=%NULL)+%LL1%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(NEW_VALUE_OP, "%IF(%LL1!=%NULL) NEW(%LL1)%ELSE NEW%ENDIF", -'e',1,LLNODE) - -DEFNODECODE(NEW_SPEC_OP, "NEW(%LL1)", -'e',1,LLNODE) - -DEFNODECODE(TEMPLATE_OP, "TEMPLATE", -'e',0,LLNODE) - -DEFNODECODE(PROCESSORS_OP, "PROCESSORS", -'e',0,LLNODE) - -DEFNODECODE(DYNAMIC_OP, "DYNAMIC", -'e',0,LLNODE) - -DEFNODECODE(DIMENSION_OP, "%IF(%CHECKFLAG(DVM) != %NULL)DIMENSION%ELSEdimension%ENDIF(%LL1)", -'e',1,LLNODE) - -DEFNODECODE(SHADOW_OP, "SHADOW (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ALIGN_OP, "ALIGN %IF(%LL1!=%NULL) (%LL1)%ENDIF%IF(%LL2!=%NULL) WITH %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(DISTRIBUTE_OP, "DISTRIBUTE%IF(%LL1!=%NULL) (%LL1)%ENDIF%IF(%LL2!=%NULL) ONTO %LL2%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(REMOTE_ACCESS_OP, "REMOTE_ACCESS (%IF (%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", -'e',1,LLNODE) - -DEFNODECODE(INDIRECT_ACCESS_OP, "INDIRECT_ACCESS (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", -'e',1,LLNODE) - -DEFNODECODE(ACROSS_OP, "ACROSS (%LL1)%IF(%LL2!=%NULL)(%LL2)%ENDIF", -'e',2,LLNODE) - -DEFNODECODE(SHADOW_RENEW_OP, "SHADOW_RENEW (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(SHADOW_START_OP, "SHADOW_START %SYMBID", -'e',0,LLNODE) - -DEFNODECODE(SHADOW_WAIT_OP, "SHADOW_WAIT %SYMBID", -'e',0,LLNODE) - -DEFNODECODE(SHADOW_COMP_OP, "SHADOW_COMPUTE %IF(%LL1!=%NULL)(%LL1)%ENDIF", -'e',1,LLNODE) - -DEFNODECODE(REDUCTION_OP, "REDUCTION (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", -'e',1,LLNODE) - -DEFNODECODE(CONSISTENT_OP, "CONSISTENT (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", -'e',1,LLNODE) - -DEFNODECODE(ACC_PRIVATE_OP, "PRIVATE (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(STAGE_OP, "STAGE (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(COMMON_OP, "COMMON", -'e',0,LLNODE) - -DEFNODECODE(ACC_CUDA_BLOCK_OP, "CUDA_BLOCK (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_TIE_OP, "TIE (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_CUDA_OP, "CUDA", -'e',0,LLNODE) - -DEFNODECODE(ACC_HOST_OP, "HOST", -'e',0,LLNODE) - -DEFNODECODE(ACC_ASYNC_OP, "ASYNC", -'e',0,LLNODE) - -DEFNODECODE(PARALLEL_OP, "PARALLEL", -'e',0,LLNODE) - -DEFNODECODE(ACC_TARGETS_OP, "TARGETS (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_INLOCAL_OP, "INLOCAL (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_LOCAL_OP, "LOCAL%IF(%LL1!=%NULL) (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_OUT_OP, "OUT (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_INOUT_OP, "INOUT (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(ACC_IN_OP, "IN (%LL1)", -'e',1,LLNODE) - -DEFNODECODE(DVM_NEW_VALUE_DIR, "%CMNT!DVM$%PUTTABCOMTNEW_VALUE%IF(%LL1!=%NULL) %LL1%ENDIF", -'s',1,BIFNODE) - -DEFNODECODE(HPF_TEMPLATE_STAT, "%CMNT!DVM$%PUTTABCOMTTEMPLATE%IF(%LL2!=%NULL), %LL2::%ENDIF %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_DYNAMIC_DIR, "%CMNT!DVM$%PUTTABCOMTDYNAMIC %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_INHERIT_DIR, "%CMNT!DVM$%PUTTABCOMTINHERIT %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(HPF_PROCESSORS_STAT, "%CMNT!DVM$%PUTTABCOMTPROCESSORS %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_SHADOW_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW %LL1( %LL2 )%NL", -'s',2,BIFNODE) - -DEFNODECODE(DVM_INDIRECT_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTINDIRECT_GROUP %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_REMOTE_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTREMOTE_GROUP %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_REDUCTION_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTREDUCTION_GROUP %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_CONSISTENT_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_CONSISTENT_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT_GROUP %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_DISTRIBUTE_DIR, "%CMNT!DVM$%PUTTABCOMTDISTRIBUTE%IF(%LL2!=%NULL) (%LL2)%ENDIF%IF(%LL3!=%NULL) ONTO %LL3 %ENDIF :: %LL1%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_REDISTRIBUTE_DIR, "%CMNT!DVM$%PUTTABCOMTREDISTRIBUTE (%LL2)%IF(%LL3!=%NULL) ONTO %LL3%ENDIF :: %LL1%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_ALIGN_DIR, "%CMNT!DVM$%PUTTABCOMTALIGN (%LL2) WITH %LL3 :: %LL1%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_REALIGN_DIR, "%CMNT!DVM$%PUTTABCOMTREALIGN (%LL2) WITH %LL3 :: %LL1%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_PARALLEL_ON_DIR, "%CMNT!DVM$%PUTTABCOMTPARALLEL (%LL3)%IF(%LL1!=%NULL) ON %LL1%ENDIF%IF(%LL2!=%NULL), %LL2%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_PARALLEL_TASK_DIR, "%CMNT!DVM$%PUTTABCOMTPARALLEL (%LL3)%IF(%LL1!=%NULL) ON %LL1%ENDIF%IF(%LL2!=%NULL), %LL2%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_SHADOW_START_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_START %SYMBID%NL", -'s',0,BIFNODE) - -DEFNODECODE(DVM_SHADOW_WAIT_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_WAIT %SYMBID%NL", -'s',0,BIFNODE) - -DEFNODECODE(DVM_SHADOW_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_GROUP %SYMBID ( %LL1 )%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_REDUCTION_START_DIR, "%CMNT!DVM$%PUTTABCOMTREDUCTION_START %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_REDUCTION_WAIT_DIR, "%CMNT!DVM$%PUTTABCOMTREDUCTION_WAIT %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_CONSISTENT_START_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT_START %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_CONSISTENT_WAIT_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT_WAIT %SYMBID%NL", -'s',0,BIFNODE) - -DEFNODECODE(DVM_REMOTE_ACCESS_DIR, "%CMNT!DVM$%PUTTABCOMTREMOTE_ACCESS (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)%NL", -'s',1,BIFNODE) -DEFNODECODE(DVM_TASK_DIR, "%CMNT!DVM$%PUTTABCOMTTASK %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(DVM_MAP_DIR, "%CMNT!DVM$%PUTTABCOMTMAP %LL1 %IF(%LL2 != %NULL)ONTO %LL2%ENDIF%IF(%LL3 != %NULL)BY %LL3%ENDIF%NL", -'s',3,BIFNODE) -DEFNODECODE(DVM_PREFETCH_DIR, "%CMNT!DVM$%PUTTABCOMTPREFETCH %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_RESET_DIR, "%CMNT!DVM$%PUTTABCOMTRESET %SYMBID%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_DEBUG_DIR, "%CMNT!DVM$%PUTTABCOMTDEBUG %LL1 %IF(%LL2!=%NULL)(%LL2)%ENDIF%NL", -'s',2,BIFNODE) -DEFNODECODE(DVM_ENDDEBUG_DIR, "%CMNT!DVM$%PUTTABCOMTEND DEBUG %LL1%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_INTERVAL_DIR, "%CMNT!DVM$%PUTTABCOMTINTERVAL %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(DVM_EXIT_INTERVAL_DIR, "%CMNT!DVM$%PUTTABCOMTEXIT INTERVAL %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(DVM_ENDINTERVAL_DIR, "%CMNT!DVM$%PUTTABCOMTEND INTERVAL%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_TRACEON_DIR, "%CMNT!DVM$%PUTTABCOMTTRACE ON%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_TRACEOFF_DIR, "%CMNT!DVM$%PUTTABCOMTTRACE OFF%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_BARRIER_DIR, "%CMNT!DVM$%PUTTABCOMTBARRIER%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_CHECK_DIR, "%CMNT!DVM$%PUTTABCOMTCHECK (%LL2) :: %LL1%NL", -'s',2,BIFNODE) -DEFNODECODE(DVM_OWN_DIR, "%CMNT!DVM$%PUTTABCOMTOWN%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_ON_DIR, "%CMNT!DVM$%PUTTABCOMTON %LL1%IF(%LL2 != %NULL), %LL2%ENDIF%NL", -'s',2,BIFNODE) -DEFNODECODE(DVM_END_ON_DIR, "%CMNT!DVM$%PUTTABCOMTEND ON%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_TASK_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTTASK_REGION %SYMBID%IF(%LL2 != %NULL), %LL2%ENDIF%NL", -'s',2,BIFNODE) -DEFNODECODE(DVM_END_TASK_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTEND TASK_REGION%NL", -'s',0,BIFNODE) -DEFNODECODE(DVM_POINTER_DIR, "%CMNT!DVM$%PUTTABCOMT%LL3, POINTER(%LL2) :: %LL1%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_F90_DIR, "%CMNT!DVM$%PUTTABCOMTF90 %LL1 = %LL2%NL", -'s',2,BIFNODE) - -DEFNODECODE(DVM_ASYNCHRONOUS_DIR, "%CMNT!DVM$%PUTTABCOMTASYNCHRONOUS %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_ENDASYNCHRONOUS_DIR, "%CMNT!DVM$%PUTTABCOMTEND ASYNCHRONOUS%NL", -'s',0,BIFNODE) - -DEFNODECODE(DVM_ASYNCWAIT_DIR, "%CMNT!DVM$%PUTTABCOMTASYNCWAIT %LL1%NL", -'s',0,BIFNODE) - -DEFNODECODE(DVM_TEMPLATE_CREATE_DIR, "%CMNT!DVM$%PUTTABCOMTTEMPLATE_CREATE (%LL1)%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_TEMPLATE_DELETE_DIR, "%CMNT!DVM$%PUTTABCOMTTEMPLATE_DELETE (%LL1)%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_VAR_DECL, "%CMNT!DVM$%PUTTABCOMT%SETFLAG(VARLEN)%IF(%LL3 != %NULL)%SETFLAG(DVM)%LL3%UNSETFLAG(DVM):: %SETFLAG(PARAM)%LL1%UNSETFLAG(PARAM)%ELSE%SETFLAG(VARDECL) %LL1%UNSETFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARLEN) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(DVM_HEAP_DIR, "%CMNT!DVM$%PUTTABCOMTHEAP %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(DVM_ASYNCID_DIR, "%CMNT!DVM$%PUTTABCOMTASYNCID%IF(%LL2 != %NULL), COMMON::%ENDIF %LL1%NL", -'s',2,BIFNODE) - -DEFNODECODE(DVM_NEW_VALUE_DIR, "%CMNT!DVM$%PUTTABCOMTNEW_VALUE%NL", -'s',0,BIFNODE) - -DEFNODECODE(DVM_IO_MODE_DIR, "%CMNT!DVM$%PUTTABCOMTIO_MODE (%LL1)%NL", -'s',1,BIFNODE) -DEFNODECODE(DVM_SHADOW_ADD_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_ADD (%LL1 = %LL2)%IF(%LL3!=%NULL) INCLUDE_TO %LL3%ENDIF%NL", -'s',3,BIFNODE) -DEFNODECODE(DVM_LOCALIZE_DIR, "%CMNT!DVM$%PUTTABCOMTLOCALIZE (%LL1 => %LL2)%NL", -'s',2,BIFNODE) - -DEFNODECODE(ACC_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTREGION %LL1%NL", -'s',1,BIFNODE) -DEFNODECODE(ACC_END_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTEND REGION%NL", -'s',0,BIFNODE) -DEFNODECODE(ACC_GET_ACTUAL_DIR, "%CMNT!DVM$%PUTTABCOMTGET_ACTUAL%IF(%LL1!=%NULL) (%LL1)%ENDIF%NL", -'s',1,BIFNODE) -DEFNODECODE(ACC_ACTUAL_DIR, "%CMNT!DVM$%PUTTABCOMTACTUAL%IF(%LL1!=%NULL) (%LL1)%ENDIF%NL", -'s',1,BIFNODE) -DEFNODECODE(ACC_CHECKSECTION_DIR, "%CMNT!DVM$%PUTTABCOMTHOSTSECTION%NL", -'s',0,BIFNODE) -DEFNODECODE(ACC_END_CHECKSECTION_DIR,"%CMNT!DVM$%PUTTABCOMTEND HOSTSECTION%NL", -'s',0,BIFNODE) -DEFNODECODE(ACC_ROUTINE_DIR, "%CMNT!DVM$%PUTTABCOMTROUTINE%IF(%LL1!=%NULL), %LL1%ENDIF%NL", -'s',1,BIFNODE) -DEFNODECODE(ACC_DECLARE_DIR, "%CMNT!DVM$%PUTTABCOMTDECLARE %LL1%NL", -'s',1,BIFNODE) - -DEFNODECODE(OMP_NOWAIT, "NOWAIT", -'e',0,LLNODE) -DEFNODECODE(OMP_PRIVATE, "PRIVATE (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_FIRSTPRIVATE, "FIRSTPRIVATE (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_LASTPRIVATE, "LASTPRIVATE (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_THREADPRIVATE, "/%LL1/", -'e',0,LLNODE) -DEFNODECODE(OMP_COPYIN, "COPYIN (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_SHARED, "SHARED (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_DEFAULT, "DEFAULT (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_ORDERED, "ORDERED", -'e',0,LLNODE) -DEFNODECODE(OMP_IF, "IF (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_NUM_THREADS, "NUM_THREADS (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_REDUCTION, "REDUCTION (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_COLLAPSE, "COLLAPSE (%LL1)", -'e',0,LLNODE) -DEFNODECODE(OMP_SCHEDULE, "SCHEDULE (%LL1%IF(%LL2!=%NULL),%LL2%ENDIF)", -'e',0,LLNODE) -DEFNODECODE(OMP_COPYPRIVATE, "COPYPRIVATE (%LL1)", -'e',0,LLNODE) - - -DEFNODECODE(OMP_PARALLEL_DIR, "!$OMP%PUTTABCOMTPARALLEL %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_PARALLEL_DIR, "!$OMP%DECTAB%PUTTABCOMTEND PARALLEL %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_SECTIONS_DIR, "!$OMP%PUTTABCOMTSECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_SECTION_DIR, "!$OMP%PUTTABCOMTSECTION%INCTAB%NL%BLOB1%DECTAB", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_SECTIONS_DIR, "!$OMP%DECTAB%PUTTABCOMTEND SECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_DO_DIR, "!$OMP%PUTTABCOMTDO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_DO_DIR, "!$OMP%PUTTABCOMTEND DO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_SINGLE_DIR, "!$OMP%PUTTABCOMTSINGLE %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_SINGLE_DIR, "!$OMP%DECTAB%PUTTABCOMTEND SINGLE %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_WORKSHARE_DIR, "!$OMP%PUTTABCOMTWORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_WORKSHARE_DIR, "!$OMP%DECTAB%PUTTABCOMTEND WORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_PARALLEL_DO_DIR, "!$OMP%PUTTABCOMTPARALLEL DO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_PARALLEL_DO_DIR, "!$OMP%PUTTABCOMTEND PARALLEL DO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_PARALLEL_SECTIONS_DIR, "!$OMP%PUTTABCOMTPARALLEL SECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_PARALLEL_SECTIONS_DIR, "!$OMP%DECTAB%PUTTABCOMTEND PARALLEL SECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_PARALLEL_WORKSHARE_DIR, "!$OMP%PUTTABCOMTPARALLEL WORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_PARALLEL_WORKSHARE_DIR, "!$OMP%DECTAB%PUTTABCOMTEND PARALLEL WORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_THREADPRIVATE_DIR, "!$OMP%PUTTABCOMTTHREADPRIVATE %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_MASTER_DIR, "!$OMP%PUTTABCOMTMASTER%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_MASTER_DIR, "!$OMP%DECTAB%PUTTABCOMTEND MASTER%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_ORDERED_DIR, "!$OMP%PUTTABCOMTORDERED%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_ORDERED_DIR, "!$OMP%DECTAB%PUTTABCOMTEND ORDERED%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_ATOMIC_DIR, "!$OMP%PUTTABCOMTATOMIC%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_BARRIER_DIR, "!$OMP%PUTTABCOMTBARRIER%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_CRITICAL_DIR, "!$OMP%PUTTABCOMTCRITICAL %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%INCTAB%NL%BLOB1", -'s',3,BIFNODE) - -DEFNODECODE(OMP_END_CRITICAL_DIR, "!$OMP%DECTAB%PUTTABCOMTEND CRITICAL %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(OMP_FLUSH_DIR, "!$OMP%PUTTABCOMTFLUSH %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%NL", -'s',3,BIFNODE) - -DEFNODECODE(RECORD_DECL, "%CMNT%PUTTABtype %IF (%LL1 != %NULL),%LL1::%ENDIF%SYMBID%INCTAB%NL%BLOB1%DECTAB", -'d',0,BIFNODE) - - -/*****************variant tags for SPF nodes*****************************/ -DEFNODECODE(SPF_ANALYSIS_DIR, "%CMNT!$SPF%PUTTABCOMTANALYSIS (%LL1)%NL", -'s',0,BIFNODE) -DEFNODECODE(SPF_PARALLEL_DIR, "%CMNT!$SPF%PUTTABCOMTPARALLEL (%LL1)%NL", -'s',0,BIFNODE) -DEFNODECODE(SPF_TRANSFORM_DIR, "%CMNT!$SPF%PUTTABCOMTTRANSFORM (%LL1)%NL", -'s',0,BIFNODE) -DEFNODECODE(SPF_PARALLEL_REG_DIR, "%CMNT!$SPF%PUTTABCOMTPARALLEL_REG %SYMBID %IF(%LL1 != %NULL), APPLY_REGION(%LL1)%ENDIF%IF(%LL2 != %NULL), APPLY_FRAGMENT(%LL2)%ENDIF%NL", -'s',2,BIFNODE) -DEFNODECODE(SPF_END_PARALLEL_REG_DIR, "%CMNT!$SPF%PUTTABCOMTEND PARALLEL_REG%NL", -'s',0,BIFNODE) -DEFNODECODE(SPF_CHECKPOINT_DIR, "%CMNT!$SPF%PUTTABCOMTCHECKPOINT (%LL1)%NL", -'s',1,BIFNODE) - -DEFNODECODE(SPF_NOINLINE_OP, "NOINLINE", -'e',0,LLNODE) -DEFNODECODE(SPF_FISSION_OP, "FISSION (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_EXPAND_OP, "EXPAND %IF(%LL1 != %NULL)(%LL1)%ENDIF", -'e',1,LLNODE) -DEFNODECODE(SPF_SHRINK_OP, "SHRINK (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_TYPE_OP, "TYPE (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_VARLIST_OP, "VARLIST (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_EXCEPT_OP, "EXCEPT (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_FILES_COUNT_OP, "FILES_COUNT (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_INTERVAL_OP, "INTERVAL (%LL1, %LL2)", -'e',2,LLNODE) -DEFNODECODE(SPF_TIME_OP, "TIME", -'e',0,LLNODE) -DEFNODECODE(SPF_ITER_OP, "ITER", -'e',0,LLNODE) -DEFNODECODE(SPF_FLEXIBLE_OP, "FLEXIBLE", -'e',0,LLNODE) -DEFNODECODE(SPF_PARAMETER_OP, "PARAMETER (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_UNROLL_OP, "UNROLL %IF(%LL1 != %NULL)(%LL1)%ENDIF", -'e',1,LLNODE) -DEFNODECODE(SPF_MERGE_OP, "MERGE", -'e',0,LLNODE) -DEFNODECODE(SPF_COVER_OP, "COVER (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_PROCESS_PRIVATE_OP, "PROCESS_PRIVATE (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_WEIGHT_OP, "WEIGHT (%LL1)", -'e',1,LLNODE) -DEFNODECODE(SPF_CODE_COVERAGE_OP, "CODE_COVERAGE", -'e',0,LLNODE) - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.uni b/projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.uni deleted file mode 100644 index 838baf2..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.uni +++ /dev/null @@ -1,35 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/lib/Makefile (phb) -# -# This makefile recursively calls MAKE in each subdirectory -# - -# What to compile -SUBDIR=oldsrc newsrc - -oldsrc: - cd oldsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -newsrc: - cd newsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -all: oldsrc newsrc - @echo "****** DONE MAKING SUBDIRECTORIES $(SUBDIR) ******" - -clean: - @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES $(SUBDIR) ******" - cd oldsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - cd newsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @echo "****** DONE CLEAN SUBDIRECTORIES $(SUBDIR) ******" - -cleanall: - @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES $(SUBDIR) ******" - cd oldsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall - cd newsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall - @echo "****** DONE CLEANALL SUBDIRECTORIES $(SUBDIR) ******" - -.PHONY: all clean cleanall oldsrc newsrc diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.win b/projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.win deleted file mode 100644 index 1a12396..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/makefile.win +++ /dev/null @@ -1,48 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - - -# sage/lib/Makefile (phb) - -# Valentin Emelianov (4/01/99) - -# -# This makefile recursively calls MAKE in each subdirectory -# - -# What to compile -SUBDIR=oldsrc newsrc - - -all: - @echo "****** RECURSIVELY MAKING SUBDIRECTORIES $(SUBDIR) ******" - @cd oldsrc - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - @cd .. - @cd newsrc - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - @cd .. - @echo "****** DONE MAKING SUBDIRECTORIES $(SUBDIR) ******" - -clean: - @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES $(SUBDIR) ******" - @cd oldsrc - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @cd .. - @cd newsrc - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @cd .. - @echo "****** DONE CLEAN SUBDIRECTORIES $(SUBDIR) ******" - -cleanall: - @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES $(SUBDIR) ******" - @cd oldsrc - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @cd .. - @cd newsrc - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @cd .. - @echo "****** DONE CLEANALL SUBDIRECTORIES $(SUBDIR) ******" - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt deleted file mode 100644 index 51667bc..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt +++ /dev/null @@ -1,16 +0,0 @@ -set(SAGE_SOURCES low_level.c unparse.c) - -if(MSVC_IDE) - foreach(DIR ${DVM_SAGE_INCLUDE_DIRS}) - file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} - "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag") - set(SAGE_HEADERS ${SAGE_HEADERS} ${FILES}) - endforeach() - source_group("Header Files" FILES ${SAGE_HEADERS}) -endif() - -add_library(sage ${SAGE_SOURCES} ${SAGE_HEADERS}) - -target_compile_definitions(sage PRIVATE SYS5) -target_include_directories(sage PUBLIC "${DVM_SAGE_INCLUDE_DIRS}") -set_target_properties(sage PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}") diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/Makefile b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/Makefile deleted file mode 100644 index a8eb6aa..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/Makefile +++ /dev/null @@ -1,83 +0,0 @@ -####################################################################### -## pC++/Sage++ Copyright (C) 1993 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - - -# sage/lib/newsrc/Makefile (phb) - -LSX = .a - -#HP_CFLAGS#CEXTRA = -Aa +z#ENDIF# -#HP_CFLAGS#LSX = .sl#ENDIF# - -SHELL = /bin/sh -CONFIG_ARCH=iris4d - -# ALPHA Sage new lib.a modified by Pete Beckman (2/1/93) - -RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ] -#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF# - -CC = gcc -#CC=cc#ENDIF##USE_CC# - -CXX = g++ -CXX = /usr/WorkShop/usr/bin/DCC -OLDHEADERS = ../../h - -#INSTALLDEST = ../$(CONFIG_ARCH) -INSTALLDEST = ../../../libsage -INSTALL = /bin/cp - -# Directory in which include file can be found -toolbox_include = ../include - -INCLUDE = -I$(OLDHEADERS) -I../include -CFLAGS = $(INCLUDE) -g -Wall $(CEXTRA) -LDFLAGS = -BISON= /usr/freeware/bin/bison -BISON= bison -TOOLBOX_SRC = comments.c low_level.c unparse.c toolsann.c annotate.tab.c - -TOOLBOX_HDR = $(toolbox_include)/macro.h $(toolbox_include)/bif_node.def $(toolbox_include)/type.def $(toolbox_include)/symb.def - -TOOLBOX_OBJ = low_level.o unparse.o - -TOOLBOX_OBJ_ANN = comments.o toolsann.o annotate.tab.o - -all: libsage$(LSX) - -clean: - /bin/rm -f *.o lib*$(LSX) - -low_level.o: low_level.c $(TOOLBOX_HDR) - -unparse.o: unparse.c $(TOOLBOX_HDR) $(toolbox_include)/unparse.def $(toolbox_include)/unparseC++.def - -main.o : main.c - -libsage : libsage$(LSX) - -libsage.a: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) - /bin/rm -f libsage.a - ar qc libsage.a $(TOOLBOX_OBJ) - @if $(RANLIB_TEST) ; then ranlib libsage.a ; \ - else echo "\tNOTE: ranlib not required" ; fi - -libsage.sl: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) - /bin/rm -f libsage.sl - ld -b -s -o libsage.sl $(TOOLBOX_OBJ) - - -install: $(INSTALLDEST)/libsage$(LSX) - -$(INSTALLDEST)/libsage$(LSX): libsage$(LSX) - if [ -d $(INSTALLDEST) ] ; then true; else mkdir $(INSTALLDEST) ;fi - $(INSTALL) libsage$(LSX) $(INSTALLDEST)/libsage$(LSX) - @if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libsage$(LSX) ; \ - else echo "\tNOTE: ranlib not required" ; fi - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c deleted file mode 100644 index 1e2494e..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c +++ /dev/null @@ -1,3145 +0,0 @@ - -/* A Bison parser, made from annotate.y with Bison version GNU Bison version 1.22 - */ - -#define YYBISON 1 /* Identify Bison output. */ - -#define IFDEFA 258 -#define APPLYTO 259 -#define ALABELT 260 -#define SECTIONT 261 -#define SPECIALAF 262 -#define FROMT 263 -#define TOT 264 -#define TOTLABEL 265 -#define TOFUNCTION 266 -#define DefineANN 267 -#define IDENTIFIER 268 -#define TYPENAME 269 -#define SCSPEC 270 -#define TYPESPEC 271 -#define TYPEMOD 272 -#define CONSTANT 273 -#define STRING 274 -#define ELLIPSIS 275 -#define SIZEOF 276 -#define ENUM 277 -#define STRUCT 278 -#define UNION 279 -#define IF 280 -#define ELSE 281 -#define WHILE 282 -#define DO 283 -#define FOR 284 -#define SWITCH 285 -#define CASE 286 -#define DEFAULT_TOKEN 287 -#define BREAK 288 -#define CONTINUE 289 -#define RETURN 290 -#define GOTO 291 -#define ASM 292 -#define CLASS 293 -#define PUBLIC 294 -#define FRIEND 295 -#define ACCESSWORD 296 -#define OVERLOAD 297 -#define OPERATOR 298 -#define COBREAK 299 -#define COLOOP 300 -#define COEXEC 301 -#define LOADEDOPR 302 -#define MULTIPLEID 303 -#define MULTIPLETYPENAME 304 -#define ASSIGN 305 -#define OROR 306 -#define ANDAND 307 -#define EQCOMPARE 308 -#define ARITHCOMPARE 309 -#define LSHIFT 310 -#define RSHIFT 311 -#define UNARY 312 -#define PLUSPLUS 313 -#define MINUSMINUS 314 -#define HYPERUNARY 315 -#define DOUBLEMARK 316 -#define POINTSAT 317 - -extern char* xmalloc(int size); -extern void Message(char *s, int l); -extern void set_up_momentum(int value,int token); -extern void automata_driver(int value); -extern char* copys(char *); - -#line 5 "annotate.y" - -#include "macro.h" -#include - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -#ifdef _NEEDALLOCAH_ -# include -#endif - -#define ON 1 -#define OFF 0 -#define OTHER 2 -#define ID_ONLY 1 -#define RANGE_APPEAR 2 -#define EXCEPTION_ON 4 -#define EXPR_LR 8 -#define VECTOR_CONST_APPEAR 16 -#define ARRAY_OP_NEED 32 -#define TRACEON 0 - -extern POINTER newNode(); - - -#line 35 "annotate.y" -typedef union { - int token ; - char charv ; - char *charp; - PTR_BFND bfnode ; - PTR_LLND ll_node ; - PTR_SYMB symbol ; - PTR_TYPE data_type ; - PTR_HASH hash_entry ; - PTR_LABEL label ; - PTR_BLOB blob_ptr ; - } YYSTYPE; -#line 151 "annotate.y" - char *input_filename; - extern int lastdecl_id; - PTR_LLND ANNOTATE_NODE = NULL; - PTR_BFND ANNOTATIONSCOPE = NULL; - extern PTR_SYMB newSymbol(); - extern PTR_LLND newExpr(); - extern PTR_LLND makeInt(); - static int cur_counter = 0; - static int primary_flag= 0; - PTR_TYPE global_int_annotation = NULL; - extern PTR_LLND Follow_Llnd(); - static int recursive_yylex = OFF; - static int exception_flag = 0; - static PTR_HASH cur_id_entry; - int line_pos_1 = 0; - char *line_pos_fname = 0; - static int old_line = 0; - static int yylineno=0; - static int yyerror(); - PTR_CMNT cur_comment = NULL; - PTR_CMNT new_cur_comment = NULL ; - PTR_HASH look_up_annotate(); - PTR_HASH look_up_type(); - char *STRINGTOPARSE = 0; - int PTTOSTRINGTOPARSE = 0; - int LENSTRINGTOPARSE = 0; - extern PTR_LLND Make_Function_Call(); - static PTR_LLND check_array_id_format(); - static PTR_LLND look_up_section(); - extern PTR_SYMB getSymbolWithName(); /*getSymbolWithName(name, scope)*/ - PTR_SYMB Look_For_Symbol_Ann(); - char AnnExTensionNumber[255]; /* to symbole right for the annotation */ - static int Recog_My_Token(); - static int look_up_specialfunction(); - static char unMYGETC(char c); - static char MYGETC(); - static int map_assgn_op(); - -#ifndef YYLTYPE -typedef - struct yyltype - { - int timestamp; - int first_line; - int first_column; - int last_line; - int last_column; - char *text; - } - yyltype; - -#define YYLTYPE yyltype -#endif - -#ifndef YYDEBUG -#define YYDEBUG 1 -#endif - -#include - -#ifndef __cplusplus -#ifndef __STDC__ -#define const -#endif -#endif - - - -#define YYFINAL 211 -#define YYFLAG -32768 -#define YYNTBASE 85 - -#define YYTRANSLATE(x) ((unsigned)(x) <= 317 ? yytranslate[x] : 114) - -static const char yytranslate[] = { 0, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 83, 2, 84, 2, 70, 59, 2, 81, - 82, 68, 66, 50, 67, 77, 69, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 54, 79, 63, - 51, 62, 53, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 78, 2, 80, 58, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 57, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, - 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, - 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 48, 49, 52, 55, 56, 60, 61, 64, - 65, 71, 72, 73, 74, 75, 76 -}; - -#if YYDEBUG != 0 -static const short yyprhs[] = { 0, - 0, 1, 10, 14, 15, 20, 21, 26, 27, 32, - 39, 41, 44, 49, 52, 55, 56, 58, 59, 64, - 69, 76, 77, 79, 83, 87, 88, 91, 93, 97, - 99, 101, 103, 105, 107, 108, 110, 112, 116, 119, - 123, 124, 126, 130, 132, 134, 136, 138, 140, 142, - 148, 152, 156, 157, 163, 167, 168, 170, 174, 176, - 178, 180, 183, 186, 190, 194, 198, 202, 206, 210, - 214, 218, 222, 226, 230, 234, 238, 242, 248, 252, - 256, 258, 261, 264, 268, 272, 276, 280, 284, 288, - 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, - 334, 338, 342, 344, 346, 348, 352, 356, 358, 359, - 365, 370, 373, 376, 378, 382, 386, 389, 392, 394 -}; - -static const short yyrhs[] = { -1, - 78, 86, 87, 88, 90, 79, 91, 80, 0, 78, - 91, 80, 0, 0, 3, 81, 113, 82, 0, 0, - 5, 81, 113, 82, 0, 0, 4, 81, 89, 82, - 0, 4, 81, 89, 82, 25, 96, 0, 6, 0, - 11, 13, 0, 8, 113, 9, 113, 0, 9, 113, - 0, 10, 113, 0, 0, 92, 0, 0, 7, 81, - 97, 82, 0, 13, 81, 97, 82, 0, 12, 81, - 113, 50, 18, 82, 0, 0, 93, 0, 92, 50, - 93, 0, 16, 13, 94, 0, 0, 51, 108, 0, - 13, 0, 0, 50, 13, 0, 13, 0, 14, 0, - 67, 0, 83, 0, 98, 0, 0, 98, 0, 108, - 0, 98, 50, 108, 0, 78, 80, 0, 78, 100, - 80, 0, 0, 101, 0, 100, 50, 101, 0, 109, - 0, 103, 0, 104, 0, 99, 0, 18, 0, 13, - 0, 102, 54, 102, 54, 102, 0, 102, 54, 102, - 0, 18, 84, 18, 0, 0, 106, 54, 106, 54, - 106, 0, 106, 54, 106, 0, 0, 108, 0, 108, - 84, 108, 0, 108, 0, 105, 0, 110, 0, 95, - 110, 0, 21, 108, 0, 108, 66, 108, 0, 108, - 67, 108, 0, 108, 68, 108, 0, 108, 69, 108, - 0, 108, 70, 108, 0, 108, 61, 108, 0, 108, - 63, 108, 0, 108, 62, 108, 0, 108, 60, 108, - 0, 108, 59, 108, 0, 108, 57, 108, 0, 108, - 58, 108, 0, 108, 56, 108, 0, 108, 55, 108, - 0, 108, 53, 108, 54, 108, 0, 108, 51, 108, - 0, 108, 52, 108, 0, 112, 0, 95, 109, 0, - 21, 109, 0, 109, 66, 109, 0, 109, 67, 109, - 0, 109, 68, 109, 0, 109, 69, 109, 0, 109, - 70, 109, 0, 109, 64, 109, 0, 109, 65, 109, - 0, 109, 61, 109, 0, 109, 63, 109, 0, 109, - 62, 109, 0, 109, 60, 109, 0, 109, 59, 109, - 0, 109, 57, 109, 0, 109, 58, 109, 0, 109, - 56, 109, 0, 109, 55, 109, 0, 109, 53, 96, - 54, 109, 0, 109, 51, 109, 0, 109, 52, 109, - 0, 13, 0, 18, 0, 113, 0, 81, 96, 82, - 0, 81, 1, 82, 0, 99, 0, 0, 110, 81, - 111, 97, 82, 0, 110, 78, 107, 80, 0, 110, - 72, 0, 110, 73, 0, 18, 0, 81, 109, 82, - 0, 81, 1, 82, 0, 112, 72, 0, 112, 73, - 0, 19, 0, 113, 19, 0 -}; - -#endif - -#if YYDEBUG != 0 -static const short yyrline[] = { 0, - 192, 193, 203, 214, 218, 227, 231, 241, 245, 253, - 262, 266, 271, 276, 281, 288, 293, 300, 305, 312, - 319, 330, 334, 339, 348, 367, 371, 380, 387, 393, - 396, 400, 404, 411, 417, 422, 429, 434, 444, 451, - 460, 464, 468, 479, 484, 488, 492, 499, 504, 511, - 519, 526, 534, 538, 544, 551, 555, 561, 566, 567, - 570, 580, 584, 588, 592, 596, 600, 604, 608, 613, - 617, 621, 626, 630, 634, 638, 642, 646, 651, 655, - 663, 671, 675, 679, 683, 687, 691, 695, 699, 703, - 707, 712, 716, 721, 727, 731, 735, 739, 743, 747, - 752, 756, 766, 773, 777, 781, 787, 791, 795, 810, - 851, 875, 880, 891, 897, 903, 907, 911, 918, 923 -}; - -static const char * const yytname[] = { "$","error","$illegal.","IFDEFA","APPLYTO", -"ALABELT","SECTIONT","SPECIALAF","FROMT","TOT","TOTLABEL","TOFUNCTION","DefineANN", -"IDENTIFIER","TYPENAME","SCSPEC","TYPESPEC","TYPEMOD","CONSTANT","STRING","ELLIPSIS", -"SIZEOF","ENUM","STRUCT","UNION","IF","ELSE","WHILE","DO","FOR","SWITCH","CASE", -"DEFAULT_TOKEN","BREAK","CONTINUE","RETURN","GOTO","ASM","CLASS","PUBLIC","FRIEND", -"ACCESSWORD","OVERLOAD","OPERATOR","COBREAK","COLOOP","COEXEC","LOADEDOPR","MULTIPLEID", -"MULTIPLETYPENAME","','","'='","ASSIGN","'?'","':'","OROR","ANDAND","'|'","'^'", -"'&'","EQCOMPARE","ARITHCOMPARE","'>'","'<'","LSHIFT","RSHIFT","'+'","'-'","'*'", -"'/'","'%'","UNARY","PLUSPLUS","MINUSMINUS","HYPERUNARY","DOUBLEMARK","POINTSAT", -"'.'","'['","';'","']'","'('","')'","'!'","'#'","annotation","IfDefR","Alabel", -"ApplyTo","section","LocalDeclare","Expression_List","declare_local_list","onedeclare", -"domain","unop","expr","exprlist","nonnull_exprlist","vector_constant","vector_list", -"single_v_expr","element","triplet","compound_constant","array_expr_a","expr_no_commas_1", -"expr_vector","expr_no_commas","const_expr_no_commas","primary","@1","const_primary", -"string","@1" -}; -#endif - -static const short yyr1[] = { 0, - 85, 85, 85, 86, 86, 87, 87, 88, 88, 88, - 89, 89, 89, 89, 89, 90, 90, 91, 91, 91, - 91, 92, 92, 92, 93, 94, 94, -1, -1, -1, - -1, 95, 95, 96, 97, 97, 98, 98, 99, 99, - 100, 100, 100, 101, 101, 101, 101, 102, 102, 103, - 103, 104, 105, 105, 105, 106, 106, -1, 107, 107, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, - 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, - 109, 109, 110, 110, 110, 110, 110, 110, 111, 110, - 110, 110, 110, 112, 112, 112, 112, 112, 113, 113 -}; - -static const short yyr2[] = { 0, - 0, 8, 3, 0, 4, 0, 4, 0, 4, 6, - 1, 2, 4, 2, 2, 0, 1, 0, 4, 4, - 6, 0, 1, 3, 3, 0, 2, 1, 3, 1, - 1, 1, 1, 1, 0, 1, 1, 3, 2, 3, - 0, 1, 3, 1, 1, 1, 1, 1, 1, 5, - 3, 3, 0, 5, 3, 0, 1, 3, 1, 1, - 1, 2, 2, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 5, 3, 3, - 1, 2, 2, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, - 3, 3, 1, 1, 1, 3, 3, 1, 0, 5, - 4, 2, 2, 1, 3, 3, 2, 2, 1, 2 -}; - -static const short yydefact[] = { 1, - 4, 0, 0, 0, 0, 6, 0, 0, 35, 0, - 35, 0, 8, 3, 119, 0, 103, 104, 0, 32, - 41, 0, 33, 0, 0, 36, 108, 37, 61, 105, - 0, 0, 0, 0, 16, 120, 5, 63, 49, 114, - 0, 39, 0, 0, 47, 0, 42, 0, 45, 46, - 44, 81, 0, 0, 34, 62, 19, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 112, 113, 53, 109, 0, - 20, 0, 0, 0, 0, 17, 23, 0, 114, 83, - 0, 0, 82, 0, 40, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 117, 118, 107, 106, 38, - 79, 80, 0, 77, 76, 74, 75, 73, 72, 69, - 71, 70, 64, 65, 66, 67, 68, 60, 0, 0, - 57, 35, 0, 7, 11, 0, 0, 0, 0, 0, - 26, 18, 0, 52, 116, 115, 43, 48, 51, 101, - 102, 0, 99, 98, 96, 97, 95, 94, 91, 93, - 92, 89, 90, 84, 85, 86, 87, 88, 0, 56, - 111, 0, 21, 0, 14, 15, 12, 9, 0, 25, - 0, 24, 0, 0, 78, 55, 57, 110, 0, 0, - 27, 2, 50, 100, 56, 13, 10, 54, 0, 0, - 0 -}; - -static const short yydefgoto[] = { 209, - 6, 13, 35, 150, 85, 7, 86, 87, 190, 24, - 54, 25, 26, 27, 46, 47, 48, 49, 50, 138, - 139, 140, 28, 51, 29, 142, 52, 30 -}; - -static const short yypact[] = { -55, - 61, -51, -50, -43, -16, 72, 4, 84, 155, 84, - 155, 24, 104,-32768,-32768, -10,-32768,-32768, 155,-32768, - 164, 133,-32768, -3, 35, 86,-32768, 295, 29, 118, - 13, 60, 84, 63, 8,-32768,-32768,-32768,-32768, -17, - 168,-32768, 142, 168,-32768, -14,-32768, 93,-32768,-32768, - 255, -53, 66, 67, 86, 29,-32768, 155, 155, 155, - 155, 155, 155, 155, 155, 155, 155, 155, 155, 155, - 155, 155, 155, 155, 155,-32768,-32768, 151,-32768, 147, --32768, -6, 103, 153, 88, 125,-32768, 160,-32768,-32768, - 98, 201,-32768, 132,-32768, 9, 168, 168, 155, 168, - 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, - 168, 168, 168, 168, 168,-32768,-32768,-32768,-32768, 295, - 295, 333, 275, 399, 427, 453, 477, 499, 519, 89, - 89, 89, -35, -35,-32768,-32768,-32768,-32768, 129, 108, - 229, 155, 102,-32768,-32768, 84, 84, 84, 177, 119, - 152, 5, 186,-32768,-32768,-32768,-32768,-32768, 150, 255, - 314, 154, 384, 413, 440, 465, 488, 509, 128, 128, - 128, 206, 206, 1, 1,-32768,-32768,-32768, 155, 155, --32768, 124,-32768, 2, 118, 118,-32768, 182, 155,-32768, - 137,-32768, 9, 168, 369, 165, 295,-32768, 84, 155, - 295,-32768,-32768, 351, 155, 118,-32768,-32768, 220, 221, --32768 -}; - -static const short yypgoto[] = {-32768, --32768,-32768,-32768,-32768,-32768, 74,-32768, 71,-32768, -15, - -94, -7, -19, -13,-32768, 134, -89,-32768,-32768,-32768, - -166,-32768, -18, 18, 203,-32768,-32768, -8 -}; - - -#define YYLAST 589 - - -static const short yytable[] = { 16, - 38, 31, 55, 32, 162, 44, 159, 45, 36, 17, - 199, 3, 36, 196, 18, 15, 4, 5, 116, 117, - 36, 39, 1, 84, 82, 44, 158, 44, 44, 8, - 9, 36, 73, 74, 75, 94, -48, 10, 208, 120, - 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, - 131, 132, 133, 134, 135, 136, 137, -22, 90, 141, - 92, 93, 80, 2, 11, 95, 88, 3, 113, 114, - 115, 37, 4, 5, 21, 144, 12, 22, 44, 55, - 45, 44, 44, 14, 44, 44, 44, 44, 44, 44, - 44, 44, 44, 44, 44, 44, 44, 44, 44, 44, - 76, 77, 15, 203, 33, 207, 78, 34, 145, 79, - 146, 147, 148, 149, 160, 161, 57, 163, 164, 165, - 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, - 176, 177, 178, 53, 182, 58, 36, 184, 185, 186, - -18, 81, 91, 83, 39, 17, 96, 118, 119, 40, - 18, 15, 41, 19, 71, 72, 73, 74, 75, 89, - 195, 197, 41, 17, 143, 151, 152, 17, 18, 15, - 201, 19, 18, 15, 153, 19, 39, 154, 44, 155, - 55, 40, 180, 183, 41, 89, 197, 181, 41, 187, - 206, 109, 110, 111, 112, 113, 114, 115, 20, 20, - 188, 84, 189, 193, -56, 198, 200, 194, 20, 21, - 21, 204, 43, 22, 23, 23, 202, 20, 205, 210, - 211, 20, 43, 192, 23, 191, 56, 157, 21, 0, - 20, 22, 21, 23, 20, 22, 0, 23, 0, 0, - 0, 21, 0, 42, 43, 0, 23, 0, 43, 0, - 23, 97, 98, 99, 0, 100, 101, 102, 103, 104, - 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, - 115, 111, 112, 113, 114, 115, 0, 0, 0, 59, - 60, 61, 156, 62, 63, 64, 65, 66, 67, 68, - 69, 70, 0, 0, 71, 72, 73, 74, 75, 0, - 0, 0, 0, 0, 0, 97, 98, 99, -59, 100, - 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, - 111, 112, 113, 114, 115, 59, 60, 61, 179, 62, - 63, 64, 65, 66, 67, 68, 69, 70, 0, 0, - 71, 72, 73, 74, 75, 59, 60, 61, 0, 62, - 63, 64, 65, 66, 67, 68, 69, 70, 0, 0, - 71, 72, 73, 74, 75, 98, 99, 0, 100, 101, - 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, - 112, 113, 114, 115, 60, 61, 0, 62, 63, 64, - 65, 66, 67, 68, 69, 70, 0, 0, 71, 72, - 73, 74, 75, 99, 0, 100, 101, 102, 103, 104, - 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, - 115, 61, 0, 62, 63, 64, 65, 66, 67, 68, - 69, 70, 0, 0, 71, 72, 73, 74, 75, 101, - 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, - 112, 113, 114, 115, 63, 64, 65, 66, 67, 68, - 69, 70, 0, 0, 71, 72, 73, 74, 75, 102, - 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, - 113, 114, 115, 64, 65, 66, 67, 68, 69, 70, - 0, 0, 71, 72, 73, 74, 75, 103, 104, 105, - 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, - 65, 66, 67, 68, 69, 70, 0, 0, 71, 72, - 73, 74, 75, 104, 105, 106, 107, 108, 109, 110, - 111, 112, 113, 114, 115, 66, 67, 68, 69, 70, - 0, 0, 71, 72, 73, 74, 75, 105, 106, 107, - 108, 109, 110, 111, 112, 113, 114, 115, 67, 68, - 69, 70, 0, 0, 71, 72, 73, 74, 75, 106, - 107, 108, 109, 110, 111, 112, 113, 114, 115, 68, - 69, 70, 0, 0, 71, 72, 73, 74, 75 -}; - -static const short yycheck[] = { 8, - 19, 10, 22, 11, 99, 21, 96, 21, 19, 13, - 9, 7, 19, 180, 18, 19, 12, 13, 72, 73, - 19, 13, 78, 16, 33, 41, 18, 43, 44, 81, - 81, 19, 68, 69, 70, 50, 54, 81, 205, 58, - 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, - 69, 70, 71, 72, 73, 74, 75, 50, 41, 78, - 43, 44, 50, 3, 81, 80, 84, 7, 68, 69, - 70, 82, 12, 13, 78, 82, 5, 81, 94, 99, - 94, 97, 98, 80, 100, 101, 102, 103, 104, 105, - 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, - 72, 73, 19, 193, 81, 200, 78, 4, 6, 81, - 8, 9, 10, 11, 97, 98, 82, 100, 101, 102, - 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, - 113, 114, 115, 1, 142, 50, 19, 146, 147, 148, - 80, 82, 1, 81, 13, 13, 54, 82, 82, 18, - 18, 19, 21, 21, 66, 67, 68, 69, 70, 18, - 179, 180, 21, 13, 18, 13, 79, 13, 18, 19, - 189, 21, 18, 19, 50, 21, 13, 18, 194, 82, - 200, 18, 54, 82, 21, 18, 205, 80, 21, 13, - 199, 64, 65, 66, 67, 68, 69, 70, 67, 67, - 82, 16, 51, 54, 54, 82, 25, 54, 67, 78, - 78, 194, 81, 81, 83, 83, 80, 67, 54, 0, - 0, 67, 81, 153, 83, 152, 24, 94, 78, -1, - 67, 81, 78, 83, 67, 81, -1, 83, -1, -1, - -1, 78, -1, 80, 81, -1, 83, -1, 81, -1, - 83, 51, 52, 53, -1, 55, 56, 57, 58, 59, - 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, - 70, 66, 67, 68, 69, 70, -1, -1, -1, 51, - 52, 53, 82, 55, 56, 57, 58, 59, 60, 61, - 62, 63, -1, -1, 66, 67, 68, 69, 70, -1, - -1, -1, -1, -1, -1, 51, 52, 53, 80, 55, - 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, - 66, 67, 68, 69, 70, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, - 66, 67, 68, 69, 70, 51, 52, 53, -1, 55, - 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, - 66, 67, 68, 69, 70, 52, 53, -1, 55, 56, - 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, - 67, 68, 69, 70, 52, 53, -1, 55, 56, 57, - 58, 59, 60, 61, 62, 63, -1, -1, 66, 67, - 68, 69, 70, 53, -1, 55, 56, 57, 58, 59, - 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, - 70, 53, -1, 55, 56, 57, 58, 59, 60, 61, - 62, 63, -1, -1, 66, 67, 68, 69, 70, 56, - 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, - 67, 68, 69, 70, 56, 57, 58, 59, 60, 61, - 62, 63, -1, -1, 66, 67, 68, 69, 70, 57, - 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, - 68, 69, 70, 57, 58, 59, 60, 61, 62, 63, - -1, -1, 66, 67, 68, 69, 70, 58, 59, 60, - 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, - 58, 59, 60, 61, 62, 63, -1, -1, 66, 67, - 68, 69, 70, 59, 60, 61, 62, 63, 64, 65, - 66, 67, 68, 69, 70, 59, 60, 61, 62, 63, - -1, -1, 66, 67, 68, 69, 70, 60, 61, 62, - 63, 64, 65, 66, 67, 68, 69, 70, 60, 61, - 62, 63, -1, -1, 66, 67, 68, 69, 70, 61, - 62, 63, 64, 65, 66, 67, 68, 69, 70, 61, - 62, 63, -1, -1, 66, 67, 68, 69, 70 -}; -/* -*-C-*- Note some compilers choke on comments on `#line' lines. */ -#line 3 "/usr/local/lib/bison.simple" - -/* Skeleton output parser for bison, - Copyright (C) 1984, 1989, 1990 Bob Corbett and Richard Stallman - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 1, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ - - -#ifndef alloca - #ifdef __GNUC__ - #define alloca __builtin_alloca - #else /* not GNU C. */ - #if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi) - #include - #else /* not sparc */ - #if defined (_WIN32 ) && !defined (__TURBOC__) - #include - #else /* not MSDOS, or __TURBOC__ */ - #if defined(_AIX) - #include - #pragma alloca - #else /* not MSDOS, __TURBOC__, or _AIX */ - #ifdef __hpux - #ifdef __cplusplus - extern "C" { - void *alloca (unsigned int); - }; - #else /* not __cplusplus */ - void *alloca (); - #endif /* not __cplusplus */ - #endif /* __hpux */ - #endif /* not _AIX */ - #endif /* not MSDOS, or __TURBOC__ */ - #endif /* not sparc. */ - #endif /* not GNU C. */ -#endif /* alloca not defined. */ - -/* This is the parser code that is written into each bison parser - when the %semantic_parser declaration is not specified in the grammar. - It was written by Richard Stallman by simplifying the hairy parser - used when %semantic_parser is specified. */ - -/* Note: there must be only one dollar sign in this file. - It is replaced by the list of actions, each action - as one case of the switch. */ - -#define yyerrok (yyerrstatus = 0) -#define yyclearin (yychar = YYEMPTY) -#define YYEMPTY -2 -#define YYEOF 0 -#define YYACCEPT return(0) -#define YYABORT return(1) -#define YYERROR goto yyerrlab1 -/* Like YYERROR except do call yyerror. - This remains here temporarily to ease the - transition to the new meaning of YYERROR, for GCC. - Once GCC version 2 has supplanted version 1, this can go. */ -#define YYFAIL goto yyerrlab -#define YYRECOVERING() (!!yyerrstatus) -#define YYBACKUP(token, value) \ -do \ - if (yychar == YYEMPTY && yylen == 1) \ - { yychar = (token), yylval = (value); \ - yychar1 = YYTRANSLATE (yychar); \ - YYPOPSTACK; \ - goto yybackup; \ - } \ - else \ - { yyerror ("syntax error: cannot back up"); YYERROR; } \ -while (0) - -#define YYTERROR 1 -#define YYERRCODE 256 - -#ifndef YYPURE -int yylex_annotate(); -#define YYLEX yylex_annotate() -#endif - -#ifdef YYPURE -#ifdef YYLSP_NEEDED -#define YYLEX yylex(&yylval, &yylloc) -#else -#define YYLEX yylex(&yylval) -#endif -#endif - -/* If nonreentrant, generate the variables here */ - -#ifndef YYPURE - -static int yychar; /* the lookahead symbol */ -static YYSTYPE yylval; /* the semantic value of the */ - /* lookahead symbol */ - -#ifdef YYLSP_NEEDED -YYLTYPE yylloc; /* location data for the lookahead */ - /* symbol */ -#endif - -static int yynerrs; /* number of parse errors so far */ -#endif /* not YYPURE */ - -#if YYDEBUG != 0 -static int yydebug; /* nonzero means print parse trace */ -/* Since this is uninitialized, it does not stop multiple parsers - from coexisting. */ -#endif - -/* YYINITDEPTH indicates the initial size of the parser's stacks */ - -#ifndef YYINITDEPTH -#define YYINITDEPTH 200 -#endif - -/* YYMAXDEPTH is the maximum size the stacks can grow to - (effective only if the built-in stack extension method is used). */ - -#if YYMAXDEPTH == 0 -#undef YYMAXDEPTH -#endif - -#ifndef YYMAXDEPTH -#define YYMAXDEPTH 10000 -#endif - -/* Prevent warning if -Wstrict-prototypes. */ -#ifdef __GNUC__ -int yyparse_annotate(void); -#endif - -#if __GNUC__ > 1 /* GNU C and GNU C++ define this. */ -#define __yy_bcopy(FROM,TO,COUNT) __builtin_memcpy(TO,FROM,COUNT) -#else /* not GNU C or C++ */ -#ifndef __cplusplus - -/* This is the most reliable way to avoid incompatibilities - in available built-in functions on various systems. */ -static void -__yy_bcopy (from, to, count) - char *from; - char *to; - int count; -{ - register char *f = from; - register char *t = to; - register int i = count; - - while (i-- > 0) - *t++ = *f++; -} - -#else /* __cplusplus */ - -/* This is the most reliable way to avoid incompatibilities - in available built-in functions on various systems. */ -static void -__yy_bcopy (char *from, char *to, int count) -{ - register char *f = from; - register char *t = to; - register int i = count; - - while (i-- > 0) - *t++ = *f++; -} - -#endif -#endif - -#line 184 "/usr/local/lib/bison.simple" -int -yyparse_annotate() -{ - register int yystate; - register int yyn; - register short *yyssp; - register YYSTYPE *yyvsp; - int yyerrstatus; /* number of tokens to shift before error messages enabled */ - int yychar1 = 0; /* lookahead token as an internal (translated) token number */ - - short yyssa[YYINITDEPTH]; /* the state stack */ - YYSTYPE yyvsa[YYINITDEPTH]; /* the semantic value stack */ - - short *yyss = yyssa; /* refer to the stacks thru separate pointers */ - YYSTYPE *yyvs = yyvsa; /* to allow yyoverflow to reallocate them elsewhere */ - -#ifdef YYLSP_NEEDED - YYLTYPE yylsa[YYINITDEPTH]; /* the location stack */ - YYLTYPE *yyls = yylsa; - YYLTYPE *yylsp; - -#define YYPOPSTACK (yyvsp--, yyssp--, yylsp--) -#else -#define YYPOPSTACK (yyvsp--, yyssp--) -#endif - - int yystacksize = YYINITDEPTH; - -#ifdef YYPURE - int yychar; - YYSTYPE yylval; - int yynerrs; -#ifdef YYLSP_NEEDED - YYLTYPE yylloc; -#endif -#endif - - YYSTYPE yyval; /* the variable used to return */ - /* semantic values from the action */ - /* routines */ - - int yylen; - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Starting parse\n"); -#endif - - yystate = 0; - yyerrstatus = 0; - yynerrs = 0; - yychar = YYEMPTY; /* Cause a token to be read. */ - - /* Initialize stack pointers. - Waste one element of value and location stack - so that they stay on the same level as the state stack. - The wasted elements are never initialized. */ - - yyssp = yyss - 1; - yyvsp = yyvs; -#ifdef YYLSP_NEEDED - yylsp = yyls; -#endif - -/* Push a new state, which is found in yystate . */ -/* In all cases, when you get here, the value and location stacks - have just been pushed. so pushing a state here evens the stacks. */ -yynewstate: - - *++yyssp = yystate; - - if (yyssp >= yyss + yystacksize - 1) - { - /* Give user a chance to reallocate the stack */ - /* Use copies of these so that the &'s don't force the real ones into memory. */ - YYSTYPE *yyvs1 = yyvs; - short *yyss1 = yyss; -#ifdef YYLSP_NEEDED - YYLTYPE *yyls1 = yyls; -#endif - - /* Get the current used size of the three stacks, in elements. */ - int size = yyssp - yyss + 1; - -#ifdef yyoverflow - /* Each stack pointer address is followed by the size of - the data in use in that stack, in bytes. */ -#ifdef YYLSP_NEEDED - /* This used to be a conditional around just the two extra args, - but that might be undefined if yyoverflow is a macro. */ - yyoverflow("parser stack overflow", - &yyss1, size * sizeof (*yyssp), - &yyvs1, size * sizeof (*yyvsp), - &yyls1, size * sizeof (*yylsp), - &yystacksize); -#else - yyoverflow("parser stack overflow", - &yyss1, size * sizeof (*yyssp), - &yyvs1, size * sizeof (*yyvsp), - &yystacksize); -#endif - - yyss = yyss1; yyvs = yyvs1; -#ifdef YYLSP_NEEDED - yyls = yyls1; -#endif -#else /* no yyoverflow */ - /* Extend the stack our own way. */ - if (yystacksize >= YYMAXDEPTH) - { - yyerror("parser stack overflow"); - return 2; - } - yystacksize *= 2; - if (yystacksize > YYMAXDEPTH) - yystacksize = YYMAXDEPTH; - yyss = (short *) alloca (yystacksize * sizeof (*yyssp)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,yyss, 0); -#endif - __yy_bcopy ((char *)yyss1, (char *)yyss, size * sizeof (*yyssp)); - yyvs = (YYSTYPE *) alloca (yystacksize * sizeof (*yyvsp)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,yyvs, 0); -#endif - __yy_bcopy ((char *)yyvs1, (char *)yyvs, size * sizeof (*yyvsp)); -#ifdef YYLSP_NEEDED - yyls = (YYLTYPE *) alloca (yystacksize * sizeof (*yylsp)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,yyls, 0); -#endif - __yy_bcopy ((char *)yyls1, (char *)yyls, size * sizeof (*yylsp)); -#endif -#endif /* no yyoverflow */ - - yyssp = yyss + size - 1; - yyvsp = yyvs + size - 1; -#ifdef YYLSP_NEEDED - yylsp = yyls + size - 1; -#endif - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Stack size increased to %d\n", yystacksize); -#endif - - if (yyssp >= yyss + yystacksize - 1) - YYABORT; - } - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Entering state %d\n", yystate); -#endif - - goto yybackup; - yybackup: - -/* Do appropriate processing given the current state. */ -/* Read a lookahead token if we need one and don't already have one. */ -/* yyresume: */ - - /* First try to decide what to do without reference to lookahead token. */ - - yyn = yypact[yystate]; - if (yyn == YYFLAG) - goto yydefault; - - /* Not known => get a lookahead token if don't already have one. */ - - /* yychar is either YYEMPTY or YYEOF - or a valid token in external form. */ - - if (yychar == YYEMPTY) - { -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Reading a token: "); -#endif - yychar = YYLEX; - } - - /* Convert token to internal form (in yychar1) for indexing tables with */ - - if (yychar <= 0) /* This means end of input. */ - { - yychar1 = 0; - yychar = YYEOF; /* Don't call YYLEX any more */ - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Now at end of input.\n"); -#endif - } - else - { - yychar1 = YYTRANSLATE(yychar); - -#if YYDEBUG != 0 - if (yydebug) - { - fprintf (stderr, "Next token is %d (%s", yychar, yytname[yychar1]); - /* Give the individual parser a way to print the precise meaning - of a token, for further debugging info. */ -#ifdef YYPRINT - YYPRINT (stderr, yychar, yylval); -#endif - fprintf (stderr, ")\n"); - } -#endif - } - - yyn += yychar1; - if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != yychar1) - goto yydefault; - - yyn = yytable[yyn]; - - /* yyn is what to do for this token type in this state. - Negative => reduce, -yyn is rule number. - Positive => shift, yyn is new state. - New state is final state => don't bother to shift, - just return success. - 0, or most negative number => error. */ - - if (yyn < 0) - { - if (yyn == YYFLAG) - goto yyerrlab; - yyn = -yyn; - goto yyreduce; - } - else if (yyn == 0) - goto yyerrlab; - - if (yyn == YYFINAL) - YYACCEPT; - - /* Shift the lookahead token. */ - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Shifting token %d (%s), ", yychar, yytname[yychar1]); -#endif - - /* Discard the token being shifted unless it is eof. */ - if (yychar != YYEOF) - yychar = YYEMPTY; - - *++yyvsp = yylval; -#ifdef YYLSP_NEEDED - *++yylsp = yylloc; -#endif - - /* count tokens shifted since error; after three, turn off error status. */ - if (yyerrstatus) yyerrstatus--; - - yystate = yyn; - goto yynewstate; - -/* Do the default action for the current state. */ -yydefault: - - yyn = yydefact[yystate]; - if (yyn == 0) - goto yyerrlab; - -/* Do a reduction. yyn is the number of a rule to reduce with. */ -yyreduce: - yylen = yyr2[yyn]; - if (yylen > 0) - yyval = yyvsp[1-yylen]; /* implement default value of the action */ - -#if YYDEBUG != 0 - if (yydebug) - { - int i; - - fprintf (stderr, "Reducing via rule %d (line %d), ", - yyn, yyrline[yyn]); - - /* Print the symbols being reduced, and their result. */ - for (i = yyprhs[yyn]; yyrhs[i] > 0; i++) - fprintf (stderr, "%s ", yytname[yyrhs[i]]); - fprintf (stderr, " -> %s\n", yytname[yyr1[yyn]]); - } -#endif - - - switch (yyn) { - -case 2: -#line 194 "annotate.y" -{ - ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,yyvsp[-6].ll_node, - newExpr(EXPR_LIST,NULL,yyvsp[-5].ll_node, - newExpr(EXPR_LIST,NULL,yyvsp[-4].ll_node, - newExpr(EXPR_LIST,NULL,yyvsp[-3].ll_node, - newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,NULL))))); - if (TRACEON) - printf("Recognized ANNOTATION\n"); - ; - break;} -case 3: -#line 204 "annotate.y" -{ - ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,NULL))))); - if (TRACEON) printf("Recognized ANNOTATION\n"); - ; - break;} -case 4: -#line 215 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 5: -#line 219 "annotate.y" -{ - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"IfDef", NULL); - yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); - if (TRACEON) printf("Recognized IFDEFA \n"); - ; - break;} -case 6: -#line 228 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 7: -#line 232 "annotate.y" -{ - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"Label", NULL); - yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); - if (TRACEON) printf("Recognized IFDEFA \n"); - if (TRACEON) printf("Recognized ALABEL\n"); - ; - break;} -case 8: -#line 242 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 9: -#line 246 "annotate.y" -{ - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); - yyval.ll_node = Make_Function_Call (ids,NULL,2,yyvsp[-1].ll_node, NULL); - if (TRACEON) printf("Recognized APPLYTO \n"); - ; - break;} -case 10: -#line 254 "annotate.y" -{ - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); - yyval.ll_node = Make_Function_Call (ids,NULL,2,yyvsp[-3].ll_node,yyvsp[0].ll_node); - if (TRACEON) printf("Recognized APPLYTO \n"); - ; - break;} -case 11: -#line 263 "annotate.y" -{ /* SECTIONT return a string_val llnd */ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 12: -#line 267 "annotate.y" -{ - - yyval.ll_node = newExpr(VAR_REF,NULL,yyvsp[0].hash_entry); - ; - break;} -case 13: -#line 272 "annotate.y" -{ - yyval.ll_node = newExpr(EXPR_LIST,NULL,yyvsp[-2].ll_node, - newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL)); - ; - break;} -case 14: -#line 277 "annotate.y" -{ - yyval.ll_node = newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL)); - ; - break;} -case 15: -#line 282 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 16: -#line 289 "annotate.y" -{ - if (TRACEON) printf("Recognized LocalDeclare\n"); - yyval.ll_node = NULL; - ; - break;} -case 17: -#line 294 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - if (TRACEON) printf("Recognized declare_local_list\n"); - ; - break;} -case 18: -#line 301 "annotate.y" -{ - yyval.ll_node = NULL; - if (TRACEON) printf("Recognized empty expr\n"); - ; - break;} -case 19: -#line 306 "annotate.y" -{ /* for Key word like parallel loop and so on */ - PTR_SYMB ids = NULL; - ids = Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[-3].hash_entry,global_int_annotation); - yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); - if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); - ; - break;} -case 20: -#line 313 "annotate.y" -{ /* for Key word like parallel loop and so on */ - PTR_SYMB ids = NULL; - ids = Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[-3].hash_entry,global_int_annotation); - yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); - if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); - ; - break;} -case 21: -#line 320 "annotate.y" -{ /* for Key word like parallel loop and so on */ - PTR_SYMB ids = NULL; - ids = Look_For_Symbol_Ann (FUNCTION_NAME, "Define" ,global_int_annotation); - yyval.ll_node = Make_Function_Call (ids,NULL,2,yyvsp[-3].ll_node,yyvsp[-1].ll_node); - if (TRACEON) printf("Recognized Expression_List Define \n"); - ; - break;} -case 22: -#line 331 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 23: -#line 335 "annotate.y" -{ - yyval.ll_node = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); - if (TRACEON) printf("Recognized onedeclare \n"); - ; - break;} -case 24: -#line 340 "annotate.y" -{ - PTR_LLND ll_ptr ; - ll_ptr = Follow_Llnd(yyvsp[-2].ll_node,2); - NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); - if (TRACEON) printf("Recognized declare_local_list _inlist \n"); - yyval.ll_node=yyvsp[-2].ll_node; - ; - break;} -case 25: -#line 350 "annotate.y" -{ - PTR_SYMB ids = NULL; - PTR_LLND expr; - PTR_HASH p; - char temp1[256]; - - /* need a symb there, will be global later */ - p = yyvsp[-1].hash_entry; - strcpy(temp1,AnnExTensionNumber); - strncat(temp1,p->ident,255); - ids = newSymbol (VARIABLE_NAME,temp1,global_int_annotation); - expr = newExpr(VAR_REF,global_int_annotation, ids); - if (yyvsp[0].ll_node) - yyval.ll_node = newExpr(ASSGN_OP,global_int_annotation,expr, yyvsp[0].ll_node); - else - yyval.ll_node = expr; - ; - break;} -case 26: -#line 368 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 27: -#line 372 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 28: -#line 382 "annotate.y" -{ - /* to modify, must be check before created */ - yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL); - /* $$ = install_parameter($1,VARIABLE_NAME) ; */ - ; - break;} -case 29: -#line 388 "annotate.y" -{ - yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL); - ; - break;} -case 30: -#line 395 "annotate.y" -{ yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL);; - break;} -case 31: -#line 397 "annotate.y" -{ yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL); ; - break;} -case 32: -#line 401 "annotate.y" -{ - yyval.token = MINUS_OP ; - ; - break;} -case 33: -#line 405 "annotate.y" -{ - yyval.token = NOT_OP ; - ; - break;} -case 34: -#line 412 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 35: -#line 419 "annotate.y" -{ - yyval.ll_node = LLNULL ; - ; - break;} -case 36: -#line 423 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 37: -#line 431 "annotate.y" -{ - yyval.ll_node = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); - ; - break;} -case 38: -#line 435 "annotate.y" -{ PTR_LLND ll_ptr ; - ll_ptr = Follow_Llnd(yyvsp[-2].ll_node,2); - NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); - - yyval.ll_node=yyvsp[-2].ll_node; - ; - break;} -case 39: -#line 445 "annotate.y" -{ - yyval.ll_node = newExpr(VECTOR_CONST,NULL,NULL,NULL); - primary_flag = VECTOR_CONST_APPEAR ; - /* Temporarily setting */ - NODE_TYPE(yyval.ll_node) = global_int_annotation ; - ; - break;} -case 40: -#line 452 "annotate.y" -{ - yyval.ll_node = newExpr(VECTOR_CONST,NULL,yyvsp[-1].ll_node,NULL); - primary_flag = VECTOR_CONST_APPEAR ; - /* Temporarily setting */ - NODE_TYPE(yyval.ll_node) = global_int_annotation ; - ; - break;} -case 41: -#line 461 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 42: -#line 465 "annotate.y" -{ - yyval.ll_node = newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL); - ; - break;} -case 43: -#line 469 "annotate.y" -{ - PTR_LLND ll_node1 ; - ll_node1 = Follow_Llnd(yyvsp[-2].ll_node,2); - NODE_OPERAND1(ll_node1)= newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL); - yyval.ll_node=yyvsp[-2].ll_node; - ; - break;} -case 44: -#line 481 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 45: -#line 485 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 46: -#line 489 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 47: -#line 493 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 48: -#line 501 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 49: -#line 505 "annotate.y" -{ - yyval.ll_node = newExpr(VAR_REF, NULL,Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL)); - exception_flag = ON ; - ; - break;} -case 50: -#line 514 "annotate.y" -{ PTR_LLND p1,p2 ; - p1 = newExpr(DDOT,NULL,yyvsp[-4].ll_node,yyvsp[-2].ll_node); - p2 = newExpr(DDOT,NULL,p1,yyvsp[0].ll_node); - yyval.ll_node = p2 ; - ; - break;} -case 51: -#line 520 "annotate.y" -{ - yyval.ll_node= newExpr(DDOT,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 52: -#line 528 "annotate.y" -{ - yyval.ll_node= newExpr(COPY_NODE,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 53: -#line 535 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 54: -#line 539 "annotate.y" -{ PTR_LLND p1,p2 ; - p1 = newExpr(DDOT,NULL,yyvsp[-4].ll_node,yyvsp[-2].ll_node); - p2 = newExpr(DDOT,NULL,p1,yyvsp[0].ll_node); - yyval.ll_node = p2 ; - ; - break;} -case 55: -#line 545 "annotate.y" -{ - yyval.ll_node= newExpr(DDOT,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 56: -#line 552 "annotate.y" -{ - yyval.ll_node = LLNULL ; - ; - break;} -case 57: -#line 556 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 61: -#line 572 "annotate.y" -{ - /* Need Another way to check this one */ - /* if (primary_flag & EXCEPTION_ON) Message("syntax error 6"); */ - if (exception_flag == ON) { /* Message("undefined symbol",0); */ - exception_flag =OFF; - } - yyval.ll_node=yyvsp[0].ll_node ; - ; - break;} -case 62: -#line 581 "annotate.y" -{ - yyval.ll_node=newExpr(yyvsp[-1].token,NULL,yyvsp[0].ll_node); - ; - break;} -case 63: -#line 585 "annotate.y" -{ - yyval.ll_node= newExpr(SIZE_OP,global_int_annotation,yyvsp[0].ll_node,LLNULL); - ; - break;} -case 64: -#line 589 "annotate.y" -{ - yyval.ll_node=newExpr(ADD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 65: -#line 593 "annotate.y" -{ - yyval.ll_node=newExpr(SUBT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 66: -#line 597 "annotate.y" -{ - yyval.ll_node=newExpr(MULT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 67: -#line 601 "annotate.y" -{ - yyval.ll_node=newExpr(DIV_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 68: -#line 605 "annotate.y" -{ - yyval.ll_node=newExpr(MOD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 69: -#line 609 "annotate.y" -{ int op1 ; - op1 = (yyvsp[-1].token == ((int) LE_EXPR)) ? LE_OP : GE_OP ; - yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 70: -#line 614 "annotate.y" -{ - yyval.ll_node=newExpr(LT_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 71: -#line 618 "annotate.y" -{ - yyval.ll_node=newExpr(GT_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 72: -#line 622 "annotate.y" -{ int op1 ; - op1 = (yyvsp[-1].token == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; - yyval.ll_node=newExpr(op1,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 73: -#line 627 "annotate.y" -{ - yyval.ll_node=newExpr(BITAND_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 74: -#line 631 "annotate.y" -{ - yyval.ll_node=newExpr(BITOR_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 75: -#line 635 "annotate.y" -{ - yyval.ll_node=newExpr(XOR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 76: -#line 639 "annotate.y" -{ - yyval.ll_node=newExpr(AND_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 77: -#line 643 "annotate.y" -{ - yyval.ll_node=newExpr(OR_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 78: -#line 647 "annotate.y" -{ PTR_LLND ll_node1; - ll_node1=newExpr(EXPR_IF_BODY,yyvsp[-2].ll_node,yyvsp[0].ll_node); - yyval.ll_node=newExpr(EXPR_IF,NULL,yyvsp[-4].ll_node,ll_node1); - ; - break;} -case 79: -#line 652 "annotate.y" -{ - yyval.ll_node=newExpr(ASSGN_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 80: -#line 656 "annotate.y" -{ int op1 ; - op1 = map_assgn_op(yyvsp[-1].token); - yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 81: -#line 665 "annotate.y" -{ - if (exception_flag == ON) { Message("undefined symbol",0); - exception_flag =OFF; - } - yyval.ll_node=yyvsp[0].ll_node ; - ; - break;} -case 82: -#line 672 "annotate.y" -{ - yyval.ll_node=newExpr(yyvsp[-1].token,NULL,yyvsp[0].ll_node); - ; - break;} -case 83: -#line 676 "annotate.y" -{ - yyval.ll_node=newExpr(SIZE_OP,NULL,yyvsp[0].ll_node); - ; - break;} -case 84: -#line 680 "annotate.y" -{ - yyval.ll_node=newExpr(ADD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 85: -#line 684 "annotate.y" -{ - yyval.ll_node=newExpr(SUBT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 86: -#line 688 "annotate.y" -{ - yyval.ll_node=newExpr(MULT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 87: -#line 692 "annotate.y" -{ - yyval.ll_node=newExpr(DIV_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 88: -#line 696 "annotate.y" -{ - yyval.ll_node=newExpr(MOD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 89: -#line 700 "annotate.y" -{ - yyval.ll_node=newExpr(LSHIFT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 90: -#line 704 "annotate.y" -{ - yyval.ll_node=newExpr(RSHIFT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 91: -#line 708 "annotate.y" -{ int op1 ; - op1 = (yyvsp[-1].token == ((int) LE_EXPR)) ? LE_OP : GE_OP ; - yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 92: -#line 713 "annotate.y" -{ - yyval.ll_node=newExpr(LT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 93: -#line 717 "annotate.y" -{ - yyval.ll_node=newExpr(GT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 94: -#line 722 "annotate.y" -{ int op1 ; - - op1 = (yyvsp[-1].token == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; - yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 95: -#line 728 "annotate.y" -{ - yyval.ll_node=newExpr(BITAND_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 96: -#line 732 "annotate.y" -{ - yyval.ll_node=newExpr(BITOR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 97: -#line 736 "annotate.y" -{ - yyval.ll_node=newExpr(XOR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 98: -#line 740 "annotate.y" -{ - yyval.ll_node=newExpr(AND_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 99: -#line 744 "annotate.y" -{ - yyval.ll_node=newExpr(OR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 100: -#line 748 "annotate.y" -{ PTR_LLND ll_node1; - ll_node1=newExpr(EXPR_IF_BODY,yyvsp[-3].charv,yyvsp[-2].ll_node); - yyval.ll_node=newExpr(EXPR_IF,NULL,yyvsp[-4].ll_node,ll_node1); - ; - break;} -case 101: -#line 753 "annotate.y" -{ - yyval.ll_node=newExpr(ASSGN_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 102: -#line 757 "annotate.y" -{ int op1 ; - op1 = map_assgn_op(yyvsp[-1].token); - yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); - ; - break;} -case 103: -#line 768 "annotate.y" -{ PTR_SYMB symbptr; - symbptr = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry,NULL); - yyval.ll_node = newExpr(VAR_REF,global_int_annotation,symbptr); - exception_flag = ON ; - ; - break;} -case 104: -#line 774 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 105: -#line 778 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 106: -#line 782 "annotate.y" -{ - primary_flag = EXPR_LR ; - yyval.ll_node = yyvsp[-1].ll_node ; - ; - break;} -case 107: -#line 788 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 108: -#line 792 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node; - ; - break;} -case 109: -#line 796 "annotate.y" -{ PTR_SYMB symb; - - if (exception_flag == ON) - { - /* strange behavior for default function */ - symb = NODE_SYMB(yyvsp[-1].ll_node); - SYMB_CODE(symb) = FUNCTION_NAME; - exception_flag = OFF ; - yyval.ll_node = Make_Function_Call (symb,NULL,0,NULL); - } - else - yyval.ll_node = yyvsp[-1].ll_node ; - ; - break;} -case 110: -#line 811 "annotate.y" -{ PTR_LLND lnode_ptr ,llp ; - int status; - - llp = yyvsp[-2].ll_node ; - status = OFF ; - if ((llp->variant == FUNC_CALL) && (!llp->entry.Template.ll_ptr1)) - { - lnode_ptr = llp; - status = FUNC_CALL ; - } - if ((!status) &&((llp->variant == RECORD_REF)|| - (llp->variant == POINTST_OP))) - { - lnode_ptr = llp->entry.Template.ll_ptr2; - if ((lnode_ptr)&&(lnode_ptr->variant== FUNCTION_REF)) - { - lnode_ptr->variant = FUNC_CALL; - } - status = FUNC_CALL ; - } - if ((!status) &&(llp->variant== FUNCTION_REF)) - { llp->variant = FUNC_CALL ; - status = FUNC_CALL ; - lnode_ptr = llp; - } - if (!status) { - status = FUNCTION_OP; - lnode_ptr = llp; - } - switch (status) { - case FUNCTION_OP : yyval.ll_node =newExpr(FUNCTION_OP,yyvsp[-2].ll_node,yyvsp[-1].ll_node); - yyval.ll_node->type = yyvsp[-2].ll_node->type ; - break; - case FUNC_CALL : lnode_ptr->entry.Template.ll_ptr1=yyvsp[-1].ll_node; - yyval.ll_node = yyvsp[-2].ll_node ; - break; - default : Message("system error 10",0); - } - ; - break;} -case 111: -#line 852 "annotate.y" -{ int status ; - PTR_LLND ll_ptr,lp1; - - ll_ptr = check_array_id_format(yyvsp[-3].ll_node,&status); - switch (status) { - case NO : Message("syntax error ",0); - break ; - case ARRAY_OP_NEED: - lp1 = newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,LLNULL);/*mod*/ - yyval.ll_node = newExpr(ARRAY_OP,NULL,yyvsp[-3].ll_node,lp1); - break; - case ID_ONLY : - ll_ptr->variant = ARRAY_REF ; - ll_ptr->entry.Template.ll_ptr1 = newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,LLNULL); - yyval.ll_node = yyvsp[-3].ll_node ; - break; - case RANGE_APPEAR : - ll_ptr->entry.Template.ll_ptr2 = newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,LLNULL); - yyval.ll_node = yyvsp[-3].ll_node ; - break; - } -/* $$->type = adjust_deref_type($1->type,DEREF_OP);*/ - ; - break;} -case 112: -#line 876 "annotate.y" -{ - yyval.ll_node = newExpr(PLUSPLUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); - yyval.ll_node->type = yyvsp[-1].ll_node->type ; - ; - break;} -case 113: -#line 881 "annotate.y" -{ - yyval.ll_node = newExpr(MINUSMINUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); - yyval.ll_node->type = yyvsp[-1].ll_node->type ; - ; - break;} -case 114: -#line 894 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -case 115: -#line 898 "annotate.y" -{ - primary_flag =EXPR_LR ; - yyval.ll_node = yyvsp[-1].ll_node ; - ; - break;} -case 116: -#line 904 "annotate.y" -{ - yyval.ll_node = NULL; - ; - break;} -case 117: -#line 908 "annotate.y" -{ - yyval.ll_node = newExpr(PLUSPLUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); - ; - break;} -case 118: -#line 912 "annotate.y" -{ - yyval.ll_node = newExpr(MINUSMINUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); - ; - break;} -case 119: -#line 920 "annotate.y" -{ - yyval.ll_node = yyvsp[0].ll_node ; - ; - break;} -} - /* the action file gets copied in in place of this dollarsign */ -#line 465 "/usr/local/lib/bison.simple" - - yyvsp -= yylen; - yyssp -= yylen; -#ifdef YYLSP_NEEDED - yylsp -= yylen; -#endif - -#if YYDEBUG != 0 - if (yydebug) - { - short *ssp1 = yyss - 1; - fprintf (stderr, "state stack now"); - while (ssp1 != yyssp) - fprintf (stderr, " %d", *++ssp1); - fprintf (stderr, "\n"); - } -#endif - - *++yyvsp = yyval; - -#ifdef YYLSP_NEEDED - yylsp++; - if (yylen == 0) - { - yylsp->first_line = yylloc.first_line; - yylsp->first_column = yylloc.first_column; - yylsp->last_line = (yylsp-1)->last_line; - yylsp->last_column = (yylsp-1)->last_column; - yylsp->text = 0; - } - else - { - yylsp->last_line = (yylsp+yylen-1)->last_line; - yylsp->last_column = (yylsp+yylen-1)->last_column; - } -#endif - - /* Now "shift" the result of the reduction. - Determine what state that goes to, - based on the state we popped back to - and the rule number reduced by. */ - - yyn = yyr1[yyn]; - - yystate = yypgoto[yyn - YYNTBASE] + *yyssp; - if (yystate >= 0 && yystate <= YYLAST && yycheck[yystate] == *yyssp) - yystate = yytable[yystate]; - else - yystate = yydefgoto[yyn - YYNTBASE]; - - goto yynewstate; - -yyerrlab: /* here on detecting error */ - - if (! yyerrstatus) - /* If not already recovering from an error, report this error. */ - { - ++yynerrs; - -#ifdef YYERROR_VERBOSE - yyn = yypact[yystate]; - - if (yyn > YYFLAG && yyn < YYLAST) - { - int size = 0; - char *msg; - int x, count; - - count = 0; - /* Start X at -yyn if nec to avoid negative indexes in yycheck. */ - for (x = (yyn < 0 ? -yyn : 0); - x < (sizeof(yytname) / sizeof(char *)); x++) - if (yycheck[x + yyn] == x) - size += strlen(yytname[x]) + 15, count++; - msg = (char *) malloc(size + 15); - if (msg != 0) - { - strcpy(msg, "parse error"); - - if (count < 5) - { - count = 0; - for (x = (yyn < 0 ? -yyn : 0); - x < (sizeof(yytname) / sizeof(char *)); x++) - if (yycheck[x + yyn] == x) - { - strcat(msg, count == 0 ? ", expecting `" : " or `"); - strcat(msg, yytname[x]); - strcat(msg, "'"); - count++; - } - } - yyerror(msg); - free(msg); - } - else - yyerror ("parse error; also virtual memory exceeded"); - } - else -#endif /* YYERROR_VERBOSE */ - yyerror("parse error"); - } - - goto yyerrlab1; -yyerrlab1: /* here on error raised explicitly by an action */ - - if (yyerrstatus == 3) - { - /* if just tried and failed to reuse lookahead token after an error, discard it. */ - - /* return failure if at end of input */ - if (yychar == YYEOF) - YYABORT; - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Discarding token %d (%s).\n", yychar, yytname[yychar1]); -#endif - - yychar = YYEMPTY; - } - - /* Else will try to reuse lookahead token - after shifting the error token. */ - - yyerrstatus = 3; /* Each real token shifted decrements this */ - - goto yyerrhandle; - -yyerrdefault: /* current state does not do anything special for the error token. */ - -#if 0 - /* This is wrong; only states that explicitly want error tokens - should shift them. */ - yyn = yydefact[yystate]; /* If its default is to accept any token, ok. Otherwise pop it.*/ - if (yyn) goto yydefault; -#endif - -yyerrpop: /* pop the current state because it cannot handle the error token */ - - if (yyssp == yyss) YYABORT; - yyvsp--; - yystate = *--yyssp; -#ifdef YYLSP_NEEDED - yylsp--; -#endif - -#if YYDEBUG != 0 - if (yydebug) - { - short *ssp1 = yyss - 1; - fprintf (stderr, "Error: state stack now"); - while (ssp1 != yyssp) - fprintf (stderr, " %d", *++ssp1); - fprintf (stderr, "\n"); - } -#endif - -yyerrhandle: - - yyn = yypact[yystate]; - if (yyn == YYFLAG) - goto yyerrdefault; - - yyn += YYTERROR; - if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != YYTERROR) - goto yyerrdefault; - - yyn = yytable[yyn]; - if (yyn < 0) - { - if (yyn == YYFLAG) - goto yyerrpop; - yyn = -yyn; - goto yyreduce; - } - else if (yyn == 0) - goto yyerrpop; - - if (yyn == YYFINAL) - YYACCEPT; - -#if YYDEBUG != 0 - if (yydebug) - fprintf(stderr, "Shifting error token, "); -#endif - - *++yyvsp = yylval; -#ifdef YYLSP_NEEDED - *++yylsp = yylloc; -#endif - - yystate = yyn; - goto yynewstate; -} -#line 926 "annotate.y" - -static int lineno; /* current line number in file being read */ - -/* comments structure */ -#define MAX_COMMENT_SIZE 1024 -char comment_buf[MAX_COMMENT_SIZE + 2]; /* OFFSET '2' to avoid boundary */ -int comment_cursor = 0; -int global_comment_type; - - -/************************************************************************* - * * - * lexical analyzer * - * * - *************************************************************************/ - -static int maxtoken; /* Current length of token buffer */ -static char *token_buffer; /* Pointer to token buffer */ -static int previous_value ; /* last token to be remembered */ - -/* frw[i] is index in rw of the first word whose length is i. */ - -#define MAXRESERVED 9 - -/*static char frw[10] = - { 0, 0, 0, 2, 6, 14, 22, 34, 39, 44 };*/ -static char frw[10] = -{ 0, 0, 0, 2, 5, 13, 21, 32, 37, 41 }; - -static char *rw[] = - { "if", "do", - "int", "for", "asm", - "case", "char", "auto", "goto", "else", "long", "void", "enum", - "float", "short", "union", "break", "while", "const", "IfDef","Label", - "double", "static", "extern", "struct", "return", "sizeof", "switch", "signed","coexec","coloop","friend", - "typedef", "default","private","cobreak", "ApplyTo", - "unsigned", "continue", "register", "volatile","operator"}; - -static short rtoken[] = - { IF, DO, - TYPESPEC, FOR, ASM, - CASE, TYPESPEC, SCSPEC, GOTO, ELSE, TYPEMOD, TYPESPEC, ENUM, - TYPESPEC, TYPEMOD, UNION, BREAK, WHILE, TYPEMOD, IFDEFA, ALABELT, - TYPESPEC, SCSPEC, SCSPEC, STRUCT, RETURN, SIZEOF, SWITCH, TYPEMOD,COEXEC,COLOOP,FRIEND, - SCSPEC, DEFAULT_TOKEN,ACCESSWORD,COBREAK, APPLYTO, - TYPEMOD, CONTINUE, SCSPEC, TYPEMOD,OPERATOR}; - -/* This table corresponds to rw and rtoken. - Its element is an index in ridpointers */ - -#define NORID RID_UNUSED - -static enum rid rid[] = - { NORID, NORID, - RID_INT, NORID, NORID, - NORID, RID_CHAR, RID_AUTO, NORID, NORID, RID_LONG, RID_VOID, NORID, - RID_FLOAT, RID_SHORT, NORID, NORID, NORID, RID_CONST, NORID, NORID, - RID_DOUBLE, RID_STATIC, RID_EXTERN, NORID, NORID, NORID, NORID, RID_SIGNED,NORID,NORID,NORID, - RID_TYPEDEF, NORID,RID_PRIVATE,NORID, NORID, - RID_UNSIGNED, NORID, RID_REGISTER, RID_VOLATILE,NORID}; - -/* The elements of `ridpointers' are identifier nodes - for the reserved type names and storage classes. -tree ridpointers[(int) RID_MAX]; -static tree line_identifier; The identifier node named "line" */ - - -void -init_lex () -{ - //extern char *malloc(); - - /* Start it at 0, because check_newline is called at the very beginning - and will increment it to 1. */ - lineno = 0; - maxtoken = 40; - lastdecl_id = 0; - token_buffer = (char *) xmalloc((unsigned)(maxtoken+1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,token_buffer, 0); -#endif -} - -static void -reinit_parse_for_function () -{ -} - -/* Put char into comment buffer. When the buffer is full, we make a comment */ -/* structure and reset the comment_cursor. */ -static int -put_char_buffer(c,sw) -char c ; -int sw; -{ -/* no comment here */ -return 0; -} - -static int -skip_white_space(type) - int type ; -{ - register int c; - - - c = MYGETC(); - - for (;;) - { - switch (c) - { - case '/': - return '/'; - - case '\n': - case ' ': - case '\t': - case '\f': - case '\r': - case '\b': - c = MYGETC(); - break; - - case '\\': - c = MYGETC(); - if (c == '\n') - lineno++; - else - yyerror("stray '\\' in program"); - c = MYGETC(); - break; - - default: - return (c); - } - } -} - -/* Take care of the comments in the tail of the source code */ -static int -skip_white_space_2() -{ - register int c; - - c = MYGETC(); - for (;;) - { - switch (c) - { - case '/': - return '/'; - case '\n': - return(c); - - case ' ': - case '\t': - case '\f': - case '\r': - case '\b': - c = MYGETC(); - break; - - case '\\': - c = MYGETC(); - if (c == '\n') - lineno++; - else - yyerror("stray '\\' in program"); - c = MYGETC(); - break; - - default: - return (c); - } - } -} - - - -/* make the token buffer longer, preserving the data in it. -p should point to just beyond the last valid character in the old buffer -and the value points to the corresponding place in the new one. */ - -static char * -extend_token_buffer(p) -char *p; -{ - register char *newbuf; - register char *value; - int newlength = maxtoken * 2 + 10; - register char *p2, *p1; - //extern char *malloc(); - - newbuf = (char*)malloc(newlength+1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,newbuf, 0); -#endif - p2 = newbuf; - p1 = newbuf + newlength + 1; - while (p1 != p2) *p2++ = 0; - - value = newbuf; - p2 = token_buffer; - while (p2 != p) - *value++ = *p2++; - - token_buffer = newbuf; - - maxtoken = newlength; - - return (value); -} - - - - -#define isalnum(char) ((char >= 'a' && char <= 'z') || (char >= 'A' && char <= 'Z') || (char >= '0' && char <= '9')) -#define isdigit(char) (char >= '0' && char <= '9') -#define ENDFILE -1 /* token that represents end-of-file */ -#define isanop(d) ((d == '+') || (d == '-') || (d == '&') || (d == '|') || (d == '<') || (d == '>') || (d == '*') || (d == '/') || (d == '%') || (d == '^') || (d == '!') || (d == '=') ) - - -int -readescape () -{ - register int c = MYGETC (); - register int count, code; - - switch (c) - { - case 'x': - code = 0; - count = 0; - while (1) - { - c = MYGETC (); - if (!(c >= 'a' && c <= 'f') - && !(c >= 'A' && c <= 'F') - && !(c >= '0' && c <= '9')) - { - unMYGETC (c); - break; - } - if (c >= 'a' && c <= 'z') - c -= 'a' - 'A'; - code *= 16; - if (c >= 'a' && c <= 'f') - code += c - 'a' + 10; - if (c >= 'A' && c <= 'F') - code += c - 'A' + 10; - if (c >= '0' && c <= '9') - code += c - '0'; - count++; - if (count == 3) - break; - } - if (count == 0) - yyerror ("\\x used with no following hex digits"); - return code; - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - code = 0; - count = 0; - while ((c <= '7') && (c >= '0') && (count++ < 3)) - { - code = (code * 8) + (c - '0'); - c = MYGETC (); - } - unMYGETC (c); - return code; - - case '\\': case '\'': case '"': - return c; - - case '\n': - lineno++; - return -1; - - case 'n': - return c ; /* return TARGET_NEWLINE; */ - - case 't': - return c; /* return TARGET_TAB; */ - - case 'r': - return c;/* return TARGET_CR; */ - - case 'f': - return c;/* return TARGET_FF;*/ - - case 'b': - return c;/* return TARGET_BS;*/ - - case 'a': - return c; /* return TARGET_BELL;*/ - - case 'v': - return c; /* return TARGET_VT;*/ - } - return c; -} - - -int -yylex_annotate() -{ - register int c; - register char *p; - register int value; - int low /*,high */ ; - char *str1 ; -/* double ddval ; */ -/* int type; */ - int c3; - - - - if (recursive_yylex == OFF) new_cur_comment = (PTR_CMNT) NULL ; - - /* line_pos_1 = lineno +1 ; */ - c = skip_white_space(FULL); - /* yylloc.first_line = lineno;*/ - - switch (c) - { - case EOF: - value = ENDFILE; break; - - case 'A': case 'B': case 'C': case 'D': case 'E': - case 'F': case 'G': case 'H': case 'I': case 'J': - case 'K': case 'L': case 'M': case 'N': case 'O': - case 'P': case 'Q': case 'R': case 'S': case 'T': - case 'U': case 'V': case 'W': case 'X': case 'Y': - case 'Z': - case 'a': case 'b': case 'c': case 'd': case 'e': - case 'f': case 'g': case 'h': case 'i': case 'j': - case 'k': case 'l': case 'm': case 'n': case 'o': - case 'p': case 'q': case 'r': case 's': case 't': - case 'u': case 'v': case 'w': case 'x': case 'y': - case 'z': - case '_': - - p = token_buffer; - while (isalnum(c) || (c == '_') || (c == '~')) - { - if (p >= token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - c = MYGETC(); - } - - *p = 0; - unMYGETC(c); - - value = IDENTIFIER; - - - if (p - token_buffer <= MAXRESERVED) - { - register int lim = frw [p - token_buffer + 1]; - register int i; - - for (i = frw[p - token_buffer]; i < lim; i++) - if (rw[i][0] == token_buffer[0] && !strcmp(rw[i], token_buffer)) - { - if (rid[i]) - yylval.token = (int) rid[i] ; - value = (int) rtoken[i]; - break; - } - } - - { int temp; - if ((temp = Recog_My_Token(token_buffer)) != -1) - { - yylval.token = temp; - value = temp; - } - } - - if (value == IDENTIFIER) - { int t_status ; - PTR_LLND temp; - /* temp move it out */ - - yylval.hash_entry = look_up_type(token_buffer,&t_status); - /* if ((t_status)&&(lastdecl_id ==0)) value = TYPENAME; - Wait to fix that */ - /* temporary fix */ - temp = look_up_section(token_buffer); - if (temp) - { - yylval.ll_node = temp; - value = SECTIONT; - } - - if (look_up_specialfunction(token_buffer)) - { - value = SPECIALAF; - } - - - } - - break; - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - case '.': - { - int base = 10; - int count = 0; - int largest_digit = 0; - /* for multi-precision arithmetic, - we store only 8 live bits in each short, - giving us 64 bits of reliable precision */ - short shorts[8]; - int floatflag = 0; /* Set 1 if we learn this is a floating constant */ - - for (count = 0; count < 8; count++) - shorts[count] = 0; - - p = token_buffer; - *p++ = c; - - if (c == '0') - { - *p++ = (c = MYGETC()); - if ((c == 'x') || (c == 'X')) - { - base = 16; - *p++ = (c = MYGETC()); - } - else - { - base = 8; - } - } - - while (c == '.' - || (isalnum (c) && (c != 'l') && (c != 'L') - && (c != 'u') && (c != 'U') - && (!floatflag || ((c != 'f') && (c != 'F'))))) - { - if (c == '.') - { - if (base == 16) - yyerror ("floating constant may not be in radix 16"); - floatflag = 1; - base = 10; - *p++ = c = MYGETC (); - /* Accept '.' as the start of a floating-point number - only when it is followed by a digit. - Otherwise, unread the following non-digit - and use the '.' as a structural token. */ - if (p == token_buffer + 2 && !isdigit (c)) - { - if (c == '.') - { - c = MYGETC (); - if (c == '.') - { - value = ELLIPSIS ; - goto done ; - } - yyerror ("syntax error"); - } - unMYGETC (c); - value = '.'; - goto done; - } - } - else - { - if (isdigit(c)) - { - c = c - '0'; - } - else if (base <= 10) - { - if ((c&~040) == 'E') - { - if (base == 8) - yyerror ("floating constant may not be in radix 8"); - base = 10; - floatflag = 1; - break; /* start of exponent */ - } - yyerror ("nondigits in number and not hexadecimal"); - c = 0; - } - else if (c >= 'a') - { - c = c - 'a' + 10; - } - else - { - c = c - 'A' + 10; - } - if (c >= largest_digit) - largest_digit = c; - - for (count = 0; count < 8; count++) - { - (shorts[count] *= base); - if (count) - { - shorts[count] += (shorts[count-1] >> 8); - shorts[count-1] &= (1<<8)-1; - } - else shorts[0] += c; - } - - *p++ = (c = MYGETC()); - } - } - - if (largest_digit >= base) - yyerror ("numeric constant contains digits beyond the radix"); - - /* Remove terminating char from the token buffer and delimit the string */ - *--p = 0; - - if (floatflag) - { - /* enum rid type = DOUBLE_TYPE_CONST ; */ - - /* Read explicit exponent if any, and put it in tokenbuf. */ - - if ((c == 'e') || (c == 'E')) - { - *p++ = c; - c = MYGETC(); - if ((c == '+') || (c == '-')) - { - *p++ = c; - c = MYGETC(); - } - while (isdigit(c)) - { - *p++ = c; - c = MYGETC(); - } - } - - *p = 0; - - while (1) - { -/* if (c == 'f' || c == 'F') - type = FLOAT_TYPE_CONST ; - else if (c == 'l' || c == 'L') - type = LONG_DOUBLE_TYPE_CONST ; - else */ - - if((c != 'f') && (c != 'F') && (c != 'l') && (c !='L')) - { - if (isalnum (c)) - { - yyerror ("garbage at end of number"); - while (isalnum (c)) - c = MYGETC (); - } - break; - } - c = MYGETC (); - } - - unMYGETC(c); - -/* ddval = build_real_from_string (token_buffer, 0); */ - str1= (char *) copys(token_buffer); - yylval.ll_node = newExpr(FLOAT_VAL,NULL,LLNULL,LLNULL,str1); - - } - else - { - /* enum rid type; */ - - /* int spec_unsigned = 0; */ - /* int spec_long = 0; */ - - while (1) - { -/* if (c == 'u' || c == 'U') - { - spec_unsigned = 1; - } - else if (c == 'l' || c == 'L') - { - spec_long = 1; - } - else */ - - if((c != 'u') && (c != 'U') && (c != 'l') && (c != 'L')) - { - if (isalnum (c)) - { - yyerror ("garbage at end of number"); - while (isalnum (c)) - c = MYGETC (); - } - break; - } - c = MYGETC (); - } - - unMYGETC (c); - - /* This is simplified by the fact that our constant - is always positive. */ - - low= (shorts[3]<<24) + (shorts[2]<<16) + (shorts[1]<<8) + shorts[0] ; - /* high = (shorts[7]<<24) + (shorts[6]<<16) + (shorts[5]<<8) + shorts[4] ; */ - - - /* type = LONG_UNSIGNED_TYPE_CONST ; */ - yylval.ll_node = makeInt(low); - } - - value = CONSTANT; break; - } - - case '\'': - c = MYGETC(); - { - - tryagain: - - if (c == '\\') - { - c = readescape (); - if (c < 0) - goto tryagain; - } - else if (c == '\n') - { - Message ("ANSI C forbids newline in character constant",0); - lineno++; - } - - c3= c; - - c = MYGETC (); - if (c != '\'') - yyerror("malformatted character constant"); - yylval.ll_node = newExpr(CHAR_VAL,LLNULL,LLNULL,low); - yylval.ll_node->entry.cval = c3; - value = CONSTANT; break; - } - - case '"': - { - c = MYGETC(); - p = token_buffer; - - while (c != '"') - { - if (c == '\\') - { - /* New Added Three lines */ - if (p == token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - - c = readescape (); - if (c < 0) - goto skipnewline; - } - else if (c == '\n') - { - Message ("ANSI C forbids newline in string constant",0); - lineno++; - } - - if (p == token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - - skipnewline: - c = MYGETC (); - } - - *p++ = 0; - - str1= (char *) copys(token_buffer); - yylval.ll_node = (PTR_LLND) newNode(STRING_VAL); - NODE_STRING_POINTER(yylval.ll_node) = str1; - value = STRING; break; - } - - case '+': - case '-': - case '&': - case '|': - case '<': - case '>': - case '*': - case '/': - case '%': - case '^': - case '!': - case '=': - { - register int c1; - if ( previous_value == OPERATOR ) - { - p = token_buffer; - while (isanop(c) ) - { - if (p >= token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - c = MYGETC(); - } - *p = 0; - unMYGETC(c); - value = LOADEDOPR ; - yylval.hash_entry = look_up_annotate(token_buffer); - break; - } - combine: - - switch (c) - { - case '+': - yylval.token = (int) PLUS_EXPR; break; - case '-': - yylval.token = (int) MINUS_EXPR; break; - case '&': - yylval.token = (int) BIT_AND_EXPR; break; - case '|': - yylval.token = (int) BIT_IOR_EXPR; break; - case '*': - yylval.token = (int) MULT_EXPR; break; - case '/': - yylval.token = (int) TRUNC_DIV_EXPR; break; - case '%': - yylval.token = (int) TRUNC_MOD_EXPR; break; - case '^': - yylval.token = (int) BIT_XOR_EXPR; break; - case LSHIFT: - yylval.token = (int) LSHIFT_EXPR; break; - case RSHIFT: - yylval.token = (int) RSHIFT_EXPR; break; - case '<': - yylval.token = (int) LT_EXPR; break; - case '>': - yylval.token = (int) GT_EXPR; break; - } - - c1 = MYGETC(); - - if (c1 == '=') - { - switch (c) - { - case '<': - value = ARITHCOMPARE; yylval.token = (int) LE_EXPR; goto done; - case '>': - value = ARITHCOMPARE; yylval.token = (int) GE_EXPR; goto done; - case '!': - value = EQCOMPARE; yylval.token = (int) NE_EXPR; goto done; - case '=': - value = EQCOMPARE; yylval.token = (int) EQ_EXPR; goto done; - } - value = ASSIGN; goto done; - } - else if (c == c1) - switch (c) - { - case '+': - value = PLUSPLUS; goto done; - case '-': - value = MINUSMINUS; goto done; - case '&': - value = ANDAND; goto done; - case '|': - value = OROR; goto done; -/* testing */ -/* case ':': - value = DOUBLEMARK; goto done; */ - - case '<': - c = LSHIFT; - goto combine; - case '>': - c = RSHIFT; - goto combine; - } - else if ((c == '-') && (c1 == '>')) - { value = POINTSAT; goto done; } - unMYGETC (c1); - - - value = c; - goto done; - } - - default: - value = c; - } - -done: - - if (recursive_yylex == OFF) { - previous_value = value ; - line_pos_1 = lineno ; - c = skip_white_space_2(); - if (c != '\n'); - unMYGETC(c); - if (value != '}') - { c = skip_white_space(NEXT_FULL); - if (c == '\n') lineno++ ; - else unMYGETC(c); - } - set_up_momentum(value,yylval.token); - automata_driver(value); - cur_counter++; - old_line = yylineno ; - yylineno = line_pos_1; - } - - if (TRACEON) printf("yylex returned %d\n", value); - return (value); -} - - -static int yyerror(s) - char *s; -{ - /* Message(s,0); empty at the moment, generate false error report? - to be modified later */ - return 1; /* PHB needed a return val, 1 seems ok */ -} - - -/* primary :- primary [ expr_vector ] - * <1> check the LHS format - * <2> return : NO if incorrect format at LHS - * ID_ONLY if LHS only have id format (including multiple id) - * RANGE_APPEAR if LHS format owns both id and range_list - */ - -static -PTR_LLND check_array_id_format(ll_ptr,state) -int *state; -PTR_LLND ll_ptr ; - -{ PTR_LLND temp,temp1; - - temp = ll_ptr; - switch (NODE_CODE(ll_ptr)) { - case VAR_REF : - *state = ID_ONLY ; - return(ll_ptr); - case ARRAY_REF : - temp1 = Follow_Llnd(NODE_OPERAND0(ll_ptr),2); - *state = RANGE_APPEAR; - return(temp1); - case ARRAY_OP:temp1 = Follow_Llnd(NODE_OPERAND1(ll_ptr),2); - *state =RANGE_APPEAR ; - return(temp1); - default : *state = ARRAY_OP_NEED ; - return(temp); - } - } - -static -int -map_assgn_op(value) -int value; -{ - switch (value) { - case ((int) PLUS_EXPR) : - return(PLUS_ASSGN_OP); - case ((int) MINUS_EXPR): - return(MINUS_ASSGN_OP); - case ((int) BIT_AND_EXPR): - return(AND_ASSGN_OP); - case ((int) BIT_IOR_EXPR): - return(IOR_ASSGN_OP); - case ((int) MULT_EXPR): - return(MULT_ASSGN_OP); - case ((int) TRUNC_DIV_EXPR): - return(DIV_ASSGN_OP); - case ((int) TRUNC_MOD_EXPR): - return(MOD_ASSGN_OP); - case ((int) BIT_XOR_EXPR): - return(XOR_ASSGN_OP); - case ((int) LSHIFT_EXPR): - return(LSHIFT_ASSGN_OP); - case ((int) RSHIFT_EXPR): - return(RSHIFT_ASSGN_OP); - } -return 0; -} - -PTR_HASH -look_up_type(st, ip) - char *st; - int *ip; -{ - char *pt; - - pt = (char *) xmalloc(strlen(st) +1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,pt, 0); -#endif - strcpy(pt,st); - /* dummy, to be cleaned */ - return (PTR_HASH) pt; -} - - -PTR_HASH -look_up_annotate(st) - char *st; -{ - char *pt; - - pt = (char *) xmalloc(strlen(st) +1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,pt, 0); -#endif - strcpy(pt,st); - /* dummy, to be cleaned */ - return (PTR_HASH) pt; -} - -static char MYGETC() -{ - - if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) - return EOF; - - if (STRINGTOPARSE[ PTTOSTRINGTOPARSE] == '\0') - { - PTTOSTRINGTOPARSE++; - return EOF; - } - - PTTOSTRINGTOPARSE++; - return STRINGTOPARSE[ PTTOSTRINGTOPARSE-1]; -} - -static char unMYGETC(char c) -{ - if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) - return EOF; - - if (PTTOSTRINGTOPARSE >0) - PTTOSTRINGTOPARSE --; - STRINGTOPARSE[ PTTOSTRINGTOPARSE] = c; - return c; -} - - -/* CurrentScope should be the last in the list */ -static char *sectionkeyword[] = - { "NextStmt", - "NextAnnotation", - "EveryWhere", - "Follow", -/* keep it last*/ "CurrentScope"}; - - -static PTR_LLND -look_up_section(str) - char *str; -{ int i; - PTR_LLND pt = NULL; - - for (i = 0; i < RID_MAX; i++) - { - if (strcmp(sectionkeyword[i], str) == 0) - { - pt = (PTR_LLND) newNode(STRING_VAL); - NODE_STRING_POINTER(pt) = (char *) xmalloc(strlen(str) +1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,NODE_STRING_POINTER(pt), 0); -#endif - strcpy(NODE_STRING_POINTER(pt),str); - return pt; - } - if (strcmp(sectionkeyword[i],"CurrentScope") == 0) - return NULL; - } - - return NULL; -} - - -/* Dummy should be the last in the list */ -static char *specialfunction[] = - { "ListOfAn", - "Align", - "Induction", - "Used", - "Modified", - "Alias", - "Permutation", - "Assert", -/* keep it last*/ "Dummy"}; - -static int -look_up_specialfunction(str) - char *str; -{ int i; - - for (i = 0; i < RID_MAX; i++) - { - if (strcmp(specialfunction[i], str) == 0) - { - return TRUE; - } - if (strcmp(specialfunction[i],"Dummy") == 0) - return 0; - } - - return 0; -} - - -static int -Recog_My_Token(str) -char *str; -{ - - if (strcmp("FromAnn",str) == 0) - return FROMT; - - if (strcmp("ToAnn",str) == 0) - return TOT; - - if (strcmp("ToLabel",str) == 0) - return TOTLABEL; - - if (strcmp("ToFunction",str) == 0) - return TOFUNCTION; - - if (strcmp("Define",str) == 0) - return DefineANN; - - return -1; -} - - -PTR_SYMB -Look_For_Symbol_Ann(code,name,type) - int code; - char *name; - PTR_TYPE type; -{ - PTR_SYMB symb; - char temp1[256]; - - strcpy(temp1, AnnExTensionNumber); - strncat(temp1,name,255); - - if ((symb = getSymbolWithName(temp1, ANNOTATIONSCOPE))) - return symb; - - if ((symb = getSymbolWithName(name, ANNOTATIONSCOPE))) - return symb; - - return newSymbol (code,name,type); -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h deleted file mode 100644 index f257958..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h +++ /dev/null @@ -1,74 +0,0 @@ -typedef union { - int token ; - char charv ; - char *charp; - PTR_BFND bfnode ; - PTR_LLND ll_node ; - PTR_SYMB symbol ; - PTR_TYPE data_type ; - PTR_HASH hash_entry ; - PTR_LABEL label ; - PTR_BLOB blob_ptr ; - } YYSTYPE; -#define IFDEFA 258 -#define APPLYTO 259 -#define ALABELT 260 -#define SECTIONT 261 -#define SPECIALAF 262 -#define FROMT 263 -#define TOT 264 -#define TOTLABEL 265 -#define TOFUNCTION 266 -#define DefineANN 267 -#define IDENTIFIER 268 -#define TYPENAME 269 -#define SCSPEC 270 -#define TYPESPEC 271 -#define TYPEMOD 272 -#define CONSTANT 273 -#define STRING 274 -#define ELLIPSIS 275 -#define SIZEOF 276 -#define ENUM 277 -#define STRUCT 278 -#define UNION 279 -#define IF 280 -#define ELSE 281 -#define WHILE 282 -#define DO 283 -#define FOR 284 -#define SWITCH 285 -#define CASE 286 -#define DEFAULT_TOKEN 287 -#define BREAK 288 -#define CONTINUE 289 -#define RETURN 290 -#define GOTO 291 -#define ASM 292 -#define CLASS 293 -#define PUBLIC 294 -#define FRIEND 295 -#define ACCESSWORD 296 -#define OVERLOAD 297 -#define OPERATOR 298 -#define COBREAK 299 -#define COLOOP 300 -#define COEXEC 301 -#define LOADEDOPR 302 -#define MULTIPLEID 303 -#define MULTIPLETYPENAME 304 -#define ASSIGN 305 -#define OROR 306 -#define ANDAND 307 -#define EQCOMPARE 308 -#define ARITHCOMPARE 309 -#define LSHIFT 310 -#define RSHIFT 311 -#define UNARY 312 -#define PLUSPLUS 313 -#define MINUSMINUS 314 -#define HYPERUNARY 315 -#define DOUBLEMARK 316 -#define POINTSAT 317 - -extern YYSTYPE yylval; diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.y b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.y deleted file mode 100644 index 12226f1..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/annotate.y +++ /dev/null @@ -1,1988 +0,0 @@ - -/* This is a small prototype for the annotation system, it deliver a - set of llnode/bifnode for the annotation system */ - -%{ -#include "macro.h" - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif -#include -#ifdef _NEEDALLOCAH_ -# include -#endif - -extern char* xmalloc(int size); -extern void Message(char *s, int l); -extern void set_up_momentum(int value,int token); -extern void automata_driver(int value); -extern char* copys(char *); - -#define ON 1 -#define OFF 0 -#define OTHER 2 -#define ID_ONLY 1 -#define RANGE_APPEAR 2 -#define EXCEPTION_ON 4 -#define EXPR_LR 8 -#define VECTOR_CONST_APPEAR 16 -#define ARRAY_OP_NEED 32 -#define TRACEON 0 - -extern POINTER newNode(); - -%} - -%start annotation -%union { - int token ; - char charv ; - char *charp; - PTR_BFND bfnode ; - PTR_LLND ll_node ; - PTR_SYMB symbol ; - PTR_TYPE data_type ; - PTR_HASH hash_entry ; - PTR_LABEL label ; - PTR_BLOB blob_ptr ; - } - -/* Begin Token for annotation system */ -/* The IfDef token */ -%token IFDEFA -/* the Apply to token */ -%token APPLYTO -%token ALABELT -%token SECTIONT -%token SPECIALAF -%token FROMT -%token TOT -%token TOTLABEL -%token TOFUNCTION -%token DefineANN -/* End Token for annotation system */ - -/* all identifiers that are not reserved words - and are not declared typedefs in the current block */ -%token IDENTIFIER -/* all identifiers that are declared typedefs in the current block. - In some contexts, they are treated just like IDENTIFIER, - but they can also serve as typespecs in declarations. */ -%token TYPENAME - -/* reserved words that specify storage class. - yylval contains an IDENTIFIER_NODE which indicates which one. */ -%token SCSPEC - -/* reserved words that specify type. - yylval contains an IDENTIFIER_NODE which indicates which one. */ -%token TYPESPEC - -/* reserved words that modify type: "const" or "volatile". - yylval contains an IDENTIFIER_NODE which indicates which one. */ -%token TYPEMOD - -/*character or numeric constants. - yylval is the node for the constant. */ -%token CONSTANT - -/* String constants in raw form. - yylval is a STRING_CST node. */ -%token STRING - -/* "...", used for functions with variable arglists. */ -%token ELLIPSIS - -/* the reserved words */ -%token SIZEOF ENUM STRUCT UNION IF ELSE WHILE DO FOR SWITCH CASE DEFAULT_TOKEN -%token BREAK CONTINUE RETURN GOTO ASM -%token CLASS PUBLIC FRIEND ACCESSWORD OVERLOAD -%token OPERATOR COBREAK COLOOP COEXEC LOADEDOPR - -%token MULTIPLEID MULTIPLETYPENAME - -/* Define the operator tokens and their precedences. - The value is an integer because, if used, it is the tree code - to use in the expression made from the operator. */ - -%left ',' -%right '=' -%right ASSIGN -%right '?' ':' -%left OROR -%left ANDAND -%left '|' -%left '^' -%left '&' -%left EQCOMPARE -%left ARITHCOMPARE '>' '<' -%left LSHIFT RSHIFT -%left '+' '-' -%left '*' '/' '%' -%right UNARY PLUSPLUS MINUSMINUS -%left HYPERUNARY -%left DOUBLEMARK -%left POINTSAT '.' - - -%type unop -%type IDENTIFIER TYPENAME LOADEDOPR -%type CONSTANT STRING primary -%type expr_no_commas const_expr_no_commas -%type expr nonnull_exprlist exprlist const_primary element -%type string -%type SCSPEC TYPESPEC TYPEMOD -%type vector_constant triplet compound_constant vector_list -%type single_v_expr array_expr_a -%type array_expr_b expr_vector -%type expr_no_commas_1 -%type identifier identifiers -%type ACCESSWORD -%type IfDefR -%type Alabel -%type ApplyTo -%type LocalDeclare -%type Expression_List -%type declare_local_list -%type onedeclare -%type domain -%type section -%type SECTIONT -%type SPECIALAF - -%{ char *input_filename; - extern int lastdecl_id; - PTR_LLND ANNOTATE_NODE = NULL; - PTR_BFND ANNOTATIONSCOPE = NULL; - extern PTR_SYMB newSymbol(); - extern PTR_LLND newExpr(); - extern PTR_LLND makeInt(); - static int cur_counter = 0; - static int primary_flag= 0; - PTR_TYPE global_int_annotation = NULL; - extern PTR_LLND Follow_Llnd(); - static int recursive_yylex = OFF; - static int exception_flag = 0; - static PTR_HASH cur_id_entry; - int line_pos_1 = 0; - char *line_pos_fname = 0; - static int old_line = 0; - static int yylineno=0; - static int yyerror(); - PTR_CMNT cur_comment = NULL; - PTR_CMNT new_cur_comment = NULL ; - PTR_HASH look_up(); - PTR_HASH look_up_type(); - char *STRINGTOPARSE = 0; - int PTTOSTRINGTOPARSE = 0; - int LENSTRINGTOPARSE = 0; - extern PTR_LLND Make_Function_Call(); - static PTR_LLND check_array_id_format(); - static PTR_LLND look_up_section(); - extern PTR_SYMB getSymbolWithName(); /*getSymbolWithName(name, scope)*/ - PTR_SYMB Look_For_Symbol_Ann(); - char AnnExTensionNumber[255]; /* to symbole right for the annotation */ - static int Recog_My_Token(); - static int look_up_specialfunction(); - static char unMYGETC(char c); - static char MYGETC(); - static int map_assgn_op(); -%} - -%% - -annotation: /* empty */ - | '[' IfDefR Alabel ApplyTo LocalDeclare ';' Expression_List ']' - { - ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,$2, - newExpr(EXPR_LIST,NULL,$3, - newExpr(EXPR_LIST,NULL,$4, - newExpr(EXPR_LIST,NULL,$5, - newExpr(EXPR_LIST,NULL,$7,NULL))))); - if (TRACEON) - printf("Recognized ANNOTATION\n"); - } - | '['Expression_List ']' - { - ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,$2,NULL))))); - if (TRACEON) printf("Recognized ANNOTATION\n"); - }; - - -IfDefR: /* empty */ - { - $$ = NULL; - } - | IFDEFA '(' string ')' - { - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"IfDef", NULL); - $$ = Make_Function_Call (ids,NULL,1,$3); - if (TRACEON) printf("Recognized IFDEFA \n"); - }; - -Alabel: /* empty */ - { - $$ = NULL; - } - | ALABELT '(' string ')' - { - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"Label", NULL); - $$ = Make_Function_Call (ids,NULL,1,$3); - if (TRACEON) printf("Recognized IFDEFA \n"); - if (TRACEON) printf("Recognized ALABEL\n"); - }; - -ApplyTo: /* empty */ - { - $$ = NULL; - } - | APPLYTO '(' section ')' - { - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); - $$ = Make_Function_Call (ids,NULL,2,$3, NULL); - if (TRACEON) printf("Recognized APPLYTO \n"); - } - | APPLYTO '(' section ')' IF expr - { - PTR_SYMB ids = NULL; - /* need a symb there, will be global later */ - ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); - $$ = Make_Function_Call (ids,NULL,2,$3,$6); - if (TRACEON) printf("Recognized APPLYTO \n"); - }; - -section : SECTIONT - { /* SECTIONT return a string_val llnd */ - $$ = $1; - } - | TOFUNCTION IDENTIFIER - { - - $$ = newExpr(VAR_REF,NULL,$2); - } - | FROMT string TOT string - { - $$ = newExpr(EXPR_LIST,NULL,$2, - newExpr(EXPR_LIST,NULL,$4,NULL)); - } - | TOT string - { - $$ = newExpr(EXPR_LIST,NULL,NULL, - newExpr(EXPR_LIST,NULL,$2,NULL)); - } - | TOTLABEL string - { - $$ = $2; - } - ; - - -LocalDeclare: /* empty */ - { - if (TRACEON) printf("Recognized LocalDeclare\n"); - $$ = NULL; - } - | declare_local_list - { - $$ = $1; - if (TRACEON) printf("Recognized declare_local_list\n"); - }; -/******************* Annotation Expression Stuff ****************************/ - -Expression_List: /* empty */ - { - $$ = NULL; - if (TRACEON) printf("Recognized empty expr\n"); - } - | SPECIALAF '(' exprlist ')' - { /* for Key word like parallel loop and so on */ - PTR_SYMB ids = NULL; - ids = Look_For_Symbol_Ann (VARIABLE_NAME, $1,global_int_annotation); - $$ = Make_Function_Call (ids,NULL,1,$3); - if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); - } - | IDENTIFIER '(' exprlist ')' - { /* for Key word like parallel loop and so on */ - PTR_SYMB ids = NULL; - ids = Look_For_Symbol_Ann (VARIABLE_NAME, $1,global_int_annotation); - $$ = Make_Function_Call (ids,NULL,1,$3); - if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); - } - | DefineANN '(' string ',' CONSTANT ')' - { /* for Key word like parallel loop and so on */ - PTR_SYMB ids = NULL; - ids = Look_For_Symbol_Ann (FUNCTION_NAME, "Define" ,global_int_annotation); - $$ = Make_Function_Call (ids,NULL,2,$3,$5); - if (TRACEON) printf("Recognized Expression_List Define \n"); - }; - - -/******************** LOCAL DECLARATION **********************************/ -/* for local declaration */ -declare_local_list: - { - $$ = NULL; - } - | onedeclare - { - $$ = newExpr(EXPR_LIST,NODE_TYPE($1),$1,NULL); - if (TRACEON) printf("Recognized onedeclare \n"); - } - | declare_local_list ',' onedeclare - { - PTR_LLND ll_ptr ; - ll_ptr = Follow_Llnd($1,2); - NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE($3),$3,NULL); - if (TRACEON) printf("Recognized declare_local_list _inlist \n"); - $$=$1; - }; - -onedeclare: - TYPESPEC IDENTIFIER domain - { - PTR_SYMB ids = NULL; - PTR_LLND expr; - PTR_HASH p; - char temp1[256]; - - /* need a symb there, will be global later */ - p = $2; - strcpy(temp1,AnnExTensionNumber); - strncat(temp1,p->ident,255); - ids = newSymbol (VARIABLE_NAME,temp1,global_int_annotation); - expr = newExpr(VAR_REF,global_int_annotation, ids); - if ($3) - $$ = newExpr(ASSGN_OP,global_int_annotation,expr, $3); - else - $$ = expr; - }; -domain: - { - $$ = NULL; - } - | '=' expr_no_commas - { - $$ = $2; - }; - - -/********************* PARSER EXPRESSION ************************/ -/* Must appear precede expr for resolve precedence problem */ -/* A nonempty list of identifiers. */ -identifiers: - IDENTIFIER - { - /* to modify, must be check before created */ - $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL); - /* $$ = install_parameter($1,VARIABLE_NAME) ; */ - } - | identifiers ',' IDENTIFIER - { - $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $3, NULL); - } - ; - -identifier: - IDENTIFIER - { $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL);} - | TYPENAME - { $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL); } - ; - -unop: '-' - { - $$ = MINUS_OP ; - } - | '!' - { - $$ = NOT_OP ; - } - ; - - -expr: nonnull_exprlist - { - $$ = $1 ; - } - ; - -exprlist: - /* empty */ - { - $$ = LLNULL ; - } - | nonnull_exprlist - { - $$ = $1 ; - } - ; - -/* modified */ -nonnull_exprlist: - expr_no_commas - { - $$ = newExpr(EXPR_LIST,NODE_TYPE($1),$1,NULL); - } - | nonnull_exprlist ',' expr_no_commas - { PTR_LLND ll_ptr ; - ll_ptr = Follow_Llnd($1,2); - NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE($3),$3,NULL); - - $$=$1; - } - ; - -/* modified */ -vector_constant : '[' ']' %prec ',' - { - $$ = newExpr(VECTOR_CONST,NULL,NULL,NULL); - primary_flag = VECTOR_CONST_APPEAR ; - /* Temporarily setting */ - NODE_TYPE($$) = global_int_annotation ; - } - | '[' vector_list ']' %prec ',' - { - $$ = newExpr(VECTOR_CONST,NULL,$2,NULL); - primary_flag = VECTOR_CONST_APPEAR ; - /* Temporarily setting */ - NODE_TYPE($$) = global_int_annotation ; - } - ; - -vector_list : - { - $$ = NULL; - } - | single_v_expr - { - $$ = newExpr(EXPR_LIST,NULL,$1,NULL); - } - | vector_list ',' single_v_expr - { - PTR_LLND ll_node1 ; - ll_node1 = Follow_Llnd($1,2); - NODE_OPERAND1(ll_node1)= newExpr(EXPR_LIST,NULL,$3,NULL); - $$=$1; - } - - ; - -/* modified */ -single_v_expr : - const_expr_no_commas - { - $$ = $1; - } - | triplet - { - $$ = $1; - } - | compound_constant - { - $$ = $1; - } - | vector_constant - { - $$ = $1 ; - } - ; - - - element: - CONSTANT - { - $$ = $1 ; - } - | IDENTIFIER - { - $$ = newExpr(VAR_REF, NULL,Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL)); - exception_flag = ON ; - } - ; - - triplet : - element ':' element ':' element %prec '.' - - { PTR_LLND p1,p2 ; - p1 = newExpr(DDOT,NULL,$1,$3); - p2 = newExpr(DDOT,NULL,p1,$5); - $$ = p2 ; - } - | element ':' element %prec '.' - { - $$= newExpr(DDOT,NULL,$1,$3); - } - ; - - -compound_constant : - CONSTANT '#' CONSTANT - { - $$= newExpr(COPY_NODE,NULL,$1,$3); - } - - ; -/* modified */ -array_expr_a : /* empty */ - { - $$ = NULL; - } - | expr_no_commas_1 ':' expr_no_commas_1 ':' expr_no_commas_1 %prec ',' - { PTR_LLND p1,p2 ; - p1 = newExpr(DDOT,NULL,$1,$3); - p2 = newExpr(DDOT,NULL,p1,$5); - $$ = p2 ; - } - | expr_no_commas_1 ':' expr_no_commas_1 %prec ',' - { - $$= newExpr(DDOT,NULL,$1,$3); - } - ; - - -expr_no_commas_1 : - { - $$ = LLNULL ; - } - | expr_no_commas - { - $$ = $1 ; - } - ; -/* modified */ -array_expr_b : expr_no_commas '#' expr_no_commas - ; - - -/* modified */ -expr_vector : expr_no_commas /* original is expr */ - | array_expr_a - ; - -expr_no_commas: - primary - { - /* Need Another way to check this one */ - /* if (primary_flag & EXCEPTION_ON) Message("syntax error 6"); */ - if (exception_flag == ON) { /* Message("undefined symbol",0); */ - exception_flag =OFF; - } - $$=$1 ; - } - | unop primary %prec UNARY - { - $$=newExpr($1,NULL,$2); - } - | SIZEOF expr_no_commas %prec UNARY - { - $$= newExpr(SIZE_OP,global_int_annotation,$2,LLNULL); - } - | expr_no_commas '+' expr_no_commas - { - $$=newExpr(ADD_OP,NULL,$1,$3); - } - | expr_no_commas '-' expr_no_commas - { - $$=newExpr(SUBT_OP,NULL,$1,$3); - } - | expr_no_commas '*' expr_no_commas - { - $$=newExpr(MULT_OP,NULL,$1,$3); - } - | expr_no_commas '/' expr_no_commas - { - $$=newExpr(DIV_OP,NULL,$1,$3); - } - | expr_no_commas '%' expr_no_commas - { - $$=newExpr(MOD_OP,NULL,$1,$3); - } - | expr_no_commas ARITHCOMPARE expr_no_commas - { int op1 ; - op1 = ($2 == ((int) LE_EXPR)) ? LE_OP : GE_OP ; - $$=newExpr(op1,NULL,$1,$3); - } - | expr_no_commas '<' expr_no_commas - { - $$=newExpr(LT_OP,global_int_annotation,$1,$3); - } - | expr_no_commas '>' expr_no_commas - { - $$=newExpr(GT_OP,global_int_annotation,$1,$3); - } - | expr_no_commas EQCOMPARE expr_no_commas - { int op1 ; - op1 = ($2 == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; - $$=newExpr(op1,global_int_annotation,$1,$3); - } - | expr_no_commas '&' expr_no_commas - { - $$=newExpr(BITAND_OP,global_int_annotation,$1,$3); - } - | expr_no_commas '|' expr_no_commas - { - $$=newExpr(BITOR_OP,global_int_annotation,$1,$3); - } - | expr_no_commas '^' expr_no_commas - { - $$=newExpr(XOR_OP,NULL,$1,$3); - } - | expr_no_commas ANDAND expr_no_commas - { - $$=newExpr(AND_OP,global_int_annotation,$1,$3); - } - | expr_no_commas OROR expr_no_commas - { - $$=newExpr(OR_OP,global_int_annotation,$1,$3); - } - | expr_no_commas '?' expr_no_commas ':' expr_no_commas /* expr */ - { PTR_LLND ll_node1; - ll_node1=newExpr(EXPR_IF_BODY,$3,$5); - $$=newExpr(EXPR_IF,NULL,$1,ll_node1); - } - | expr_no_commas '=' expr_no_commas - { - $$=newExpr(ASSGN_OP,NULL,$1,$3); - } - | expr_no_commas ASSIGN expr_no_commas - { int op1 ; - op1 = map_assgn_op($2); - $$=newExpr(op1,NULL,$1,$3); - } - - ; - -const_expr_no_commas: - const_primary - { - if (exception_flag == ON) { Message("undefined symbol",0); - exception_flag =OFF; - } - $$=$1 ; - } - | unop const_expr_no_commas %prec UNARY - { - $$=newExpr($1,NULL,$2); - } - | SIZEOF const_expr_no_commas %prec UNARY - { - $$=newExpr(SIZE_OP,NULL,$2); - } - | const_expr_no_commas '+' const_expr_no_commas - { - $$=newExpr(ADD_OP,NULL,$1,$3); - } - | const_expr_no_commas '-' const_expr_no_commas - { - $$=newExpr(SUBT_OP,NULL,$1,$3); - } - | const_expr_no_commas '*' const_expr_no_commas - { - $$=newExpr(MULT_OP,NULL,$1,$3); - } - | const_expr_no_commas '/' const_expr_no_commas - { - $$=newExpr(DIV_OP,NULL,$1,$3); - } - | const_expr_no_commas '%' const_expr_no_commas - { - $$=newExpr(MOD_OP,NULL,$1,$3); - } - | const_expr_no_commas LSHIFT const_expr_no_commas - { - $$=newExpr(LSHIFT_OP,NULL,$1,$3); - } - | const_expr_no_commas RSHIFT const_expr_no_commas - { - $$=newExpr(RSHIFT_OP,NULL,$1,$3); - } - | const_expr_no_commas ARITHCOMPARE const_expr_no_commas - { int op1 ; - op1 = ($2 == ((int) LE_EXPR)) ? LE_OP : GE_OP ; - $$=newExpr(op1,NULL,$1,$3); - } - | const_expr_no_commas '<' const_expr_no_commas - { - $$=newExpr(LT_OP,NULL,$1,$3); - } - | const_expr_no_commas '>' const_expr_no_commas - { - $$=newExpr(GT_OP,NULL,$1,$3); - } - - | const_expr_no_commas EQCOMPARE const_expr_no_commas - { int op1 ; - - op1 = ($2 == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; - $$=newExpr(op1,NULL,$1,$3); - } - | const_expr_no_commas '&' const_expr_no_commas - { - $$=newExpr(BITAND_OP,NULL,$1,$3); - } - | const_expr_no_commas '|' const_expr_no_commas - { - $$=newExpr(BITOR_OP,NULL,$1,$3); - } - | const_expr_no_commas '^' const_expr_no_commas - { - $$=newExpr(XOR_OP,NULL,$1,$3); - } - | const_expr_no_commas ANDAND const_expr_no_commas - { - $$=newExpr(AND_OP,NULL,$1,$3); - } - | const_expr_no_commas OROR const_expr_no_commas - { - $$=newExpr(OR_OP,NULL,$1,$3); - } - | const_expr_no_commas '?' expr ':' const_expr_no_commas - { PTR_LLND ll_node1; - ll_node1=newExpr(EXPR_IF_BODY,$2,$3); - $$=newExpr(EXPR_IF,NULL,$1,ll_node1); - } - | const_expr_no_commas '=' const_expr_no_commas - { - $$=newExpr(ASSGN_OP,NULL,$1,$3); - } - | const_expr_no_commas ASSIGN const_expr_no_commas - { int op1 ; - op1 = map_assgn_op($2); - $$=newExpr(op1,NULL,$1,$3); - } - - ; - - -/* modified */ -primary: - IDENTIFIER - { PTR_SYMB symbptr; - symbptr = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1,NULL); - $$ = newExpr(VAR_REF,global_int_annotation,symbptr); - exception_flag = ON ; - } - | CONSTANT - { - $$ = $1 ; - } - | string - { - $$ = $1 ; - } - | '(' expr ')' - { - primary_flag = EXPR_LR ; - $$ = $2 ; - } - - | '(' error ')' - { - $$ = NULL; - } - | vector_constant %prec '.' - { - $$ = $1; - } - | primary '(' - { PTR_SYMB symb; - - if (exception_flag == ON) - { - /* strange behavior for default function */ - symb = NODE_SYMB($1); - SYMB_CODE(symb) = FUNCTION_NAME; - exception_flag = OFF ; - $$ = Make_Function_Call (symb,NULL,0,NULL); - } - else - $$ = $1 ; - } - - exprlist ')' %prec '.' - { PTR_LLND lnode_ptr ,llp ; - int status; - - llp = $3 ; - status = OFF ; - if ((llp->variant == FUNC_CALL) && (!llp->entry.Template.ll_ptr1)) - { - lnode_ptr = llp; - status = FUNC_CALL ; - } - if ((!status) &&((llp->variant == RECORD_REF)|| - (llp->variant == POINTST_OP))) - { - lnode_ptr = llp->entry.Template.ll_ptr2; - if ((lnode_ptr)&&(lnode_ptr->variant== FUNCTION_REF)) - { - lnode_ptr->variant = FUNC_CALL; - } - status = FUNC_CALL ; - } - if ((!status) &&(llp->variant== FUNCTION_REF)) - { llp->variant = FUNC_CALL ; - status = FUNC_CALL ; - lnode_ptr = llp; - } - if (!status) { - status = FUNCTION_OP; - lnode_ptr = llp; - } - switch (status) { - case FUNCTION_OP : $$ =newExpr(FUNCTION_OP,$3,$4); - $$->type = $3->type ; - break; - case FUNC_CALL : lnode_ptr->entry.Template.ll_ptr1=$4; - $$ = $3 ; - break; - default : Message("system error 10",0); - } - } - - | primary '[' expr_vector ']' %prec '.' - { int status ; - PTR_LLND ll_ptr,lp1; - - ll_ptr = check_array_id_format($1,&status); - switch (status) { - case NO : Message("syntax error ",0); - break ; - case ARRAY_OP_NEED: - lp1 = newExpr(EXPR_LIST,NULL,$3,LLNULL);/*mod*/ - $$ = newExpr(ARRAY_OP,NULL,$1,lp1); - break; - case ID_ONLY : - ll_ptr->variant = ARRAY_REF ; - ll_ptr->entry.Template.ll_ptr1 = newExpr(EXPR_LIST,NULL,$3,LLNULL); - $$ = $1 ; - break; - case RANGE_APPEAR : - ll_ptr->entry.Template.ll_ptr2 = newExpr(EXPR_LIST,NULL,$3,LLNULL); - $$ = $1 ; - break; - } -/* $$->type = adjust_deref_type($1->type,DEREF_OP);*/ - } - | primary PLUSPLUS - { - $$ = newExpr(PLUSPLUS_OP,NULL,LLNULL,$1); - $$->type = $1->type ; - } - | primary MINUSMINUS - { - $$ = newExpr(MINUSMINUS_OP,NULL,LLNULL,$1); - $$->type = $1->type ; - } - ; - - - - -/* modified */ -const_primary: - - CONSTANT - { - $$ = $1 ; - } - | '(' const_expr_no_commas ')' - { - primary_flag =EXPR_LR ; - $$ = $2 ; - } - - | '(' error ')' - { - $$ = NULL; - } - | const_primary PLUSPLUS - { - $$ = newExpr(PLUSPLUS_OP,NULL,LLNULL,$1); - } - | const_primary MINUSMINUS - { - $$ = newExpr(MINUSMINUS_OP,NULL,LLNULL,$1); - } - ; - -/* Produces a STRING_CST with perhaps more STRING_CSTs chained onto it. */ -string: - STRING - { - $$ = $1 ; - } - | string STRING - ; - -%% -int lineno; /* current line number in file being read */ - -/* comments structure */ -#define MAX_COMMENT_SIZE 1024 -char comment_buf[MAX_COMMENT_SIZE + 2]; /* OFFSET '2' to avoid boundary */ -int comment_cursor = 0; -int global_comment_type; - - -/************************************************************************* - * * - * lexical analyzer * - * * - *************************************************************************/ - -static int maxtoken; /* Current length of token buffer */ -static char *token_buffer; /* Pointer to token buffer */ -static int previous_value ; /* last token to be remembered */ - -/* frw[i] is index in rw of the first word whose length is i. */ - -#define MAXRESERVED 9 - -/*static char frw[10] = - { 0, 0, 0, 2, 6, 14, 22, 34, 39, 44 };*/ -static char frw[10] = -{ 0, 0, 0, 2, 5, 13, 21, 32, 37, 41 }; - -static char *rw[] = - { "if", "do", - "int", "for", "asm", - "case", "char", "auto", "goto", "else", "long", "void", "enum", - "float", "short", "union", "break", "while", "const", "IfDef","Label", - "double", "static", "extern", "struct", "return", "sizeof", "switch", "signed","coexec","coloop","friend", - "typedef", "default","private","cobreak", "ApplyTo", - "unsigned", "continue", "register", "volatile","operator"}; - -static short rtoken[] = - { IF, DO, - TYPESPEC, FOR, ASM, - CASE, TYPESPEC, SCSPEC, GOTO, ELSE, TYPEMOD, TYPESPEC, ENUM, - TYPESPEC, TYPEMOD, UNION, BREAK, WHILE, TYPEMOD, IFDEFA, ALABELT, - TYPESPEC, SCSPEC, SCSPEC, STRUCT, RETURN, SIZEOF, SWITCH, TYPEMOD,COEXEC,COLOOP,FRIEND, - SCSPEC, DEFAULT_TOKEN,ACCESSWORD,COBREAK, APPLYTO, - TYPEMOD, CONTINUE, SCSPEC, TYPEMOD,OPERATOR}; - -/* This table corresponds to rw and rtoken. - Its element is an index in ridpointers */ - -#define NORID RID_UNUSED - -static enum rid rid[] = - { NORID, NORID, - RID_INT, NORID, NORID, - NORID, RID_CHAR, RID_AUTO, NORID, NORID, RID_LONG, RID_VOID, NORID, - RID_FLOAT, RID_SHORT, NORID, NORID, NORID, RID_CONST, NORID, NORID, - RID_DOUBLE, RID_STATIC, RID_EXTERN, NORID, NORID, NORID, NORID, RID_SIGNED,NORID,NORID,NORID, - RID_TYPEDEF, NORID,RID_PRIVATE,NORID, NORID, - RID_UNSIGNED, NORID, RID_REGISTER, RID_VOLATILE,NORID}; - -/* The elements of `ridpointers' are identifier nodes - for the reserved type names and storage classes. -tree ridpointers[(int) RID_MAX]; -static tree line_identifier; The identifier node named "line" */ - - -void -init_lex () -{ - //extern char *malloc(); - - /* Start it at 0, because check_newline is called at the very beginning - and will increment it to 1. */ - lineno = 0; - maxtoken = 40; - lastdecl_id = 0; - token_buffer = (char *) xmalloc((unsigned)(maxtoken+1)); -} - -static void -reinit_parse_for_function () -{ -} - -/* Put char into comment buffer. When the buffer is full, we make a comment */ -/* structure and reset the comment_cursor. */ -static int -put_char_buffer(c,sw) -char c ; -int sw; -{ -/* no comment here */ -return 0; -} - -static int -skip_white_space(type) - int type ; -{ - register int c; - - - c = MYGETC(); - - for (;;) - { - switch (c) - { - case '/': - return '/'; - - case '\n': - case ' ': - case '\t': - case '\f': - case '\r': - case '\b': - c = MYGETC(); - break; - - case '\\': - c = MYGETC(); - if (c == '\n') - lineno++; - else - yyerror("stray '\\' in program"); - c = MYGETC(); - break; - - default: - return (c); - } - } -} - -/* Take care of the comments in the tail of the source code */ -static int -skip_white_space_2() -{ - register int c; - - c = MYGETC(); - for (;;) - { - switch (c) - { - case '/': - return '/'; - case '\n': - return(c); - - case ' ': - case '\t': - case '\f': - case '\r': - case '\b': - c = MYGETC(); - break; - - case '\\': - c = MYGETC(); - if (c == '\n') - lineno++; - else - yyerror("stray '\\' in program"); - c = MYGETC(); - break; - - default: - return (c); - } - } -} - - - -/* make the token buffer longer, preserving the data in it. -p should point to just beyond the last valid character in the old buffer -and the value points to the corresponding place in the new one. */ - -static char * -extend_token_buffer(p) -char *p; -{ - register char *newbuf; - register char *value; - int newlength = maxtoken * 2 + 10; - register char *p2, *p1; - extern char *malloc(); - - newbuf = malloc(newlength+1)); - - p2 = newbuf; - p1 = newbuf + newlength + 1; - while (p1 != p2) *p2++ = 0; - - value = newbuf; - p2 = token_buffer; - while (p2 != p) - *value++ = *p2++; - - token_buffer = newbuf; - - maxtoken = newlength; - - return (value); -} - - - - -#define isalnum(char) ((char >= 'a' && char <= 'z') || (char >= 'A' && char <= 'Z') || (char >= '0' && char <= '9')) -#define isdigit(char) (char >= '0' && char <= '9') -#define ENDFILE -1 /* token that represents end-of-file */ -#define isanop(d) ((d == '+') || (d == '-') || (d == '&') || (d == '|') || (d == '<') || (d == '>') || (d == '*') || (d == '/') || (d == '%') || (d == '^') || (d == '!') || (d == '=') ) - - -int -readescape () -{ - register int c = MYGETC (); - register int count, code; - - switch (c) - { - case 'x': - code = 0; - count = 0; - while (1) - { - c = MYGETC (); - if (!(c >= 'a' && c <= 'f') - && !(c >= 'A' && c <= 'F') - && !(c >= '0' && c <= '9')) - { - unMYGETC (c); - break; - } - if (c >= 'a' && c <= 'z') - c -= 'a' - 'A'; - code *= 16; - if (c >= 'a' && c <= 'f') - code += c - 'a' + 10; - if (c >= 'A' && c <= 'F') - code += c - 'A' + 10; - if (c >= '0' && c <= '9') - code += c - '0'; - count++; - if (count == 3) - break; - } - if (count == 0) - yyerror ("\\x used with no following hex digits"); - return code; - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - code = 0; - count = 0; - while ((c <= '7') && (c >= '0') && (count++ < 3)) - { - code = (code * 8) + (c - '0'); - c = MYGETC (); - } - unMYGETC (c); - return code; - - case '\\': case '\'': case '"': - return c; - - case '\n': - lineno++; - return -1; - - case 'n': - return c ; /* return TARGET_NEWLINE; */ - - case 't': - return c; /* return TARGET_TAB; */ - - case 'r': - return c;/* return TARGET_CR; */ - - case 'f': - return c;/* return TARGET_FF;*/ - - case 'b': - return c;/* return TARGET_BS;*/ - - case 'a': - return c; /* return TARGET_BELL;*/ - - case 'v': - return c; /* return TARGET_VT;*/ - } - return c; -} - - -int -yylex() -{ - register int c; - register char *p; - register int value; - int low /*,high */ ; - char *str1 ; -/* double ddval ; */ -/* int type; */ - int c3; - - - - if (recursive_yylex == OFF) new_cur_comment = (PTR_CMNT) NULL ; - - /* line_pos_1 = lineno +1 ; */ - c = skip_white_space(FULL); - /* yylloc.first_line = lineno;*/ - - switch (c) - { - case EOF: - value = ENDFILE; break; - - case 'A': case 'B': case 'C': case 'D': case 'E': - case 'F': case 'G': case 'H': case 'I': case 'J': - case 'K': case 'L': case 'M': case 'N': case 'O': - case 'P': case 'Q': case 'R': case 'S': case 'T': - case 'U': case 'V': case 'W': case 'X': case 'Y': - case 'Z': - case 'a': case 'b': case 'c': case 'd': case 'e': - case 'f': case 'g': case 'h': case 'i': case 'j': - case 'k': case 'l': case 'm': case 'n': case 'o': - case 'p': case 'q': case 'r': case 's': case 't': - case 'u': case 'v': case 'w': case 'x': case 'y': - case 'z': - case '_': - - p = token_buffer; - while (isalnum(c) || (c == '_') || (c == '~')) - { - if (p >= token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - c = MYGETC(); - } - - *p = 0; - unMYGETC(c); - - value = IDENTIFIER; - - - if (p - token_buffer <= MAXRESERVED) - { - register int lim = frw [p - token_buffer + 1]; - register int i; - - for (i = frw[p - token_buffer]; i < lim; i++) - if (rw[i][0] == token_buffer[0] && !strcmp(rw[i], token_buffer)) - { - if (rid[i]) - yylval.token = (int) rid[i] ; - value = (int) rtoken[i]; - break; - } - } - - { int temp; - if ((temp = Recog_My_Token(token_buffer)) != -1) - { - yylval.token = temp; - value = temp; - } - } - - if (value == IDENTIFIER) - { int t_status ; - PTR_LLND temp; - /* temp move it out */ - - yylval.hash_entry = look_up_type(token_buffer,&t_status); - /* if ((t_status)&&(lastdecl_id ==0)) value = TYPENAME; - Wait to fix that */ - /* temporary fix */ - temp = look_up_section(token_buffer); - if (temp) - { - yylval.ll_node = temp; - value = SECTIONT; - } - - if (look_up_specialfunction(token_buffer)) - { - value = SPECIALAF; - } - - - } - - break; - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - case '.': - { - int base = 10; - int count = 0; - int largest_digit = 0; - /* for multi-precision arithmetic, - we store only 8 live bits in each short, - giving us 64 bits of reliable precision */ - short shorts[8]; - int floatflag = 0; /* Set 1 if we learn this is a floating constant */ - - for (count = 0; count < 8; count++) - shorts[count] = 0; - - p = token_buffer; - *p++ = c; - - if (c == '0') - { - *p++ = (c = MYGETC()); - if ((c == 'x') || (c == 'X')) - { - base = 16; - *p++ = (c = MYGETC()); - } - else - { - base = 8; - } - } - - while (c == '.' - || (isalnum (c) && (c != 'l') && (c != 'L') - && (c != 'u') && (c != 'U') - && (!floatflag || ((c != 'f') && (c != 'F'))))) - { - if (c == '.') - { - if (base == 16) - yyerror ("floating constant may not be in radix 16"); - floatflag = 1; - base = 10; - *p++ = c = MYGETC (); - /* Accept '.' as the start of a floating-point number - only when it is followed by a digit. - Otherwise, unread the following non-digit - and use the '.' as a structural token. */ - if (p == token_buffer + 2 && !isdigit (c)) - { - if (c == '.') - { - c = MYGETC (); - if (c == '.') - { - value = ELLIPSIS ; - goto done ; - } - yyerror ("syntax error"); - } - unMYGETC (c); - value = '.'; - goto done; - } - } - else - { - if (isdigit(c)) - { - c = c - '0'; - } - else if (base <= 10) - { - if ((c&~040) == 'E') - { - if (base == 8) - yyerror ("floating constant may not be in radix 8"); - base = 10; - floatflag = 1; - break; /* start of exponent */ - } - yyerror ("nondigits in number and not hexadecimal"); - c = 0; - } - else if (c >= 'a') - { - c = c - 'a' + 10; - } - else - { - c = c - 'A' + 10; - } - if (c >= largest_digit) - largest_digit = c; - - for (count = 0; count < 8; count++) - { - (shorts[count] *= base); - if (count) - { - shorts[count] += (shorts[count-1] >> 8); - shorts[count-1] &= (1<<8)-1; - } - else shorts[0] += c; - } - - *p++ = (c = MYGETC()); - } - } - - if (largest_digit >= base) - yyerror ("numeric constant contains digits beyond the radix"); - - /* Remove terminating char from the token buffer and delimit the string */ - *--p = 0; - - if (floatflag) - { - /* enum rid type = DOUBLE_TYPE_CONST ; */ - - /* Read explicit exponent if any, and put it in tokenbuf. */ - - if ((c == 'e') || (c == 'E')) - { - *p++ = c; - c = MYGETC(); - if ((c == '+') || (c == '-')) - { - *p++ = c; - c = MYGETC(); - } - while (isdigit(c)) - { - *p++ = c; - c = MYGETC(); - } - } - - *p = 0; - - while (1) - { -/* if (c == 'f' || c == 'F') - type = FLOAT_TYPE_CONST ; - else if (c == 'l' || c == 'L') - type = LONG_DOUBLE_TYPE_CONST ; - else */ - - if((c != 'f') && (c != 'F') && (c != 'l') && (c !='L')) - { - if (isalnum (c)) - { - yyerror ("garbage at end of number"); - while (isalnum (c)) - c = MYGETC (); - } - break; - } - c = MYGETC (); - } - - unMYGETC(c); - -/* ddval = build_real_from_string (token_buffer, 0); */ - str1= (char *) copys(token_buffer); - yylval.ll_node = newExpr(FLOAT_VAL,NULL,LLNULL,LLNULL,str1); - - } - else - { - /* enum rid type; */ - - /* int spec_unsigned = 0; */ - /* int spec_long = 0; */ - - while (1) - { -/* if (c == 'u' || c == 'U') - { - spec_unsigned = 1; - } - else if (c == 'l' || c == 'L') - { - spec_long = 1; - } - else */ - - if((c != 'u') && (c != 'U') && (c != 'l') && (c != 'L')) - { - if (isalnum (c)) - { - yyerror ("garbage at end of number"); - while (isalnum (c)) - c = MYGETC (); - } - break; - } - c = MYGETC (); - } - - unMYGETC (c); - - /* This is simplified by the fact that our constant - is always positive. */ - - low= (shorts[3]<<24) + (shorts[2]<<16) + (shorts[1]<<8) + shorts[0] ; - /* high = (shorts[7]<<24) + (shorts[6]<<16) + (shorts[5]<<8) + shorts[4] ; */ - - - /* type = LONG_UNSIGNED_TYPE_CONST ; */ - yylval.ll_node = makeInt(low); - } - - value = CONSTANT; break; - } - - case '\'': - c = MYGETC(); - { - - tryagain: - - if (c == '\\') - { - c = readescape (); - if (c < 0) - goto tryagain; - } - else if (c == '\n') - { - Message ("ANSI C forbids newline in character constant",0); - lineno++; - } - - c3= c; - - c = MYGETC (); - if (c != '\'') - yyerror("malformatted character constant"); - yylval.ll_node = newExpr(CHAR_VAL,LLNULL,LLNULL,low); - yylval.ll_node->entry.cval = c3; - value = CONSTANT; break; - } - - case '"': - { - c = MYGETC(); - p = token_buffer; - - while (c != '"') - { - if (c == '\\') - { - /* New Added Three lines */ - if (p == token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - - c = readescape (); - if (c < 0) - goto skipnewline; - } - else if (c == '\n') - { - Message ("ANSI C forbids newline in string constant",0); - lineno++; - } - - if (p == token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - - skipnewline: - c = MYGETC (); - } - - *p++ = 0; - - str1= (char *) copys(token_buffer); - yylval.ll_node = (PTR_LLND) newNode(STRING_VAL); - NODE_STRING_POINTER(yylval.ll_node) = str1; - value = STRING; break; - } - - case '+': - case '-': - case '&': - case '|': - case '<': - case '>': - case '*': - case '/': - case '%': - case '^': - case '!': - case '=': - { - register int c1; - if ( previous_value == OPERATOR ) - { - p = token_buffer; - while (isanop(c) ) - { - if (p >= token_buffer + maxtoken) - p = extend_token_buffer(p); - *p++ = c; - c = MYGETC(); - } - *p = 0; - unMYGETC(c); - value = LOADEDOPR ; - yylval.hash_entry = look_up(token_buffer); - break; - } - combine: - - switch (c) - { - case '+': - yylval.token = (int) PLUS_EXPR; break; - case '-': - yylval.token = (int) MINUS_EXPR; break; - case '&': - yylval.token = (int) BIT_AND_EXPR; break; - case '|': - yylval.token = (int) BIT_IOR_EXPR; break; - case '*': - yylval.token = (int) MULT_EXPR; break; - case '/': - yylval.token = (int) TRUNC_DIV_EXPR; break; - case '%': - yylval.token = (int) TRUNC_MOD_EXPR; break; - case '^': - yylval.token = (int) BIT_XOR_EXPR; break; - case LSHIFT: - yylval.token = (int) LSHIFT_EXPR; break; - case RSHIFT: - yylval.token = (int) RSHIFT_EXPR; break; - case '<': - yylval.token = (int) LT_EXPR; break; - case '>': - yylval.token = (int) GT_EXPR; break; - } - - c1 = MYGETC(); - - if (c1 == '=') - { - switch (c) - { - case '<': - value = ARITHCOMPARE; yylval.token = (int) LE_EXPR; goto done; - case '>': - value = ARITHCOMPARE; yylval.token = (int) GE_EXPR; goto done; - case '!': - value = EQCOMPARE; yylval.token = (int) NE_EXPR; goto done; - case '=': - value = EQCOMPARE; yylval.token = (int) EQ_EXPR; goto done; - } - value = ASSIGN; goto done; - } - else if (c == c1) - switch (c) - { - case '+': - value = PLUSPLUS; goto done; - case '-': - value = MINUSMINUS; goto done; - case '&': - value = ANDAND; goto done; - case '|': - value = OROR; goto done; -/* testing */ -/* case ':': - value = DOUBLEMARK; goto done; */ - - case '<': - c = LSHIFT; - goto combine; - case '>': - c = RSHIFT; - goto combine; - } - else if ((c == '-') && (c1 == '>')) - { value = POINTSAT; goto done; } - unMYGETC (c1); - - - value = c; - goto done; - } - - default: - value = c; - } - -done: - - if (recursive_yylex == OFF) { - previous_value = value ; - line_pos_1 = lineno ; - c = skip_white_space_2(); - if (c != '\n'); - unMYGETC(c); - if (value != '}') - { c = skip_white_space(NEXT_FULL); - if (c == '\n') lineno++ ; - else unMYGETC(c); - } - set_up_momentum(value,yylval.token); - automata_driver(value); - cur_counter++; - old_line = yylineno ; - yylineno = line_pos_1; - } - - if (TRACEON) printf("yylex returned %d\n", value); - return (value); -} - - -static int yyerror(s) - char *s; -{ - /* Message(s,0); empty at the moment, generate false error report? - to be modified later */ - return 1; /* PHB needed a return val, 1 seems ok */ -} - - -/* primary :- primary [ expr_vector ] - * <1> check the LHS format - * <2> return : NO if incorrect format at LHS - * ID_ONLY if LHS only have id format (including multiple id) - * RANGE_APPEAR if LHS format owns both id and range_list - */ - -static -PTR_LLND check_array_id_format(ll_ptr,state) -int *state; -PTR_LLND ll_ptr ; - -{ PTR_LLND temp,temp1; - - temp = ll_ptr; - switch (NODE_CODE(ll_ptr)) { - case VAR_REF : - *state = ID_ONLY ; - return(ll_ptr); - case ARRAY_REF : - temp1 = Follow_Llnd(NODE_OPERAND0(ll_ptr),2); - *state = RANGE_APPEAR; - return(temp1); - case ARRAY_OP:temp1 = Follow_Llnd(NODE_OPERAND1(ll_ptr),2); - *state =RANGE_APPEAR ; - return(temp1); - default : *state = ARRAY_OP_NEED ; - return(temp); - } - } - -static -int -map_assgn_op(value) -int value; -{ - switch (value) { - case ((int) PLUS_EXPR) : - return(PLUS_ASSGN_OP); - case ((int) MINUS_EXPR): - return(MINUS_ASSGN_OP); - case ((int) BIT_AND_EXPR): - return(AND_ASSGN_OP); - case ((int) BIT_IOR_EXPR): - return(IOR_ASSGN_OP); - case ((int) MULT_EXPR): - return(MULT_ASSGN_OP); - case ((int) TRUNC_DIV_EXPR): - return(DIV_ASSGN_OP); - case ((int) TRUNC_MOD_EXPR): - return(MOD_ASSGN_OP); - case ((int) BIT_XOR_EXPR): - return(XOR_ASSGN_OP); - case ((int) LSHIFT_EXPR): - return(LSHIFT_ASSGN_OP); - case ((int) RSHIFT_EXPR): - return(RSHIFT_ASSGN_OP); - } -return 0; -} - -PTR_HASH -look_up_type(st, ip) - char *st; - int *ip; -{ - char *pt; - - pt = (char *) xmalloc(strlen(st) +1); - strcpy(pt,st); - /* dummy, to be cleaned */ - return (PTR_HASH) pt; -} - - -PTR_HASH -look_up(st) - char *st; -{ - char *pt; - - pt = (char *) xmalloc(strlen(st) +1); - strcpy(pt,st); - /* dummy, to be cleaned */ - return (PTR_HASH) pt; -} - -static char MYGETC() -{ - - if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) - return EOF; - - if (STRINGTOPARSE[ PTTOSTRINGTOPARSE] == '\0') - { - PTTOSTRINGTOPARSE++; - return EOF; - } - - PTTOSTRINGTOPARSE++; - return STRINGTOPARSE[ PTTOSTRINGTOPARSE-1]; -} - -static char unMYGETC(char c) -{ - if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) - return EOF; - - if (PTTOSTRINGTOPARSE >0) - PTTOSTRINGTOPARSE --; - STRINGTOPARSE[ PTTOSTRINGTOPARSE] = c; - return c; -} - - -/* CurrentScope should be the last in the list */ -static char *sectionkeyword[] = - { "NextStmt", - "NextAnnotation", - "EveryWhere", - "Follow", -/* keep it last*/ "CurrentScope"}; - - -static PTR_LLND -look_up_section(str) - char *str; -{ int i; - PTR_LLND pt = NULL; - - for (i = 0; i < RID_MAX; i++) - { - if (strcmp(sectionkeyword[i], str) == 0) - { - pt = (PTR_LLND) newNode(STRING_VAL); - NODE_STRING_POINTER(pt) = (char *) xmalloc(strlen(str) +1); - strcpy(NODE_STRING_POINTER(pt),str); - return pt; - } - if (strcmp(sectionkeyword[i],"CurrentScope") == 0) - return NULL; - } - - return NULL; -} - - -/* Dummy should be the last in the list */ -static char *specialfunction[] = - { "ListOfAn", - "Align", - "Induction", - "Used", - "Modified", - "Alias", - "Permutation", - "Assert", -/* keep it last*/ "Dummy"}; - -static int -look_up_specialfunction(str) - char *str; -{ int i; - - for (i = 0; i < RID_MAX; i++) - { - if (strcmp(specialfunction[i], str) == 0) - { - return TRUE; - } - if (strcmp(specialfunction[i],"Dummy") == 0) - return 0; - } - - return 0; -} - - -static int -Recog_My_Token(str) -char *str; -{ - - if (strcmp("FromAnn",str) == 0) - return FROMT; - - if (strcmp("ToAnn",str) == 0) - return TOT; - - if (strcmp("ToLabel",str) == 0) - return TOTLABEL; - - if (strcmp("ToFunction",str) == 0) - return TOFUNCTION; - - if (strcmp("Define",str) == 0) - return DefineANN; - - return -1; -} - - -PTR_SYMB -Look_For_Symbol_Ann(code,name,type) - int code; - char *name; - PTR_TYPE type; -{ - PTR_SYMB symb; - char temp1[256]; - - strcpy(temp1, AnnExTensionNumber); - strncat(temp1,name,255); - - if ((symb = getSymbolWithName(temp1, ANNOTATIONSCOPE))) - return symb; - - if ((symb = getSymbolWithName(name, ANNOTATIONSCOPE))) - return symb; - - return newSymbol (code,name,type); -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/comments.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/comments.c deleted file mode 100644 index 5159ce6..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/comments.c +++ /dev/null @@ -1,694 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993,1995 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* Created By Jenq-Kuen Lee April 14, 1988 */ -/* A Sub-program to help yylex() catch all the comments */ -/* A small finite automata used to identify the input token corresponding to */ -/* Bif node position */ - -#include -#include "vparse.h" -#include "vpc.h" -#include "db.h" -#include "vextern.h" -#include "annotate.tab.h" - -extern void Message(char *s, int l); - -void reset_semicoln_handler(); -void reset(); -int class_struct(int value); -int is_declare(int value); -int declare_symb(int value); -int block_like(int state); -int keep_original(int state); - -int lastdecl_id; /* o if no main_type appeared */ -int left_paren ; -static int cur_state ; -int cur_counter; - -struct { - PTR_CMNT stack[MAX_NESTED_SIZE]; - int counter[MAX_NESTED_SIZE]; - int node_type[MAX_NESTED_SIZE]; - int automata_state[MAX_NESTED_SIZE]; - int top ; - } comment_stack ; - - -struct { - PTR_CMNT stack[MAX_NESTED_SIZE + 1 ]; - int front ; - int rear ; - } comment_queue; - -struct { - int line_stack[MAX_NESTED_SIZE + 1 ]; - PTR_FNAME file_stack[MAX_NESTED_SIZE + 1 ]; - int front ; - int rear ; - int BUGGY[100]; /* This is included because some versions of - gcc seemed to have bugs that overwrite - previous fields without. */ - } line_queue; - - -PTR_FNAME find_file_entry() -{ - /* dummy, should not be use after cleaning */ - return NULL; -} - - -void put_line_queue(line_offset,name) -int line_offset ; -char *name; -{ PTR_FNAME find_file_entry(); - - if (line_queue.rear == MAX_NESTED_SIZE) line_queue.rear = 0; - else line_queue.rear++; - if (line_queue.rear == line_queue.front) Message("stack/queue overflow",0); - line_queue.line_stack[line_queue.rear] = line_offset ; - line_queue.file_stack[line_queue.rear] = find_file_entry(name); -} - - -PTR_FNAME -fetch_line_queue(line_ptr ) -int *line_ptr; -{ - if (line_queue.front == line_queue.rear) - { *line_ptr = line_queue.line_stack[line_queue.front] ; - return(line_queue.file_stack[line_queue.front]); - } - if (line_queue.front == MAX_NESTED_SIZE) line_queue.front = 0; - else line_queue.front++; - *line_ptr = line_queue.line_stack[line_queue.front] ; - return(line_queue.file_stack[line_queue.front]); -} - - -void push_state() -{ - comment_stack.top++; - comment_stack.stack[ comment_stack.top ] = cur_comment ; - comment_stack.counter[ comment_stack.top ] = cur_counter ; - comment_stack.automata_state[ comment_stack.top ] = cur_state ; -} - -void pop_state() -{ - - cur_comment = comment_stack.stack[ comment_stack.top ] ; - cur_counter = comment_stack.counter[ comment_stack.top ] ; - cur_state = comment_stack.automata_state[ comment_stack.top ] ; - comment_stack.top--; - -} - -void init_stack() -{ - comment_stack.top = 0 ; - comment_stack.automata_state[ comment_stack.top ] = ZERO; -} - - - -void automata_driver(value) -int value ; -{ - int shift_flag ; - int temp_state ; - - - - for (shift_flag = ON ; shift_flag==ON ; ) -{ shift_flag = OFF ; - - switch(cur_state) { - - case ZERO : - - switch (value) { - case IF : - put_line_queue(line_pos_1,line_pos_fname); - cur_state = IF_STATE; - break ; - case ELSE : - put_line_queue(line_pos_1,line_pos_fname); - cur_state = ELSE_EXPECTED_STATE ; - break; - case DO : - put_line_queue(line_pos_1,line_pos_fname); - cur_state = DO_STATE ; - break; - case FOR : - put_line_queue(line_pos_1,line_pos_fname); - cur_state = FOR_STATE ; - break; - case CASE : - case DEFAULT_TOKEN: - put_line_queue(line_pos_1,line_pos_fname); - cur_state = CASE_STATE; - break; - case GOTO : - put_line_queue(line_pos_1,line_pos_fname); - cur_state = GOTO_STATE; - break; - case WHILE : - put_line_queue(line_pos_1,line_pos_fname); - cur_state = WHILE_STATE; - break; - case SWITCH: - put_line_queue(line_pos_1,line_pos_fname); - cur_state = SWITCH_STATE; - break; - case COEXEC : - cur_state = COEXEC_STATE ; - put_line_queue(line_pos_1,line_pos_fname); - break; - case COLOOP: - put_line_queue(line_pos_1,line_pos_fname); - cur_state = COLOOP_STATE ; - break; - case RETURN: - put_line_queue(line_pos_1,line_pos_fname); - cur_state = RETURN_STATE ; - break; - case '}': - pop_state(); - switch (cur_state) { - case ELSE_EXPECTED_STATE: - put_line_queue(line_pos_1,line_pos_fname); - break; - case STATE_4: - case BLOCK_STATE: - put_line_queue(line_pos_1,line_pos_fname); - reset(); - reset_semicoln_handler(); - break; - case IF_STATE_4: - cur_state= ELSE_EXPECTED_STATE; - put_line_queue(line_pos_1,line_pos_fname); - break; - case DO_STATE_1: - cur_state= DO_STATE_2; - reset_semicoln_handler(); - break; - case DO_STATE_2: - case STATE_2: - break; - default: - reset(); - reset_semicoln_handler(); - } - - break ; - - case '{': - temp_state=comment_stack.automata_state[comment_stack.top]; - if (temp_state == STATE_ARG) - comment_stack.automata_state[comment_stack.top]= STATE_4; - else { cur_state = BLOCK_STATE ; - put_line_queue(line_pos_1,line_pos_fname); - push_state(); - } - reset(); - break ; - case '(': - put_line_queue(line_pos_1,line_pos_fname); - cur_state = STATE_15; - left_paren++; - break; - case IDENTIFIER: - put_line_queue(line_pos_1,line_pos_fname); - cur_state = STATE_6 ; - break; - case ';': - reset_semicoln_handler(); - break; - default : /* other */ - put_line_queue(line_pos_1,line_pos_fname); - if (class_struct(value)) cur_state = STATE_10 ; - else cur_state = STATE_1 ; - break; - } - break; - case STATE_1 : - if (value == '(') { cur_state =STATE_15 ; - left_paren++; - } - if (class_struct(value)) cur_state =STATE_10 ; - if (value == IDENTIFIER) cur_state =STATE_2 ; - if (value == OPERATOR) cur_state =STATE_4 ; - if (value ==';') reset_semicoln_handler(); - break ; - - case STATE_2 : - if (value == '(') { cur_state = STATE_15 ; - left_paren++; - } - if (value ==';') { - reset(); - reset_semicoln_handler(); - } - break; - - case STATE_4: - switch (value) { - case '(': - cur_state = STATE_15 ; - left_paren++; - break; - case '{': /* cur_state = STATE_5; */ - push_state(); - reset(); - break; - case '=': - case ',': - cur_state = STATE_12; - break; - case ';': - reset_semicoln_handler(); - break; - default: - if (is_declare(value)) - { cur_state = STATE_ARG ; - push_state(); - reset(); - } - else cur_state = STATE_12; - } - - break; - case STATE_6: - if (value == ':') cur_state = ZERO; - else { - if (value ==';') reset_semicoln_handler(); - else { cur_state = STATE_2; - shift_flag = ON ; - } - } - break; - case STATE_10 : - if (value =='{') - { cur_state = STATE_2 ; - push_state(); - reset(); - } - if ((value == '=' )||(value ==',')) cur_state = STATE_12; - if (value == '(' ) { cur_state = STATE_15; - left_paren++; - } - if (value ==';') reset_semicoln_handler(); - break ; - case STATE_12: - if (value ==';') reset_semicoln_handler(); - break ; - - case STATE_15 : - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = STATE_4 ; - break ; - case IF_STATE: - if (value == '(') { left_paren++; - cur_state = IF_STATE_2; - } - break; - case IF_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = IF_STATE_3 ; - break ; - case IF_STATE_3: - if (value == ';') { - put_line_queue(line_pos_1,line_pos_fname); - cur_state= ELSE_EXPECTED_STATE ; - } - if (value =='{') { cur_state= ELSE_EXPECTED_STATE ; - push_state(); - cur_state = ZERO ; /* counter continuing */ - } - if (cur_state == IF_STATE_3) - { cur_state = IF_STATE_4 ; - push_state(); - reset(); - shift_flag = ON; - } - break; - - case ELSE_EXPECTED_STATE: - if (value == ELSE) cur_state = BLOCK_STATE ; - else { - reset(); - reset_semicoln_handler(); - shift_flag = ON ; - } - break; - - case BLOCK_STATE: - if (value ==';') { - cur_state = BLOCK_STATE_WAITSEMI; - push_state(); - reset_semicoln_handler(); - } - if (value == '{') { push_state(); - reset(); - } - if (cur_state == BLOCK_STATE) - { - cur_state = BLOCK_STATE_WAITSEMI; - push_state(); - reset(); - shift_flag = ON ; - } - break; - - case WHILE_STATE: - if (value == '('){ left_paren++; - cur_state = WHILE_STATE_2; - } - break; - case WHILE_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = BLOCK_STATE ; - break ; - - case FOR_STATE: - if (value == '(') { left_paren++; - cur_state = FOR_STATE_2; - } - break; - case FOR_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = BLOCK_STATE ; - break ; - - case COLOOP_STATE: - if (value == '(') { left_paren++; - cur_state = COLOOP_STATE_2; - } - break; - case COLOOP_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = BLOCK_STATE ; - break ; - - case COEXEC_STATE: - if (value == '(') { left_paren++; - cur_state = COEXEC_STATE_2; - } - break; - case COEXEC_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = BLOCK_STATE ; - break ; - - case SWITCH_STATE: - if (value == '(') { left_paren++; - cur_state = SWITCH_STATE_2; - } - break; - case SWITCH_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = BLOCK_STATE ; - break ; - - case CASE_STATE : - if (value == ':') reset(); - break; - case DO_STATE : /* Need More, some problem exists */ - if (value == ';') { cur_state = DO_STATE_2 ; } - if (value == '{') { cur_state = DO_STATE_2 ; - push_state(); - reset(); - } - if (cur_state == DO_STATE) - { cur_state = DO_STATE_1 ; - push_state(); - reset(); - shift_flag = ON; - } - break; - case DO_STATE_2: - if (value == WHILE) cur_state= DO_STATE_3 ; - break ; - case DO_STATE_3: - if (value == '(') { cur_state = DO_STATE_4 ; - left_paren++; - } - break; - case DO_STATE_4: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = DO_STATE_5 ; - break ; - case DO_STATE_5: - if (value ==';') - { - put_line_queue(line_pos_1,line_pos_fname); - reset(); - reset_semicoln_handler(); - } - break; - case RETURN_STATE: - if (value ==';') reset_semicoln_handler(); - if (value == '(') { left_paren++; - cur_state = RETURN_STATE_2 ; - } - break; - case RETURN_STATE_2: - if (value == '(') left_paren++ ; - if (value == ')') left_paren--; - if (left_paren == 0) cur_state = RETURN_STATE_3 ; - break ; - case RETURN_STATE_3: - if (value ==';') reset_semicoln_handler(); - break; - case GOTO_STATE: - if (value == IDENTIFIER) cur_state = GOTO_STATE_2 ; - break; - case GOTO_STATE_2: - if (value ==';') reset_semicoln_handler(); - break; - default: - Message(" comments state un_expected...",0); - break; - } - - - } - -} - -int class_struct(int value) -{ - switch (value) { - case ENUM : - case CLASS: - case STRUCT : - case UNION: return(1); - default : return(0); - } -} - -int declare_symb(int value) -{ - switch (value) { - case TYPENAME : - case TYPESPEC: - case TYPEMOD: - case ACCESSWORD: - case SCSPEC: - case ENUM : - case CLASS: - case STRUCT : - case UNION: return(1); - default : return(0); - } -} - - -void reset() -{ - cur_state = 0 ; - cur_counter = 0 ; - cur_comment = (PTR_CMNT) NULL ; - -/* put_line_queue(line_pos_1,line_pos_fname); */ - } - -int block_like(int state) -{ - - switch( state) { - case BLOCK_STATE: - case ZERO: - case SWITCH_STATE: - case FOR_STATE : - case WHILE_STATE : - case COEXEC_STATE : - case COLOOP_STATE: - case STATE_4: /* end of function_body */ - return(1); - default: return(0); - } -} - -int is_declare(int value) -{ - switch (value) { - case TYPENAME: - case TYPESPEC : - case ACCESSWORD: - case SCSPEC: - case TYPEMOD: - case ENUM: - case UNION: - case CLASS: - case STRUCT: return(1); - default : return(0); - } -} - - - -/* pop state until reach a stable state BLOCK_STATE or ZERO */ -void reset_semicoln_handler() -{ - int sw,state; - - for (sw=1; sw; ) - { - if (keep_original(cur_state)) return; - state = comment_stack.automata_state[comment_stack.top]; - switch (state) { - case IF_STATE_4: - pop_state(); - cur_state = ELSE_EXPECTED_STATE ; - put_line_queue(line_pos_1,line_pos_fname); - break; - case DO_STATE_1: - pop_state(); - cur_state = DO_STATE_2 ; - break; - case BLOCK_STATE_WAITSEMI: - put_line_queue(line_pos_1,line_pos_fname); - pop_state(); - reset(); - break; - default : - reset(); - sw = 0 ; - } - } - -} - - -int keep_original(int state) -{ - switch (state) { - case ELSE_EXPECTED_STATE: - case DO_STATE_2: - case STATE_2: - return(1); - default: - return(0); - } -} - - - - - -/*****************************************************************************/ -/* is_at_decl_state() & is_look_ahead_of_identifier() */ -/* These two routines are used in yylex to identify if a TYPENAME is just */ -/* a IDENTIFIER */ -/* */ -/*****************************************************************************/ -int -is_at_decl_state() -{ - - /* to see if it is inside (, ) */ - switch(cur_state) { - case STATE_15: - case IF_STATE_2: - case WHILE_STATE_2: - case FOR_STATE_2: - case COLOOP_STATE_2: - case COEXEC_STATE_2: - case SWITCH_STATE_2: - case DO_STATE_4: - return(0); - default: - return(1); - } -} - - -int is_look_ahead_of_identifier(c) -char c; -{ - switch (c) { - case ':' : - case '(': - case '[': - case ',': - case ';': - case '=': - return(1); - default: - return(0); - } - -} - - -void set_up_momentum(value,token) -int value,token; -{ - - if (lastdecl_id == 0) - { - /* check if main_type appears */ - switch (value) { - case TYPESPEC: - lastdecl_id = 1; - break; - case TYPEMOD: - if ((token == (int)RID_LONG)||(token == (int)RID_SHORT)|| - (token==(int)RID_SIGNED)||(token==(int)RID_UNSIGNED)) - lastdecl_id = 1; - break; - } - } - else - { - /* case for main_type already appear, then check if - 1. this is still a decl. - 2. reset it to wait for another decl stat. */ - switch (value) { - case TYPESPEC: - case TYPEMOD: - case SCSPEC: - break; - default: - lastdecl_id = 0; - } - } - -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/low_level.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/low_level.c deleted file mode 100644 index 320bb45..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/low_level.c +++ /dev/null @@ -1,9147 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* This file is used to automatically generate a "#include" header */ -/* -mkCextern $SAGEROOT/lib/newsrc/low_level.c > ! $SAGEROOT/lib/include/ext_low.h -mkC++extern $SAGEROOT/lib/newsrc/low_level.c > ! $SAGEROOT/lib/include/extcxx_low.h -*/ - -#include - -#include -#include /* ANSI variable argument header */ -#include - -#include "compatible.h" /* Make different system compatible... (PHB) */ -#ifdef SYS5 -#include -#else -#include -#endif - -#include "vpc.h" -#include "macro.h" -#include "ext_lib.h" - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -extern void removeFromCollection(void *pointer); -#endif - -#define MAX_FILE 1000 /*max number of files in a project*/ -#define MAXFIELDSYMB 10 -#define MAXFIELDTYPE 10 -#define MAX_SYMBOL_FOR_DUPLICATE 1000 -char Current_File_name[256]; - -int debug =NO; /* used in db.c*/ - -PTR_FILE pointer_on_file_proj; -static int number_of_bif_node = 0; -int number_of_ll_node = 0; /* this counters are useless anymore ??*/ -static int number_of_symb_node = 0; -static int number_of_type_node = 0; -char *default_filename; -int Warning_count = 0; - -/* FORWARD DECLARATIONS (phb) */ -int buildLinearRepSign(); -int makeLinearExpr_Sign(); -int getLastLabelId(); -int isItInSection(); -int Init_Tool_Box(); -void Message(); - -PTR_BFND rec_num_near_search(); -PTR_BFND Redo_Bif_Next_Chain_Internal(); -PTR_SYMB duplicateSymbol(); -void Redo_Bif_Next_Chain(); -PTR_LABEL getLastLabel(); -PTR_BFND getNodeBefore (); -char *filter(); -PTR_BFND getLastNodeList(); -int *evaluateExpression(); -PTR_SYMB duplicateSymbolOfRoutine(); -void SetCurrentFileTo(); -void UnparseProgram_ThroughAllocBuffer(); -void updateTypesAndSymbolsInBodyOfRoutine(); - -extern int write_nodes(); -extern char* Tool_Unparse2_LLnode(); -extern void Init_Unparser(); -extern void Set_Function_Language(); -extern void Unset_Function_Language(); -extern char* Tool_Unparse_Bif (); -extern char* Tool_Unparse_Type(); -extern void BufferAllocate(); - -int out_free_form; -int out_upper_case; -int out_line_unlimit; -int out_line_length; // out_line_length = 132 for -ffo mode; out_line_length = 72 for -uniForm mode -PTR_SYMB last_file_symbol; - -static int CountNullBifNext = 0; /* for internal debugging */ - -/* records propoerties and type of node */ -char node_code_type[LAST_CODE]; -/* Number of argument-words in each kind of tree-node. */ -int node_code_length[LAST_CODE]; -enum typenode node_code_kind[LAST_CODE]; -/* special table for infos on type and symbol */ -char info_type[LAST_CODE][MAXFIELDTYPE]; -char info_symb[LAST_CODE][MAXFIELDSYMB]; -char general_info[LAST_CODE][MAXFIELDSYMB]; -/*static struct bif_stack_level *stack_level = NULL;*/ -/*static struct bif_stack_level *current_level = NULL;*/ - -PTR_BFND getFunctionHeader(); - -/***************************************************************************** - * * - * Procedure of general use * - * * - *****************************************************************************/ - -/* Modified to return a pointer (64bit clean) (phb) */ -/***************************************************************************/ -char* xmalloc(int size) -{ - char *val; - val = (char *) malloc (size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,val, 0); -#endif - if (val == 0) - Message("Virtual memory exhausted (malloc failed)",0); - return val; -} - -/* list of allocated data */ -static ptstack_chaining Current_Allocated_Data = NULL; -static ptstack_chaining First_STACK= NULL; - -/***************************************************************************/ -void make_a_malloc_stack() -{ - ptstack_chaining pt; - - pt = (ptstack_chaining) malloc(sizeof(struct stack_chaining)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,pt, 0); -#endif - if (!pt) - { - Message("sorry : out of memory\n",0); - exit(1); - } - - if (Current_Allocated_Data) - Current_Allocated_Data->next = pt; - pt->first = NULL; - pt->last = NULL; - pt->prev = Current_Allocated_Data; - if (Current_Allocated_Data) - pt->level = Current_Allocated_Data->level +1; - else - pt->level = 0; -/* printf("make_a_malloc_stack %d \n",pt->level);*/ - Current_Allocated_Data = pt; - if (First_STACK == NULL) - First_STACK = pt; -} - -/***************************************************************************/ -void myfree() -{ - ptstack_chaining pt; - ptchaining pt1, pt2; - if (!Current_Allocated_Data) - { - Message("Stack not defined\n",0); - exit(1); - } - - pt2 = Current_Allocated_Data->first; - -/* printf("myfree %d \n", Current_Allocated_Data->level);*/ - while (pt2) - { -#ifdef __SPF - removeFromCollection(pt2->zone); -#endif - free(pt2->zone); - pt2->zone = 0; - pt2 = pt2->list; - } - - pt2 = Current_Allocated_Data->first; - while (pt2) - { - pt1 = pt2; - pt2 = pt2->list; -#ifdef __SPF - removeFromCollection(pt1); -#endif - free(pt1); - } - pt = Current_Allocated_Data; - Current_Allocated_Data = pt->prev; - Current_Allocated_Data->next = NULL; -#ifdef __SPF - removeFromCollection(pt); -#endif - free(pt); -} - - -/***************************************************************************/ -char* mymalloc(int size) -{ - char *pt1; - ptchaining pt2; - if (!Current_Allocated_Data) - { - Message("Allocated Stack not defined\n",0); - exit(1); - } - -/* if (Current_Allocated_Data->level > 0) - printf("mymalloc %d \n", Current_Allocated_Data->level); */ - pt1 = (char *) malloc(size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,pt1, 0); -#endif - if (!pt1) - { - Message("sorry : out of memory\n",0); - exit(1); - } - - pt2 = (ptchaining) malloc(sizeof(struct chaining)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,pt2, 0); -#endif - if (!pt2 ) - { - Message("sorry : out of memory\n",0); - exit(1); - } - - pt2->zone = pt1; - pt2->list = NULL; - - if (Current_Allocated_Data->first == NULL) - Current_Allocated_Data->first = pt2; - - if (Current_Allocated_Data->last == NULL) - Current_Allocated_Data->last = pt2; - else - { - Current_Allocated_Data->last->list = pt2; - Current_Allocated_Data->last = pt2; - } - return pt1; -} - -/***************** Provides infos on nodes ******************************** - * * - * based on the table info in include dir *.def * - * * - **************************************************************************/ - -/***************************************************************************/ -int isATypeNode(variant) -int variant; -{ - return (TYPENODE == (int) node_code_kind[variant]); -} - -/***************************************************************************/ -int isASymbNode(variant) -int variant; -{ - return (SYMBNODE == (int) node_code_kind[variant]); -} - -/***************************************************************************/ -int isABifNode(variant) -int variant; -{ - return (BIFNODE == (int) node_code_kind[variant]); -} - -/***************************************************************************/ -int isALoNode(variant) -int variant; -{ - return (LLNODE == (int) node_code_kind[variant]); -} - -/***************************************************************************/ -int hasTypeBaseType(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("hasTypeBaseType not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][2] == 'b') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isStructType(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("isStructType not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][0] == 's') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isPointerType(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("isPointerType not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][0] == 'p') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isUnionType(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("isUnionType not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][0] == 'u') - return TRUE; - else - return FALSE; -} - - -/***************************************************************************/ -int isEnumType(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("EnumType not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][0] == 'e') - return TRUE; - else - return FALSE; -} - - -/***************************************************************************/ -int hasTypeSymbol(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("hasTypeSymbol not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][1] == 's') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isAtomicType(variant) -int variant; -{ - if (!isATypeNode(variant)) - { -#if !__SPF - Message("isAtomicType not applied to a type node", 0); -#endif - return FALSE; - } - if (info_type[variant][0] == 'a') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int hasNodeASymb(variant) -int variant; -{ - if ((!isABifNode(variant)) && (!isALoNode(variant))) - { -#if !__SPF - Message("hasNodeASymb not applied to a bif or low level node", 0); -#endif - return FALSE; - } - if (general_info[variant][2] == 's') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isNodeAConst(variant) -int variant; -{ - if ((!isABifNode(variant)) && (!isALoNode(variant))) - { -#if !__SPF - Message("isNodeAConst not applied to a bif or low level node", 0); -#endif - return FALSE; - } - if (general_info[variant][1] == 'c') - return TRUE; - else - return FALSE; -} - - -/***************************************************************************/ -int isAStructDeclBif(variant) -int variant; -{ - if (!isABifNode(variant)) - { -#if !__SPF - Message("isAStructDeclBif not applied to a bif", 0); -#endif - return FALSE; - } - if (general_info[variant][1] == 's') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isAUnionDeclBif(variant) -int variant; -{ - if (!isABifNode(variant)) - { -#if !__SPF - Message("isAUnionDeclBif not applied to a bif", 0); -#endif - return FALSE; - } - if (general_info[variant][1] == 'u') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isAEnumDeclBif(variant) -int variant; -{ - if (!isABifNode(variant)) - { -#if !__SPF - Message("isAEnumDeclBif not applied to a bif", 0); -#endif - return FALSE; - } - if (general_info[variant][1] == 'e') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isADeclBif(variant) -int variant; -{ - if (!isABifNode(variant)) - { -#if !__SPF - Message("isADeclBif not applied to a bif", 0); -#endif - return FALSE; - } - if (general_info[variant][0] == 'd') - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -int isAControlEnd(variant) -int variant; -{ - if (!isABifNode(variant)) - { -#if !__SPF - Message("isAControlEnd not applied to a bif", 0); -#endif - return FALSE; - } - if (general_info[variant][0] == 'c') - return TRUE; - else - return FALSE; -} - -#ifdef __SPF -extern void printLowLevelWarnings(const char *fileName, const int line, const wchar_t* messageR, const char *message, const int group); -#endif -/***************************************************************************/ -void Message(char *s, int l) -{ - if (l != 0) - fprintf(stderr, "Warning : %s line %d\n", s, l); - else - fprintf(stderr, "Warning : %s\n", s); - Warning_count++; -#ifdef __SPF - if (l == 0) - l = 1; - - printLowLevelWarnings(cur_file->filename, l, NULL, s, 4001); - - if (strstr(s, "Error in")) - { - char buf[512]; - sprintf(buf, "Internal error at line %d and file low_level.c\n", __LINE__); - addToGlobalBufferAndPrint(buf); - throw -1; - } -#endif -} - - -/***************************************************************************/ -/* A set of functions for dealing with a free list for low_level node */ -/***************************************************************************/ - -static int ExpressionNodeInFreeList = 0; -static ptstack_chaining expressionFreeNodeList = NULL; - -void setFreeListForExpressionNode() -{ - if (ExpressionNodeInFreeList) return; - - ExpressionNodeInFreeList = 1; - if (!expressionFreeNodeList) - { - expressionFreeNodeList = (ptstack_chaining) xmalloc(sizeof(struct stack_chaining)); - expressionFreeNodeList->first = NULL; - expressionFreeNodeList->last = NULL; - expressionFreeNodeList->prev = NULL; - expressionFreeNodeList->level = 0; - } -} - - -void resetFreeListForExpressionNode() -{ - ExpressionNodeInFreeList = 0; -} - - -/* Added for garbage collection */ -void libFreeExpression(ll) - PTR_LLND ll; -{ - ptchaining pt2; - - if (!ExpressionNodeInFreeList) return; - if (!ll) return; - if (!expressionFreeNodeList) - { - Message("Free list for expression node not defined\n",0); - exit(1); - } - pt2 = (ptchaining) xmalloc(sizeof(struct chaining)); - pt2->zone = (char *) ll; - pt2->list = NULL; - - if (expressionFreeNodeList->first == NULL) - expressionFreeNodeList->first = pt2; - - if (expressionFreeNodeList->last == NULL) - expressionFreeNodeList->last = pt2; - else - { - expressionFreeNodeList->last->list = pt2; - expressionFreeNodeList->last = pt2; - } -} - -char *allocateFreeListNodeExpression() -{ - char *pt; - ptchaining pt2; - - if (!ExpressionNodeInFreeList) return xmalloc(sizeof (struct llnd)); - if (!expressionFreeNodeList) - { - Message("Free list for expression node not defined\n",0); - exit(1); - } - if (expressionFreeNodeList->first == NULL) return xmalloc(sizeof (struct llnd)); - - pt2 = expressionFreeNodeList->first; - if (expressionFreeNodeList->first == expressionFreeNodeList->last) - { - expressionFreeNodeList->first = NULL; - expressionFreeNodeList->last = NULL; - } else - expressionFreeNodeList->first = pt2->list; - - pt = pt2->zone; -#ifdef __SPF - removeFromCollection(pt2); -#endif - free(pt2); - memset((char *) pt, 0 , sizeof (struct llnd)); - return pt; -} - - -/***************************************************************************/ -POINTER newNode(code) - int code; -{ - PTR_BFND tb = NULL; - PTR_LLND tl = NULL; - PTR_TYPE tt = NULL; - PTR_SYMB ts = NULL; - PTR_LABEL tlab; - PTR_CMNT tcmnt; - PTR_BLOB tbl; - int length; - int kind; - - if (code == CMNT_KIND) - { /* lets create a comment */ - - length = sizeof(struct cmnt); - tcmnt = (PTR_CMNT)xmalloc(length); - memset((char *)tcmnt, 0, length); - CMNT_ID(tcmnt) = ++CUR_FILE_NUM_CMNT(); - CMNT_NEXT(tcmnt) = PROJ_FIRST_CMNT(); - PROJ_FIRST_CMNT() = tcmnt; - return (POINTER)tcmnt; - } - - if (code == LABEL_KIND) - { /* lets create a label */ - PTR_LABEL last; - - /* allocating space... PHB */ - length = sizeof (struct Label); - tlab = (PTR_LABEL) xmalloc(length); - memset((char *) tlab, 0, length); - LABEL_ID(tlab) = ++CUR_FILE_NUM_LABEL(); - - if ((last=getLastLabel())) /* is there an existing label? PHB */ - { - LABEL_NEXT(last)=tlab; - return (POINTER) tlab; - } - else /* There is no existing label, make one PHB */ - { - LABEL_NEXT(tlab) = LBNULL; - PROJ_FIRST_LABEL() = tlab; /* set pointer to first label */ - return (POINTER) tlab; - } - } - - if (code == BLOB_KIND) - { - length = sizeof (struct blob); - tbl = (PTR_BLOB) xmalloc (length); - memset((char *) tbl, 0, length); - CUR_FILE_NUM_BLOBS()++; - return (POINTER) tbl; - } - - - kind = (int) node_code_kind[(int) code]; - switch (kind) - { - case BIFNODE: - length = sizeof (struct bfnd); - break; - case LLNODE : - length = sizeof (struct llnd); - break; - case SYMBNODE: - length = sizeof (struct symb); - break; - case TYPENODE: - length = sizeof (struct data_type); - break; - default: - Message("Node inconnu",0); - } - - switch (kind) - { - case BIFNODE: - tb = (PTR_BFND) xmalloc(length); - memset((char *) tb, 0, length); - BIF_ID (tb) = ++CUR_FILE_NUM_BIFS (); - number_of_bif_node++; - /*BIF_ID (tb) = number_of_bif_node++;*/ - BIF_CODE(tb) = code; - BIF_FILE_NAME(tb) = CUR_FILE_HEAD_FILE();/* recently added, to check */ - CUR_FILE_CUR_BFND() = tb; - BIF_LINE(tb) = 0; /* set to know that this is a new node */ - break; - case LLNODE : - if (ExpressionNodeInFreeList) - tl = (PTR_LLND) allocateFreeListNodeExpression(); - else - { - tl = (PTR_LLND) xmalloc(length); - memset((char *) tl, 0, length); - } - NODE_ID (tl) = ++CUR_FILE_NUM_LLNDS(); - NODE_NEXT (tl) = LLNULL; - number_of_ll_node++; - if (CUR_FILE_NUM_LLNDS() == 1) - PROJ_FIRST_LLND () = tl; - else - NODE_NEXT (CUR_FILE_CUR_LLND()) = tl; - CUR_FILE_CUR_LLND() = tl; - NODE_CODE(tl) = code; - break; - case SYMBNODE: - ts = (PTR_SYMB) xmalloc(length); - memset((char *) ts, 0, length); - number_of_symb_node++; - SYMB_ID (ts) = ++CUR_FILE_NUM_SYMBS(); - SYMB_CODE(ts) = code; - if (CUR_FILE_NUM_SYMBS() == 1) - PROJ_FIRST_SYMB () = ts; - else - SYMB_NEXT (CUR_FILE_CUR_SYMB()) = ts; - CUR_FILE_CUR_SYMB() = ts; - SYMB_NEXT (ts) = NULL; - SYMB_SCOPE (ts) = PROJ_FIRST_BIF();/* the default value */ - break; - case TYPENODE: - /*tt = (PTR_TYPE) alloc_type ( cur_file ); xmalloc(length); - number_of_type_node++; - TYPE_ID (tt) = number_of_type_node++; - TYPE_NEXT (tt) = NULL;*/ - - tt = (PTR_TYPE) xmalloc (length); - memset((char *) tt, 0, length); - number_of_type_node++; - TYPE_ID (tt) = ++CUR_FILE_NUM_TYPES(); - TYPE_CODE (tt) = code; - TYPE_NEXT (tt) = NULL; - if (CUR_FILE_NUM_TYPES () == 1) - PROJ_FIRST_TYPE() = tt; - else - TYPE_NEXT (CUR_FILE_CUR_TYPE()) = tt; - CUR_FILE_CUR_TYPE() = tt; - /* for VPC very ugly and should be removed later */ - if (code == T_POINTER) TYPE_TEMPLATE_DUMMY1(tt) = 1 ; - if (code == T_REFERENCE) TYPE_TEMPLATE_DUMMY1(tt) = 1 ; - break; - default: - Message("Node inconnu",0); - } - - - switch (kind) - { - case BIFNODE: - return (POINTER) tb; - case LLNODE : - return (POINTER) tl; - case SYMBNODE: - return (POINTER) ts; - case TYPENODE: - return (POINTER) tt; - default: - Message("Node inconnu",0); - } - return NULL; -} - -/***************************************************************************/ -PTR_LLND copyLlNode(node) - PTR_LLND node; -{ - PTR_LLND t; - int code; - - if (!node) - return NULL; - - code = NODE_CODE (node); - if (node_code_kind[(int) code] != LLNODE) - Message("bif_copy_node != low_level_node",0); - - t = (PTR_LLND) newNode (code); - - NODE_SYMB(t) = NODE_SYMB(node); - NODE_TYPE(t) = NODE_TYPE(node); - NODE_OPERAND0(t) = copyLlNode(NODE_OPERAND0(node)); - NODE_OPERAND1(t) = copyLlNode(NODE_OPERAND1(node)); - return t; -} - -/***************************************************************************/ -PTR_LLND makeInt(low) - int low; -{ - PTR_LLND t = (PTR_LLND) newNode(INT_VAL); - NODE_TYPE(t) = NULL; - NODE_INT_CST_LOW (t) = low; - return t; -} - -/* Originally coded by fbodin, but the code used K&R varargs conventions, - I have rewritten the code to use ANSI conventions (phb) */ -/***************************************************************************/ -PTR_LLND newExpr(int code, PTR_TYPE ntype, ... ) -{ - va_list p; - PTR_LLND t; - int length; - - /* Create a new node of type 'code' */ - t = (PTR_LLND) newNode(code); - NODE_TYPE(t) = ntype; - - /* calculate the number of args required for this type of node */ - length = node_code_length[code]; - - /* Set pointer p to the very first variable argument in list */ - va_start(p,ntype); - - if (hasNodeASymb(code)) - { - /* Extract third argument (type PTR_SYMB), inc arg pointer p */ - PTR_SYMB arg0 = va_arg(p, PTR_SYMB); - NODE_SYMB(t) = arg0; - } - if (length != 0) - { - if (length == 2) - { - /* This is equivalent to the loop below, but faster. */ - /* Extract another argument (type PTR_LLND), inc arg pointer p */ - PTR_LLND arg0 = va_arg(p, PTR_LLND); - /* Extract another argument (type PTR_LLND), inc arg pointer p */ - PTR_LLND arg1 = va_arg(p, PTR_LLND); - NODE_OPERAND0(t) = arg0; - NODE_OPERAND1(t) = arg1; - va_end (p); - return t; - } - else - if (length == 1) - { - /* This is equivalent to the loop below, but faster. */ - /* Extract another argument (type PTR_LLND), inc arg pointer p */ - PTR_LLND arg0 = va_arg(p, PTR_LLND); - NODE_OPERAND0(t) = arg0; - va_end(p); - return t; - } else - Message("A low level node have more than two operands",0); - } - va_end(p); - return t; -} - -/***************************************************************************/ -PTR_SYMB newSymbol(code, name, type) - int code; - char *name; - PTR_TYPE type; -{ - PTR_SYMB t; - char *str; - - if(name){ - str = (char *) xmalloc(strlen(name) +1); - strcpy(str,name); - } - else str=NULL; - t = (PTR_SYMB) newNode (code); - SYMB_IDENT (t) = str; - SYMB_TYPE (t) = type; - return t; -} - -/***************************************************************************/ -int Check_Lang_C(proj) -PTR_PROJ proj; -{ - PTR_FILE ptf; - PTR_BLOB ptb; - if (!proj) - return TRUE; - for (ptb = PROJ_FILE_CHAIN (proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - ptf = (PTR_FILE) BLOB_VALUE (ptb); - -/* if (debug) - fprintf(stderr,"%s\n",FILE_FILENAME (ptf)); */ - - if (FILE_LANGUAGE (ptf) != CSrc) - return(FALSE); - } - return(TRUE); -} - - -/***************************************************************************/ -int Check_Lang_Fortran(proj) -PTR_PROJ proj; -{ - PTR_FILE ptf; - PTR_BLOB ptb; - if (!proj) - return FALSE; - for (ptb = PROJ_FILE_CHAIN (proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - ptf = (PTR_FILE) BLOB_VALUE (ptb); - /* if (debug) - fprintf(stderr,"%s\n",FILE_FILENAME (ptf)); */ - - if (FILE_LANGUAGE(ptf) != ForSrc) - return(FALSE); - } - return(TRUE); -} - - -/* Procedure for unparse a program use when debug is required - the current project is taking */ -/***************************************************************************/ -void UnparseProgram(fout) - FILE *fout; -{ -/* char *s; - PTR_BLOB b, bl; - PTR_FILE f; - */ /*podd 15.03.99*/ - if (Check_Lang_Fortran(cur_proj)) - { - Init_Unparser(); - - fprintf(fout,"%s",filter(Tool_Unparse_Bif(PROJ_FIRST_BIF()))); - } else - { - Init_Unparser(); - fprintf(fout,"%s",Tool_Unparse_Bif(PROJ_FIRST_BIF())); - } -} - -/***************************************************************************/ -void UnparseProgram_ThroughAllocBuffer(fout,filept,size) - FILE *fout; - PTR_FILE filept; - int size; -{ -/* char *s; - PTR_BLOB b, bl; - PTR_FILE f; - */ /*podd 29.01.07*/ - - //SetCurrentFileTo(filept); - //SwitchToFile(GetFileNumWithPt(filept)); - - if (Check_Lang_Fortran(cur_proj)) - { - Init_Unparser(); - - BufferAllocate(size); - - fprintf(fout,"%s",filter(Tool_Unparse_Bif(PROJ_FIRST_BIF()))); - } else - { - Init_Unparser(); - fprintf(fout,"%s",Tool_Unparse_Bif(PROJ_FIRST_BIF())); - } -} - -/* Procedure for unparse a program use when debug is required - the current project is taking */ -/***************************************************************************/ -void UnparseBif(bif) - PTR_BFND bif; -{ -/* char *s; - PTR_BLOB b, bl; -*/ /* podd 15.03.99*/ - if (Check_Lang_Fortran(cur_proj)) - { - Init_Unparser(); - printf("%s",filter(Tool_Unparse_Bif(bif))); - } else - { - Init_Unparser(); - printf("%s",(Tool_Unparse_Bif(bif))); - } - -} - -/***************************************************************************/ - -/* podd 28.01.07 */ /*change podd 16.12.11*/ -char *UnparseBif_Char(bif,lang) - PTR_BFND bif; - int lang; /* ForSrc=0 - Fortran language, CSrc=1 - C language */ -{ - char *s; -/* PTR_BLOB b, bl; -*/ /* podd 15.03.99*/ - if (Check_Lang_Fortran(cur_proj) && lang != CSrc) /*podd 16.12.11*/ - { - Init_Unparser(); - s = filter(Tool_Unparse_Bif(bif)); - } else - { if(lang == CSrc) - Set_Function_Language(CSrc); - Init_Unparser(); - s = Tool_Unparse_Bif(bif); - if(lang == CSrc) - Unset_Function_Language(); - } - return(s); -} - -/* podd 08.04.24 */ -char *UnparseLLnode_Char(llnd,lang) - PTR_LLND llnd; - int lang; /* ForSrc=0 - Fortran language, CSrc=1 - C language */ -{ - char *s; -/* PTR_BLOB b, bl; -*/ /* podd 15.03.99*/ - if (Check_Lang_Fortran(cur_proj) && lang != CSrc) /*podd 16.12.11*/ - { - Init_Unparser(); - s = filter(Tool_Unparse2_LLnode(llnd)); - } else - { if(lang == CSrc) - Set_Function_Language(CSrc); - Init_Unparser(); - s = Tool_Unparse2_LLnode(llnd); - if(lang == CSrc) - Unset_Function_Language(); - } - return(s); -} - -/* Kataev N.A. 03.09.2013 base on UnparseBif_Char with change podd 16.12.11 - Kataev N.A. 19.10.2013 fix -*/ -char *UnparseLLND_Char(llnd) - PTR_LLND llnd; -{ - char *s; - Init_Unparser(); - s = Tool_Unparse2_LLnode(llnd); - return(s); -} - -/* Procedure for unparse a program use when debug is required - the current project is taking */ -/***************************************************************************/ -void UnparseLLND(ll) - PTR_LLND ll; -{ - Init_Unparser(); - printf("%s",Tool_Unparse2_LLnode(ll)); -} - -/***************************************************************************/ -char* UnparseTypeBuffer(type) - PTR_TYPE type; -{ - Init_Unparser(); - return Tool_Unparse_Type(type); -} - -/***************************************************************************/ -int open_proj_toolbox(char* proj_name, char* proj_file) -{ - char* mem[MAX_FILE]; /* for file in the project */ - int no = 0; /* number of file in the project */ - int c; - FILE* fd; /* file descriptor for project */ - char** p, * t; - char* tmp, tmpa[3000]; - - tmp = &(tmpa[0]); - - if ((fd = fopen(proj_file, "r")) == NULL) - return -1; - - p = mem; - t = tmp; - while ((c = getc(fd)) != EOF) - { - - //if (c != ' ') /* assum no blanks in filename */ - - { - if (c == '\n') - { - if (t != tmp) - { /* not a blank line */ - *t = '\0'; - *p = (char*)malloc((unsigned)(strlen(tmp) + 1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, *p, 0); -#endif - strcpy(*p++, tmp); - t = tmp; - } - } - else - *t++ = c; - } - } - - fclose(fd); - no = p - mem; - if (no > 0) - { - /* Now make it the active project */ - if ((cur_proj = OpenProj(proj_name, no, mem))) - { - cur_file = (PTR_FILE)BLOB_VALUE(CUR_PROJ_FILE_CHAIN()); - pointer_on_file_proj = cur_file; - return 0; - } - else - { - fprintf(stderr, "-2 Cannot open project\n"); - return -2; - } - } - else - { - fprintf(stderr, "-3 No files in the project\n"); - return -3; - } -} - -int open_proj_files_toolbox(char* proj_name, char** file_list, int no) -{ - if (no > 0) - { - /* Now make it the active project */ - if ((cur_proj = OpenProj(proj_name, no, file_list))) - { - cur_file = (PTR_FILE)BLOB_VALUE(CUR_PROJ_FILE_CHAIN()); - pointer_on_file_proj = cur_file; - return 0; - } - else - { - fprintf(stderr, "-2 Cannot open project\n"); - return -2; - } - } - else - { - fprintf(stderr, "-3 No files in the project\n"); - return -3; - } -} - -static int ToolBOX_INIT = 0; -/***************************************************************************/ -void Reset_Tool_Box() -{ - Init_Tool_Box(); -} - -/***************************************************************************/ -void Reset_Bif_Next() -{ - PTR_BLOB ptb; - if (cur_proj) - { - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - pointer_on_file_proj = (PTR_FILE) BLOB_VALUE (ptb); - Redo_Bif_Next_Chain(PROJ_FIRST_BIF()); - } - } else - if(pointer_on_file_proj) - Redo_Bif_Next_Chain(PROJ_FIRST_BIF()); -} - -/***************************************************************************/ -int Init_Tool_Box() -{ - - PTR_BLOB ptb; - - pointer_on_file_proj = cur_file; - number_of_type_node = CUR_FILE_NUM_TYPES() + 1; - number_of_ll_node = CUR_FILE_NUM_LLNDS() + 1; - number_of_bif_node = CUR_FILE_NUM_BIFS() + 1; - number_of_symb_node = CUR_FILE_NUM_SYMBS() + 1; - if (CUR_FILE_NAME()) strcpy(Current_File_name, CUR_FILE_NAME()); - if (ToolBOX_INIT) - return 0; - - ToolBOX_INIT = 1; - - make_a_malloc_stack(); - - /* initialisation des noeuds */ -#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) node_code_type[SYM] = TYPE; -#include"bif_node.def" -#undef DEFNODECODE - -#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) node_code_length[SYM] =LENGTH; -#include"bif_node.def" -#undef DEFNODECODE - -#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) node_code_kind[SYM] = NT; -#include"bif_node.def" -#undef DEFNODECODE - -/* set special table for symbol and type */ -#define DEFNODECODE(SYMB,f1,f2,f3,f4,f5) info_type[SYMB][0] = f1; info_type[SYMB][1] = f2; info_type[SYMB][2] = f3; info_type[SYMB][3] = f4; info_type[SYMB][4] = f5; -#include"type.def" -#undef DEFNODECODE - -#define DEFNODECODE(SYMB,f1,f2,f3,f4,f5) info_symb[SYMB][0] = f1; info_symb[SYMB][1] = f2; info_symb[SYMB][2] = f3; info_symb[SYMB][3] = f4; info_symb[SYMB][4] = f5; -#include"symb.def" -#undef DEFNODECODE - -#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) general_info[SYM][0] = f1; general_info[SYM][1] = f2; general_info[SYM][2] = f3; general_info[SYM][3] = f4; general_info[SYM][4] = f5; -#include"bif_node.def" -#undef DEFNODECODE - - if (cur_proj) - { - for (ptb = PROJ_FILE_CHAIN(cur_proj); ptb; ptb = BLOB_NEXT(ptb)) - { - pointer_on_file_proj = (PTR_FILE)BLOB_VALUE(ptb); - Redo_Bif_Next_Chain_Internal(PROJ_FIRST_BIF()); - } - } - pointer_on_file_proj = cur_file; - number_of_type_node = CUR_FILE_NUM_TYPES() + 1; - number_of_ll_node = CUR_FILE_NUM_LLNDS() + 1; - number_of_bif_node = CUR_FILE_NUM_BIFS() + 1; - number_of_symb_node = CUR_FILE_NUM_SYMBS() + 1; - - return 1; - -} - -/* For debug */ -/***************************************************************************/ -void writeDepFileInDebugdep() -{ - PTR_BFND thebif; - int i; - - thebif = PROJ_FIRST_BIF(); - i = 1; - for (;thebif;thebif=BIF_NEXT(thebif), i++) - BIF_ID(thebif) = i; - - CUR_FILE_NUM_BIFS() = i-1; - - if (write_nodes(cur_file,"debug.dep") < 0) - Message("Error, write_nodes() failed (000)",0); - -} - -int isBlankString(char *str) -{int i; - - for(i=0;i<72;i++) - if(str[i] !=' ') - return(0); - return(1); - -} - -/* this function converts a letter to uppercase except char strings (text inside quotes) */ -char to_upper_case (char c, int *quote) -{ - if(c == '\'' || c == '\"') - { - if(*quote == c) - *quote = 0; - else if(*quote==0) - *quote = c; - return c; - } - if(c >= 0 && islower(c) && *quote==0) - return toupper(c); - return c; -} - -char* filter(char *s) -{ - char c; - int i = 1, quote = 0; - - // 14.10.2016 Kolganov. Switch constant buffer to dynamic - int temp_size = 4096; - char *temp = (char*)malloc(sizeof(char) * temp_size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - // out_line_length = 132 if -ffo option is used or out_line_length = 72 if -uniForm option is used - int temp_i = 0; - int buf_i = 0; - int commentline = 0; - char *resul, *init; - int OMP, DVM, SPF; /*OMP*/ - OMP = DVM = SPF = 0; - - if (!s) - return NULL; - if (strlen(s) == 0) - return s; - make_a_malloc_stack(); - //XXX: result is not free at the end of procedure!! - resul = (char *)mymalloc(2 * strlen(s)); - memset(resul, 0, 2 * strlen(s)); - init = resul; - c = s[0]; - - if ((c != ' ') - && (c != '\n') - && (c != '0') - && (c != '1') - && (c != '2') - && (c != '3') - && (c != '4') - && (c != '5') - && (c != '6') - && (c != '7') - && (c != '8') - && (c != '9')) - commentline = 1; - else - commentline = 0; - if (commentline) - { - if ( (s[1] == '$') && (s[2] == 'O') && (s[3] == 'M') && (s[4] == 'P')) - { - OMP = 1; - DVM = SPF = 0; - } - else if ( (s[1] == '$') && (s[2] == 'S') && (s[3] == 'P') && (s[4] == 'F')) - { - SPF = 1; - OMP = DVM = 0; - } - else if (s[1] == '$') - { - OMP = 2; - DVM = SPF = 0; - } - else if ( (s[1] == 'D') && (s[2] == 'V') && (s[3] == 'M') && (s[4] == '$')) - { - DVM = 1; - OMP = SPF = 0; - } - else - OMP = DVM = SPF = 0; - } - temp_i = 0; - i = 0; - buf_i = 0; - while (c != '\0') - { - c = s[i]; - temp[buf_i] = out_upper_case && (!commentline || DVM || SPF || OMP) ? to_upper_case(c,"e) : c; - if (c == '\n') - { - if (buf_i + 1 > temp_size) - { - temp_size *= 2; -#ifdef __SPF - removeFromCollection(temp); -#endif - temp = (char*)realloc(temp, sizeof(char) * temp_size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - } - - temp[buf_i + 1] = '\0'; - sprintf(resul, "%s", temp); - resul = resul + strlen(temp); - temp_i = -1; - buf_i = -1; - if ((s[i + 1] != ' ') - && (s[i + 1] != '\n') - && (s[i + 1] != '0') - && (s[i + 1] != '1') - && (s[i + 1] != '2') - && (s[i + 1] != '3') - && (s[i + 1] != '4') - && (s[i + 1] != '5') - && (s[i + 1] != '6') - && (s[i + 1] != '7') - && (s[i + 1] != '8') - && (s[i + 1] != '9')) - commentline = 1; - else - commentline = 0; - if (commentline) - { - if ( (s[i+2] == '$') && (s[i+3] == 'O') && (s[i+4] == 'M') && (s[i+5] == 'P')) - { - OMP = 1; - DVM = SPF = 0; - } - else if ( (s[i+2] == '$') && (s[i+3] == 'S') && (s[i+4] == 'P') && (s[i+5] == 'F')) - { - SPF = 1; - OMP = DVM = 0; - } - else if (s[i + 2] == '$') - { - OMP = 2; - DVM = SPF = 0; - } - else - { - if ( (s[i+2] == 'D') && (s[i+3] == 'V') && (s[i+4] == 'M') && (s[i+5] == '$')) - { - DVM = 1; - OMP = SPF = 0; - } - else OMP = DVM = SPF = 0; - } - } - } - else - { - if (((!out_free_form && temp_i == 71) || (out_free_form && !out_line_unlimit && temp_i == out_line_length - 1)) && !commentline && (s[i + 1] != '\n')) - { - if (buf_i + 1 > temp_size) - { - temp_size *= 2; -#ifdef __SPF - removeFromCollection(temp); -#endif - temp = (char*)realloc(temp, sizeof(char) * temp_size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - } - /* insert where necessary */ - temp[buf_i + 1] = '\0'; - if (out_free_form) - { - sprintf(resul, "%s&\n", temp); - resul = resul + strlen(temp) + 2; - } - else - { - sprintf(resul, "%s\n", temp); - resul = resul + strlen(temp) + 1; - } - if (!out_free_form && isBlankString(temp)) /*24.06.13*/ - /* string of 72 blanks in fixed form */ - sprintf(resul, " "); - else - sprintf(resul, " &"); - resul = resul + strlen(" &"); - commentline = 0; - memset(temp, 0, sizeof(char) * temp_size); - temp_i = strlen(" &") - 1; - buf_i = -1; - } - - if (((!out_free_form && temp_i == 71) || (out_free_form && !out_line_unlimit && temp_i == out_line_length - 1)) && commentline && (s[i + 1] != '\n') && ((OMP == 1) || (OMP == 2) || (DVM == 1) || (SPF == 1))) /*07.08.17*/ - { - if (buf_i + 1 > temp_size) - { - temp_size *= 2; -#ifdef __SPF - removeFromCollection(temp); -#endif - temp = (char*)realloc(temp, sizeof(char) * temp_size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - } - - temp[buf_i + 1] = '\0'; - if (out_free_form) - { - sprintf(resul, "%s&\n", temp); - resul = resul + strlen(temp) + 2; - } - else - { - sprintf(resul, "%s\n", temp); - resul = resul + strlen(temp) + 1; - } - if (OMP == 1) - { - sprintf(resul, "!$OMP&"); - resul = resul + strlen("!$OMP&"); - temp_i = strlen("!$OMP&") - 1; - } - if (OMP == 2) - { - sprintf(resul, "!$ &"); - resul = resul + strlen("!$ &"); - temp_i = strlen("!$ &") - 1; - } - if (DVM == 1) - { - sprintf(resul, "!DVM$&"); - resul = resul + strlen("!DVM$&"); - temp_i = strlen("!DVM$&") - 1; - } - - if (SPF == 1) - { - sprintf(resul, "!$SPF&"); - resul = resul + strlen("!$SPF&"); - temp_i = strlen("!$SPF&") - 1; - } - memset(temp, 0, sizeof(char) * temp_size); - temp_i = strlen(" +") - 1; - buf_i = -1; - } - } - i++; - temp_i++; - buf_i++; - if (buf_i > temp_size) - { - temp_size *= 2; -#ifdef __SPF - removeFromCollection(temp); -#endif - temp = (char*)realloc(temp, sizeof(char) * temp_size); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - } - } -#ifdef __SPF - removeFromCollection(temp); -#endif - free(temp); - return init; -} - - - -/* BW, june 1994 - this function is used in duplicateStmtsBlock to determine how many - bif nodes need to be copied -*/ -/***************************************************************************/ -int numberOfBifsInBlobList(blob) -PTR_BLOB blob; -{ - PTR_BFND cur_bif; - - if(!blob) return 0; - cur_bif = BLOB_VALUE(blob); - return (numberOfBifsInBlobList(BIF_BLOB1(cur_bif)) - + numberOfBifsInBlobList(BIF_BLOB2(cur_bif)) - + numberOfBifsInBlobList(BLOB_NEXT(blob)) + 1); -} - -/***************************************************************************/ -int findBifInList1(bif_source, bif_cherche) -PTR_BFND bif_source, bif_cherche; -{ - PTR_BLOB temp; - - if ((bif_cherche == NULL) || (bif_source == NULL)) - return FALSE; - - for (temp = BIF_BLOB1 (bif_source); temp ; temp = BLOB_NEXT (temp)) - if (BLOB_VALUE (temp) == bif_cherche) - return TRUE; - return FALSE; -} - -/***************************************************************************/ -int findBifInList2(bif_source, bif_cherche) -PTR_BFND bif_source, bif_cherche; -{ - PTR_BLOB temp; - - if ((bif_cherche == NULL) || (bif_source == NULL)) - return FALSE; - - for (temp = BIF_BLOB2 (bif_source); temp ; temp = BLOB_NEXT (temp)) - if (BLOB_VALUE (temp) == bif_cherche) - return TRUE; - return FALSE; -} - -/***************************************************************************/ -int findBif(bif_source, bif_target, i) -PTR_BFND bif_source, bif_target; -int i; -{ - switch(i){ - case 0: - if (findBifInList1 (bif_source, bif_target)) - return TRUE; - else return findBifInList2 (bif_source, bif_target); - - case 1: - return findBifInList1 (bif_source, bif_target); - - case 2: - return findBifInList2 (bif_source, bif_target); - - } - return 0; -} - - -/***************************************************************************/ -PTR_BLOB appendBlob(b1, b2) -PTR_BLOB b1, b2; -{ - if (b1) { - PTR_BLOB p, q; - - for (p = b1; p; p = BLOB_NEXT (p)) /* skip to the end of b1 */ - q = p; - BLOB_NEXT (q) = b2; - } else - b1 = b2; - return b1; -} - -/* - *delete a bif node from the list of blob node - */ -/***************************************************************************/ -PTR_BFND deleteBfndFromBlobAndLabel(bf,label) - PTR_BFND bf; - PTR_LABEL label; -{ - PTR_BLOB first; - PTR_BLOB bl1, bl2; - - if (label) { - first = LABEL_UD_CHAIN(label); - if (first && (BLOB_VALUE (first) == bf)) - { - bl2 = first; - LABEL_UD_CHAIN(label) = BLOB_NEXT (first); - return (BLOB_VALUE (bl2)); - } - - for (bl1 = bl2 = first; bl1; bl1 = BLOB_NEXT (bl1)) { - if (BLOB_VALUE (bl1) == bf) { - BLOB_NEXT (bl2) = BLOB_NEXT (bl1); - return (BLOB_VALUE (bl2)); - } - bl2 = bl1; - } - return NULL; - } - return NULL; -} - -/***************************************************************************/ -PTR_BLOB lookForBifInBlobList(first, bif) -PTR_BLOB first; -PTR_BFND bif; -{ - PTR_BLOB tail; - if (first == NULL) - return NULL; - for (tail = first; tail; tail = BLOB_NEXT(tail) ) - { - if (BLOB_VALUE(tail) == bif) - return tail; - } - return NULL; -} - -/***************************************************************************/ -PTR_BFND childfInBlobList(first, num) -PTR_BLOB first; -int num; -{ - PTR_BLOB tail; - int len = 0; - if (first == NULL) - return NULL; - for (tail = first; tail; tail = BLOB_NEXT(tail) ) - { - if (len == num) - return BLOB_VALUE(tail); - len++; - } - return NULL; -} - -/***************************************************************************/ -int blobListLength(first) -PTR_BLOB first; -{ - PTR_BLOB tail; - int len = 0; - if (first == NULL) - return(0); - for (tail = first; tail; tail = BLOB_NEXT(tail) ) - len++; - return(len); -} - -/***************************************************************************/ -PTR_BFND lastBifInBlobList1(noeud) - PTR_BFND noeud; -{ - PTR_BLOB bl1 = NULL; - if (!noeud ) - return NULL; - /* on va cherche le dernier dans la liste */ - for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_NEXT(bl1) == NULL) - break; - } - if (bl1) - return BLOB_VALUE(bl1); - else - return NULL; -} - -/***************************************************************************/ -PTR_BFND lastBifInBlobList2(noeud) - PTR_BFND noeud; -{ - PTR_BLOB bl1 = NULL; - if (!noeud ) - return NULL; - /* on va cherche le dernier dans la liste */ - for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_NEXT(bl1) == NULL) - break; - } - if (bl1) - return BLOB_VALUE(bl1); - else - return NULL; -} - -/***************************************************************************/ -PTR_BFND lastBifInBlobList(noeud) - PTR_BFND noeud; -{ - if (!BIF_INDEX(noeud)) - return lastBifInBlobList1( noeud); - else - return lastBifInBlobList2( noeud); -} - -/***************************************************************************/ -PTR_BLOB lastBlobInBlobList1(noeud) - PTR_BFND noeud; -{ - PTR_BLOB bl1 = NULL; - if (!noeud ) - return NULL; - /* on va cherche le dernier dans la liste */ - for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_NEXT(bl1) == NULL) - break; - } - if (bl1) - return bl1; - else - return NULL; -} - -/***************************************************************************/ -PTR_BLOB lastBlobInBlobList2(noeud) - PTR_BFND noeud; -{ - PTR_BLOB bl1 = NULL; - if (!noeud ) - return NULL; - /* on va cherche le dernier dans la liste */ - for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_NEXT(bl1) == NULL) - break; - } - if (bl1) - return bl1; - else - return NULL; -} - -/***************************************************************************/ -PTR_BLOB lastBlobInBlobList(noeud) - PTR_BFND noeud; -{ - if (!BIF_INDEX(noeud)) - return lastBlobInBlobList1( noeud); - else - return lastBlobInBlobList2( noeud); -} - -/* - * - * append dans la blob liste d'un noeud bif, un noeud bif - * - */ -/***************************************************************************/ -int appendBfndToList1(biftoinsert, noeud) - PTR_BFND biftoinsert, noeud; -{ - PTR_BLOB bl1; - - if (!noeud || !biftoinsert) - return 0; - if (BIF_BLOB1(noeud) == NULL) - { - BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE(BIF_BLOB1(noeud)) = biftoinsert; - BLOB_NEXT(BIF_BLOB1(noeud)) = NULL; - BIF_CP(biftoinsert) = noeud; - } else - { - /* on va cherche le dernier dans la liste */ - for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_NEXT(bl1) == NULL) - break; - } - BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE(BLOB_NEXT(bl1)) = biftoinsert; - BIF_CP(biftoinsert) = noeud; - BLOB_NEXT(BLOB_NEXT(bl1)) = NULL; - } - - return 1; -} - -/***************************************************************************/ -int appendBfndToList2(biftoinsert, noeud) - PTR_BFND biftoinsert, noeud; -{ - PTR_BLOB bl1; - - if (!noeud || !biftoinsert) - return 0; - if (BIF_BLOB2(noeud) == NULL) - { - BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB2(noeud)) = NULL; - BIF_CP(biftoinsert) = noeud; - } else - { - /* on va cherche le dernier dans la liste */ - for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_NEXT(bl1) == NULL) - break; - } - BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE(BLOB_NEXT(bl1)) = biftoinsert; - BLOB_NEXT(BLOB_NEXT(bl1)) = NULL; - BIF_CP(biftoinsert) = noeud; - } - - return 1; -} - -/* replace chain_up() */ -/***************************************************************************/ -int appendBfndToList(noeud, biftoinsert) - PTR_BFND biftoinsert, noeud; -{ - /* use the index field to set the right blob node list */ - if (!noeud || !biftoinsert) - return 0; - if (!BIF_INDEX(noeud)) - return appendBfndToList1(biftoinsert, noeud); - else - return appendBfndToList2(biftoinsert, noeud); -} - - -/***************************************************************************/ -int firstBfndInList1(biftoinsert, noeud) - PTR_BFND biftoinsert, noeud; -{ - PTR_BLOB bl2; - - if (!noeud || !biftoinsert) - return 0; - if (BIF_BLOB1(noeud) == NULL) - { - BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB1(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB1(noeud)) = NULL; - BIF_CP(biftoinsert) = noeud; - } else - { - bl2 = BIF_BLOB1(noeud); - BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB1(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB1(noeud)) = bl2 ; - BIF_CP(biftoinsert) = noeud; - } - return 1; -} - - -/***************************************************************************/ -int firstBfndInList2(biftoinsert, noeud) - PTR_BFND biftoinsert, noeud; -{ - PTR_BLOB bl2; - if (!noeud || !biftoinsert) - return 0; - if (BIF_BLOB2(noeud) == NULL) - { - BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB2(noeud)) = NULL; - BIF_CP(biftoinsert) = noeud; - } else - { - bl2 = BIF_BLOB2(noeud); - BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB2(noeud)) = bl2 ; - BIF_CP(biftoinsert) = noeud; - } - return 1; -} - -/***************************************************************************/ -int insertBfndInList1(biftoinsert, current, noeud) - PTR_BFND biftoinsert, noeud,current; -{ - PTR_BLOB bl1 = NULL, bl2; - if (!noeud || !biftoinsert || !current) - return 0; - if (BIF_BLOB1(noeud) == NULL) - { - BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB1(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB1(noeud)) = NULL; - BIF_CP(biftoinsert) = noeud; - } else - { - /* on va cherche current dans la liste */ - for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_VALUE(bl1) == current) - break; - } - - if (!bl1) - { - Message("insertBfndInList1 failed",0); - return FALSE; - } - - bl2 = BLOB_NEXT(bl1); - BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BLOB_NEXT(bl1)) = biftoinsert; - BLOB_NEXT (BLOB_NEXT(bl1)) = bl2; - BIF_CP(biftoinsert) = noeud; - } - return TRUE; -} - -/***************************************************************************/ -int insertBfndInList2(biftoinsert, current, noeud) - PTR_BFND biftoinsert, noeud,current; -{ - PTR_BLOB bl1 = NULL, bl2; - - if (!noeud || !biftoinsert || !current) - return 0; - if (BIF_BLOB2(noeud) == NULL) - { - BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; - BLOB_NEXT (BIF_BLOB2(noeud)) = NULL; - BIF_CP(biftoinsert) = noeud; - } else - { - /* on va cherche current dans la liste */ - for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) - { - if (BLOB_VALUE(bl1) == current) - break; - } - - if (!bl1) - { - Message("insertBfndInList2 failed",0); - abort(); - } - - bl2 = BLOB_NEXT(bl1); - BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); - BLOB_VALUE (BLOB_NEXT(bl1)) = biftoinsert; - BLOB_NEXT(BLOB_NEXT(bl1)) = bl2 ; - BIF_CP(biftoinsert) = noeud; - - } - return 1; -} - -/* enleve in noeud de la liste de bif node si s'y trouve */ -/***************************************************************************/ -PTR_BLOB deleteBfndFrom(b1,b2) - PTR_BFND b1,b2; -{ - PTR_BLOB temp, last, res = NULL; - - if (!b1) - return NULL; - - last = NULL; - for (temp = BIF_BLOB1(b1) ; temp ; temp = BLOB_NEXT (temp)) - { - if (BLOB_VALUE(temp) == b2) - { - res = temp; - if (last == NULL) - { - BIF_BLOB1(b1) = BLOB_NEXT (temp); - break; - } - else - { - BLOB_NEXT (last) = BLOB_NEXT (temp); - break; - } - } - last = temp; - } - - if (!res) - { - last = NULL; - for (temp = BIF_BLOB2(b1) ; temp ; temp = BLOB_NEXT (temp)) - { - if (BLOB_VALUE(temp) == b2) - { - res = temp; - if (last == NULL) - { - BIF_BLOB2(b1) = BLOB_NEXT (temp); - break; - } - else - { - BLOB_NEXT (last) = BLOB_NEXT (temp); - break; - } - } - last = temp; - } - } - return res; -} - - -/***************************************************************************/ -PTR_BFND getNodeBefore(b) - PTR_BFND b; -{ - PTR_BFND temp, first; - - if (!b) - return NULL; - - if (BIF_CP(b)) - first = BIF_CP(b); - else - first = PROJ_FIRST_BIF(); - - for (temp = first; temp ; temp = BIF_NEXT(temp)) - { - if (BIF_NEXT(temp) == b) - return temp; - } - - if (BIF_CP(b)) - { - for (temp = BIF_CP(BIF_CP(b)); temp ; temp = BIF_NEXT(temp)) - { - if (BIF_NEXT(temp) == b) - return temp; - } - } - if (debug) - Message("Node Before not found ",0); - return NULL; -} - -/***************************************************************************/ -void updateControlParent(first,last,cp) -PTR_BFND first,cp,last; - -{ - PTR_BFND temp; - - for (temp = first; temp && (temp != last); temp = BIF_NEXT(temp)) - { - if (!isItInSection(first,last,BIF_CP(temp))) - BIF_CP(temp) = cp; - } - - if (!isItInSection(first,last,BIF_CP(last))) - BIF_CP(last) = cp; -} - - -/***************************************************************************/ -PTR_BFND getWhereToInsertInBfnd(where,cpin) -PTR_BFND where, cpin; -{ - PTR_BFND temp; - PTR_BLOB blob; - - if (!cpin || !where) - return NULL; - - if (findBifInList1 (cpin, where)) - return where; - if (findBifInList2 (cpin, where)) - return where; - - - for (blob = BIF_BLOB1(cpin) ; blob; blob = BLOB_NEXT(blob)) - { - temp = getWhereToInsertInBfnd(where,BLOB_VALUE(blob)); - if (temp) - return BLOB_VALUE(blob); - } - - for (blob = BIF_BLOB2(cpin) ; blob; blob = BLOB_NEXT(blob)) - { - temp = getWhereToInsertInBfnd(where,BLOB_VALUE(blob)); - if (temp) - return BLOB_VALUE(blob); - } - - return NULL; - -} - - -/* Given a node where we want to insert another node, - compute the control parent */ -/***************************************************************************/ -PTR_BFND computeControlParent(where) -PTR_BFND where; -{ - PTR_BFND cp; - - - if (!where) - { - Message("where not defined in computeControlParent: abort()",0); - abort(); - } - - if (!BIF_CP(where)) - { - switch(BIF_CODE(where)) - { /* node that can be a bif control parent */ - case GLOBAL : - case PROG_HEDR : - case PROC_HEDR : - case PROS_HEDR : - case BASIC_BLOCK : - case IF_NODE : - case WHERE_BLOCK_STMT : - case LOOP_NODE : - case FOR_NODE : - case FORALL_NODE : - case WHILE_NODE : - case CDOALL_NODE : - case SDOALL_NODE : - case DOACROSS_NODE : - case CDOACROSS_NODE : - case FUNC_HEDR : - case ENUM_DECL: - case STRUCT_DECL: - case UNION_DECL: - case CLASS_DECL: - case TECLASS_DECL: - case COLLECTION_DECL: - case SWITCH_NODE: - case ELSEIF_NODE : - return where; - default: - Message("No Control Parent in computeControlParent: abort()",0); - abort(); - } - } - - switch(BIF_CODE(where)) - { - case CONT_STAT : - if (BIF_CP(where) && - (BIF_CODE(BIF_CP(where)) != FOR_NODE) && - (BIF_CODE(BIF_CP(where)) != WHILE_NODE) && - (BIF_CODE(BIF_CP(where)) != LOOP_NODE) && - (BIF_CODE(BIF_CP(where)) != CDOALL_NODE) && - (BIF_CODE(BIF_CP(where)) != SDOALL_NODE) && - (BIF_CODE(BIF_CP(where)) != DOACROSS_NODE) && - (BIF_CODE(BIF_CP(where)) != CDOACROSS_NODE)) - { - cp = BIF_CP(where); - break; - } - case CONTROL_END : - cp = BIF_CP(BIF_CP(where)); /* handle by the function insert in */ - break; - /* that a node with a list of blobs */ - case GLOBAL : - case PROG_HEDR : - case PROC_HEDR : - case PROS_HEDR : - case BASIC_BLOCK : - case IF_NODE : - case WHERE_BLOCK_STMT : - case LOOP_NODE : - case FOR_NODE : - case FORALL_NODE : - case WHILE_NODE : - case CDOALL_NODE : - case SDOALL_NODE : - case DOACROSS_NODE : - case CDOACROSS_NODE : - case FUNC_HEDR : - case ENUM_DECL: - case STRUCT_DECL: - case UNION_DECL: - case CLASS_DECL: - case TECLASS_DECL: - case COLLECTION_DECL: - case SWITCH_NODE: - case ELSEIF_NODE : - cp = where; - break; - default: - cp = BIF_CP(where); /* dont specify it */ - } - - return cp; -} - - -/***************************************************************************/ -int insertBfndListIn(first,where,cpin) -PTR_BFND first,where; -PTR_BFND cpin; -{ - PTR_BFND cp; - PTR_BFND biforblob; - PTR_BFND temp, last; - int inblob2; - - if (!first) - return 0; - - if (!where) - { - Message("where not defined in insertBfndListIn: abort()",0); - abort(); - } - - if (!cpin) - cp = computeControlParent(where); - else - cp = cpin; - - /* find where in the blob list where to insert it */ - /* treat first the special case of if_node */ - if ((BIF_CODE(where) == CONTROL_END) && BIF_CP(where) && - (BIF_CODE(BIF_CP(where)) == IF_NODE || BIF_CODE(BIF_CP(where)) == ELSEIF_NODE) && - (!findBifInList2 (BIF_CP(where),where)) && - BIF_BLOB2(BIF_CP(where))) - { - cp = BIF_CP(where); - inblob2 = TRUE; - biforblob = NULL; - last = getLastNodeList(first); - } - else - { - biforblob = getWhereToInsertInBfnd(where,cp); - last = getLastNodeList(first); - inblob2 = findBifInList2 (cp,biforblob); -/* if (BIF_CODE(where) == ELSEIF_NODE) - inblob2 = TRUE;*/ - } - - for (temp = first; temp; temp = BIF_NEXT(temp)) - { - if (!isItInSection(first,last,BIF_CP(temp))) - { - if (!biforblob) - { - if (inblob2) - firstBfndInList2(temp, cp); - else - firstBfndInList1(temp, cp); - } else - { - if (inblob2) - insertBfndInList2(temp,biforblob, cp); - else - insertBfndInList1(temp,biforblob, cp); - } - biforblob = temp; - } - } - - updateControlParent(first,last,cp); - BIF_NEXT(last) = BIF_NEXT(where); - BIF_NEXT(where) = first; - return 1; -} - -/***************************************************************************/ -int insertBfndListInList1(first,cpin) -PTR_BFND first; -PTR_BFND cpin; -{ - PTR_BFND biforblob; - PTR_BFND temp, last; - - if (!first || !cpin) - return 0; - - biforblob = NULL; - last = getLastNodeList(first); - for (temp = first; temp; temp = BIF_NEXT(temp)) - { - if (!isItInSection(first,last,BIF_CP(temp))) - { - if (!biforblob) - { - firstBfndInList1(temp, cpin); - } else - { - insertBfndInList1(temp,biforblob, cpin); - } - biforblob = temp; - } - } - - updateControlParent(first,last,cpin); - return 1; -} - -/***************************************************************************/ -int appendBfndListToList1(first,cpin) -PTR_BFND first; -PTR_BFND cpin; -{ - PTR_BFND biforblob; - PTR_BFND temp, last; - - if (!first || !cpin) - return 0; - - biforblob = NULL; - last = getLastNodeList(first); - for (temp = first; temp; temp = BIF_NEXT(temp)) - { - if (!isItInSection(first,last,BIF_CP(temp))) - { - if (!biforblob) - { - appendBfndToList1(temp, cpin); - } else - { - insertBfndInList1(temp,biforblob, cpin); - } - biforblob = temp; - } - } - - updateControlParent(first,last,cpin); - - return 1; -} - - -/***************************************************************************/ -int firstInBfndList2(first,cpin) -PTR_BFND first; -PTR_BFND cpin; -{ - PTR_BFND biforblob; - PTR_BFND temp, last; - - if (!first || !cpin) - return 0; - - biforblob = NULL; - last = getLastNodeList(first); - for (temp = first; temp; temp = BIF_NEXT(temp)) - { - if (!isItInSection(first,last,BIF_CP(temp))) - { - if (!biforblob) - { - firstBfndInList2(temp, cpin); - } else - { - insertBfndInList2(temp,biforblob, cpin); - } - biforblob = temp; - } - } - - updateControlParent(first,last,cpin); - return 1; -} - -/***************************************************************************/ -int appendBfndListToList2(first,cpin) -PTR_BFND first; -PTR_BFND cpin; -{ - PTR_BFND biforblob; - PTR_BFND temp, last; - - if (!first || !cpin) - return 0; - - biforblob = NULL; - last = getLastNodeList(first); - for (temp = first; temp; temp = BIF_NEXT(temp)) - { - if (!isItInSection(first,last,BIF_CP(temp))) - { - if (!biforblob) - { - appendBfndToList2(temp, cpin); - } else - { - insertBfndInList2(temp,biforblob, cpin); - } - biforblob = temp; - } - } - - updateControlParent(first,last,cpin); - return 1; -} - -/***************************************************************************/ -void insertBfndBeforeIn(biftoinsert, bif_current, cpin) - PTR_BFND bif_current, biftoinsert,cpin; -{ - PTR_BFND the_one_before = NULL; - - if (! bif_current || ! biftoinsert) - { - Message("NULL bif node in biftoinsert\n",0); - exit(-1); - } - - - if (BIF_CODE (bif_current) == GLOBAL) - { - Message("Cannot insert before global\n",0); - exit(-1); - } - - the_one_before = getNodeBefore (bif_current); - insertBfndListIn (biftoinsert, the_one_before,cpin); - -} - - -/* warning to be used carefully; i.e. remove sons before a root */ -/***************************************************************************/ -PTR_BFND deleteBfnd(bif) - PTR_BFND bif; -{ - PTR_BFND temp; - - temp = getNodeBefore (bif); - deleteBfndFrom (BIF_CP (bif), bif); - if (temp) - BIF_NEXT (temp) = BIF_NEXT (bif); - return temp; -} - - -/***************************************************************************/ -int isItInSection(bif_depart, bif_fin, noeud) - PTR_BFND bif_depart, bif_fin, noeud; -{ - PTR_BFND temp; - - if (! noeud) - return FALSE; - - for (temp = bif_depart; temp; temp = BIF_NEXT (temp)) - { - if (temp == noeud) - return TRUE; - if (temp == bif_fin) - return FALSE; - } - return FALSE; - -} - - -/***************************************************************************/ -PTR_BFND extractBifSectionBetween(bif_depart, bif_fin) - PTR_BFND bif_depart, bif_fin; -{ - PTR_BFND temp; - - if (bif_depart && bif_fin) - { - for (temp = bif_depart; temp != bif_fin; temp = BIF_NEXT (temp)) - { - if (!isItInSection(bif_depart, bif_fin,BIF_CP (temp))) - { - deleteBfndFrom(BIF_CP (temp),temp); - BIF_CP (temp) = NULL; - } - } - - /* on traite maintenant bif_fin */ - if (!isItInSection(bif_depart, bif_fin,BIF_CP ( bif_fin))) - { - deleteBfndFrom(BIF_CP (bif_fin), bif_fin); - BIF_CP (bif_fin) = NULL; - } - - temp = getNodeBefore(bif_depart); - if (temp && bif_fin) - BIF_NEXT(temp) = BIF_NEXT (bif_fin); - BIF_NEXT (bif_fin) = NULL; - } - - return bif_depart; -} - -/***************************************************************************/ -PTR_BFND getLastNodeList(b) - PTR_BFND b; -{ - PTR_BFND temp; - for (temp = b; temp; temp = BIF_NEXT(temp)) - { - if (!BIF_NEXT(temp)) - { - return temp; - } - } - return temp; -} - -/***************************************************************************/ -PTR_BFND getLastNodeOfStmt(b) - PTR_BFND b; -{ - PTR_BLOB temp,last = NULL; - if (!b) - return NULL; - if (BIF_BLOB2(b)) - { - for (temp = BIF_BLOB2(b); temp ; temp = BLOB_NEXT(temp)) - { - last = temp; - } - } else - { - for (temp = BIF_BLOB1(b); temp ; temp = BLOB_NEXT(temp)) - { - last = temp; - } - } - if (last) - { - if (Check_Lang_Fortran(cur_proj)) - return BLOB_VALUE(last); - else - { /* in C the Control end may not exist */ - return getLastNodeOfStmt(BLOB_VALUE(last)); - } - } - else - return b; -} - -/* version that does not assume, there is a last */ -/***************************************************************************/ -PTR_BFND getLastNodeOfStmtNoControlEnd(b) - PTR_BFND b; -{ - PTR_BLOB temp,last = NULL; - if (!b) - return NULL; - if (BIF_BLOB2(b)) - { - for (temp = BIF_BLOB2(b); temp ; temp = BLOB_NEXT(temp)) - { - last = temp; - } - } else - { - for (temp = BIF_BLOB1(b); temp ; temp = BLOB_NEXT(temp)) - { - last = temp; - } - } - if (last) - { - return getLastNodeOfStmt(BLOB_VALUE(last)); - } - else - return b; -} - -/* preset some values of symbols for evaluateExpression*/ -#define ALLOCATECHUNKVALUE 100 -static PTR_SYMB *ValuesSymb = NULL; -static int *ValuesInt = NULL; -static int NbValues = 0; -static int NbElement = 0; - -/***************************************************************************/ -void allocateValueEvaluate() -{ - int i; - PTR_SYMB *pt1; - int *pt2; - - pt1 = (PTR_SYMB *) xmalloc( sizeof(PTR_SYMB *) * - (NbValues + ALLOCATECHUNKVALUE)); - pt2 = (int *) xmalloc( sizeof(int *) * (NbValues + ALLOCATECHUNKVALUE)); - - for (i=0; i 1) - { - PTR_LLND listlab, ptl; - int trouve = 0; - - listlab = (kind == 2) ? BIF_LL1(copie) : BIF_LL2(copie); - while (listlab) - { - ptl = NODE_OPERAND0(listlab); - /* we look in the list */ - if (ptl) - { - lab = NODE_LABEL(ptl); - trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2 * j]) - if (LABEL_STMTNO(label_insection[2 * j]) == LABEL_STMTNO(lab)) - { - trouve = j + 1; - break; - } - } - if (trouve) - { - NODE_LABEL(ptl) = label_insection[2 * (trouve - 1) + 1]; - } - } - listlab = NODE_OPERAND1(listlab); - } - temp = BIF_NEXT(temp); - continue; - } - - - - lab = NULL; - if (BIF_LL3(temp) && (NODE_CODE(BIF_LL3(temp)) == LABEL_REF)) - { - lab = NODE_LABEL(BIF_LL3(temp)); - cas = 2; - } - else if (BIF_LL1(temp) && (NODE_CODE(BIF_LL1(temp)) == LABEL_REF)) - { - lab = NODE_LABEL(BIF_LL1(temp)); - cas = 3; - } - else - { - lab = BIF_LABEL_USE(temp); - cas = 1; - } - if (lab) - { /* look where the label is the label is defined somewhere */ - int trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2 * j]) - if (LABEL_STMTNO(label_insection[2 * j]) == LABEL_STMTNO(lab)) - { - trouve = j + 1; - break; - } - } - if (trouve) - { - if (cas == 1) - { - BIF_LABEL_USE(copie) = label_insection[2 * (trouve - 1) + 1]; - } - if (cas == 2) - { - if (BIF_LL3(copie)) - { - NODE_LABEL(BIF_LL3(copie)) = label_insection[2 * (trouve - 1) + 1]; - } - } - if (cas == 3) - { - if (BIF_LL1(copie)) - { - NODE_LABEL(BIF_LL1(copie)) = label_insection[2 * (trouve - 1) + 1]; - } - } - - } - else - { - if (cas == 1) - BIF_LABEL_USE(copie) = lab; /* outside */ - /* if ((cas == 2) no change */ - } - } - temp = BIF_NEXT(temp); - } - - /* on met a jour le blob list */ - copie = alloue[1]; - for (temp = body; temp; temp = BIF_NEXT(temp)) - { - if (BIF_BLOB1(temp)) - { /* on doit cree la blob liste */ - for (blobtemp = BIF_BLOB1(temp); blobtemp; - blobtemp = BLOB_NEXT(blobtemp)) - { - /* on cherche la reference dans le tableaux allouer */ - cherche = NULL; - for (i = 0; i < lenght; i++) - { - if (alloue[2 * i] == BLOB_VALUE(blobtemp)) - { - cherche = alloue[2 * i + 1]; - break; - } - } - appendBfndToList1(cherche, copie); - } - } - if (BIF_BLOB2(temp)) - { /* on doit cree la blob liste */ - for (blobtemp = BIF_BLOB2(temp); blobtemp; - blobtemp = BLOB_NEXT(blobtemp)) - { - /* on cherche la reference dans le tableaux allouer */ - cherche = NULL; - for (i = 0; i < lenght; i++) - { - if (alloue[2 * i] == BLOB_VALUE(blobtemp)) - { - cherche = alloue[2 * i + 1]; - break; - } - } - appendBfndToList2(cherche, copie); - } - } - copie = BIF_NEXT(copie); - if (temp == lastnode) - break; - } - - /* on remet ici a jour les CP */ - copie = alloue[1]; - for (temp = body; temp; temp = BIF_NEXT(temp)) - { - if (isItInSection(body, lastnode, BIF_CP(temp))) - { /* on cherche le bif_cp pour la copie */ - cherche = NULL; - for (i = 0; i < lenght; i++) - { - if (alloue[2 * i] == BIF_CP(temp)) - { - cherche = alloue[2 * i + 1]; - break; - } - } - BIF_CP(copie) = cherche; - } - else - BIF_CP(copie) = NULL; - copie = BIF_NEXT(copie); - if (temp == lastnode) - break; - } - copie = alloue[1]; -#ifdef __SPF - removeFromCollection(alloue); - removeFromCollection(label_insection); -#endif - free(alloue); - free(label_insection); - return copie; -} - - - -/* (ajm) - This function will copy one statement and all of its children - (presumably; I didn't touch that one way or the other). - - It differs from low_level.c:duplicateStmt (v1.00) in that does not - copy all of the BIF_NEXT successors of the statement as well. - -*/ - -/***************************************************************************/ -PTR_BFND duplicateOneStmt(body) - PTR_BFND body; -{ - PTR_BFND copie, last, temp, cherche, lastnode; - int lenght,i,j; - PTR_BFND *alloue; - PTR_BLOB blobtemp; - PTR_LABEL *label_insection; - PTR_LABEL lab; - int maxlabelname; - - if (! body) return NULL; - /* on calcul d'abord la longueur */ - - maxlabelname = getLastLabelId(); - - lenght = 0; -/* Changed area, by ajm 1-Feb-94 */ -#if 0 - for (temp = body; temp ; temp = BIF_NEXT(temp)) - { - lenght++; - lastnode = temp; - } -#else - if ( body != 0 ) - { - lenght = 1; - lastnode = body;/*podd 12.03.99*/ - } -#endif /* ajm */ - - alloue = (PTR_BFND *) xmalloc(2*lenght * sizeof(PTR_BFND)); - memset((char *) alloue, 0, 2* lenght * sizeof(PTR_BFND)); - - /* label part, we record label */ - label_insection = (PTR_LABEL *) xmalloc(2*lenght * sizeof(PTR_LABEL)); - memset((char *) label_insection, 0, 2* lenght * sizeof(PTR_LABEL)); - temp = body; - last = NULL; - for (i = 0; i < lenght; i++) - { - copie = (PTR_BFND) newNode (BIF_CODE (temp)); - BIF_SYMB (copie) = BIF_SYMB (temp); - BIF_LL1 (copie) = copyLlNode(BIF_LL1 (temp)); - BIF_LL2 (copie) = copyLlNode(BIF_LL2 (temp)); - BIF_LL3 (copie) = copyLlNode(BIF_LL3 (temp)); - BIF_DECL_SPECS (copie) = BIF_DECL_SPECS(temp); - - if (last) - BIF_NEXT(last) = copie; - - - if (BIF_LABEL(temp))/* && (LABEL_BODY(BIF_LABEL(temp)) == temp))*/ - { - /* create a new label */ - label_insection[2*i+1] = (PTR_LABEL) newNode(LABEL_KIND); - maxlabelname++; - LABEL_STMTNO(label_insection[2*i+1]) = maxlabelname; - LABEL_BODY(label_insection[2*i+1]) = copie; - LABEL_USED(label_insection[2*i+1]) = LABEL_USED(BIF_LABEL(temp)); - LABEL_ILLEGAL(label_insection[2*i+1])=LABEL_ILLEGAL(BIF_LABEL(temp)); - LABEL_DEFINED(label_insection[2*i+1])=LABEL_DEFINED(BIF_LABEL(temp)); - BIF_LABEL(copie) = label_insection[2*i+1]; - label_insection[2*i] = BIF_LABEL(temp); - } - - /* on fait corresponde temp et copie */ - alloue[2*i] = temp; - alloue[2*i+1] = copie; - temp = BIF_NEXT(temp); - last = copie; - } - - /* On met a jour les labels */ - temp = body; - for (i = 0; i < lenght; i++) - { - int cas; - copie = alloue[2*i+1]; - lab = NULL; - - /* We treat first the COMGOTO_NODE first */ - if (BIF_CODE(temp) == COMGOTO_NODE) - { - PTR_LLND listlab, ptl; - int trouve = 0; - - listlab = BIF_LL1(copie); - while (listlab) - { - ptl = NODE_OPERAND0(listlab); - /* we look in the list */ - if (ptl) - { - lab = NODE_LABEL(ptl); - trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2*j]) - if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) - { - trouve = j+1; - break; - } - } - if(trouve) - { - NODE_LABEL(ptl) = label_insection[2*(trouve-1)+1]; - } - } - listlab = NODE_OPERAND1(listlab); - } - temp = BIF_NEXT(temp); - continue; - } - - - if (BIF_LL3(temp) && (NODE_CODE(BIF_LL3(temp)) == LABEL_REF)) - { - lab = NODE_LABEL(BIF_LL3(temp)); - cas = 2; - } - else - { - lab = BIF_LABEL_USE(temp); - cas = 1; - } - if (lab) - { /* look where the label is the label is defined somewhere */ - int trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2*j]) - if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) - { - trouve = j+1; - break; - } - } - if(trouve) - { - if (cas == 1) - { - BIF_LABEL_USE(copie) = label_insection[2*(trouve-1)+1]; - } - if (cas == 2) - { - if (BIF_LL3(copie)) - { - NODE_LABEL(BIF_LL3(copie)) = label_insection[2*(trouve-1)+1]; - } - } - } else - { - if (cas == 1) - BIF_LABEL_USE(copie) = lab; /* outside */ - /* if ((cas == 2) no change */ - } - } - temp = BIF_NEXT(temp); - } - - /* on met a jour le blob list */ - copie = alloue[1]; -/* Change by ajm */ -#if 0 - for (temp = body; temp ; temp = BIF_NEXT(temp)) -#else - for (temp = body; temp ; temp = 0 /* not BIF_NEXT(temp)!! */ ) -#endif - { - if (BIF_BLOB1(temp)) - { /* on doit cree la blob liste */ - for (blobtemp = BIF_BLOB1(temp);blobtemp; - blobtemp = BLOB_NEXT(blobtemp)) - { - /* on cherche la reference dans le tableaux allouer */ - cherche = NULL; - for (i = 0; i newlabelname *//*podd 13.01.14*/ - LABEL_BODY(label_insection[2*i+1]) = copie; - LABEL_USED(label_insection[2*i+1]) = LABEL_USED(BIF_LABEL(temp)); - LABEL_ILLEGAL(label_insection[2*i+1])=LABEL_ILLEGAL(BIF_LABEL(temp)); - LABEL_DEFINED(label_insection[2*i+1])=LABEL_DEFINED(BIF_LABEL(temp)); - BIF_LABEL(copie) = label_insection[2*i+1]; - label_insection[2*i] = BIF_LABEL(temp); - } - - /* on fait corresponde temp et copie */ - alloue[2*i] = temp; - alloue[2*i+1] = copie; - temp = BIF_NEXT(temp); - last = copie; - } - - /* On met a jour les labels */ /*podd 06.04.13 this fragment (renewing of label references ) is copied from function duplicateStmtsNoExtract()*/ - temp = body; - for (i = 0; i < lenght; i++) - { - int cas, kind; - copie = alloue[2*i+1]; - lab = NULL; - - /* We treat first the COMGOTO_NODE first */ - switch(BIF_CODE(temp)) { - case COMGOTO_NODE: - case ASSGOTO_NODE: - kind = 2; - break; - case ARITHIF_NODE: - kind = 3; - break; - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - case BACKSPACE_STAT: - case REWIND_STAT: - case ENDFILE_STAT: - case INQUIRE_STAT: - case OPEN_STAT: - case CLOSE_STAT: - kind = 1; - break; - default: - kind = 0; - break; - } - - - if(kind == 1) - { - PTR_LLND lb, list; - - list = BIF_LL2(copie); /*control list or format*/ - if(list && NODE_CODE(list) == EXPR_LIST) - { - for(;list;list=NODE_OPERAND1(list)) - { - lb = NODE_OPERAND1(NODE_OPERAND0(list)); - if(NODE_CODE(lb) == LABEL_REF) - lab = NODE_LABEL(lb); - if (lab) - { /* look where the label is the label is defined somewhere */ - int trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2*j]) - if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) - { - trouve = j+1; - break; - } - } - if(trouve) - { - NODE_LABEL(lb) = label_insection[2*(trouve-1)+1]; - } - } - } - } - - else if(list && (NODE_CODE(list) == SPEC_PAIR)) - { - lb =(NODE_OPERAND1(list)); - if(NODE_CODE(lb) == LABEL_REF) - lab = NODE_LABEL(lb); - if (lab) - { /* look where the label is the label is defined somewhere */ - int trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2*j]) - if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) - { - trouve = j+1; - break; - } - } - if(trouve) - { - NODE_LABEL(lb) = label_insection[2*(trouve-1)+1]; - } - } - } - temp = BIF_NEXT(temp); - continue; - } - - - if(kind > 1) - { - PTR_LLND listlab, ptl; - int trouve = 0; - - listlab = (kind==2) ? BIF_LL1(copie) : BIF_LL2(copie); - while (listlab) - { - ptl = NODE_OPERAND0(listlab); - /* we look in the list */ - if (ptl) - { - lab = NODE_LABEL(ptl); - trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2*j]) - if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) - { - trouve = j+1; - break; - } - } - if(trouve) - { - NODE_LABEL(ptl) = label_insection[2*(trouve-1)+1]; - } - } - listlab = NODE_OPERAND1(listlab); - } - temp = BIF_NEXT(temp); - continue; - } - - - - lab=NULL; - if (BIF_LL3(temp) && (NODE_CODE(BIF_LL3(temp)) == LABEL_REF)) - { - lab = NODE_LABEL(BIF_LL3(temp)); - cas = 2; - } - else if (BIF_LL1(temp) && (NODE_CODE(BIF_LL1(temp)) == LABEL_REF)) - { - lab = NODE_LABEL(BIF_LL1(temp)); - cas = 3; - } - else - { - lab = BIF_LABEL_USE(temp); - cas = 1; - } - if (lab) - { /* look where the label is the label is defined somewhere */ - int trouve = 0; - for (j = 0; j < lenght; j++) - { - if (label_insection[2*j]) - if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) - { - trouve = j+1; - break; - } - } - if(trouve) - { - if (cas == 1) - { - BIF_LABEL_USE(copie) = label_insection[2*(trouve-1)+1]; - } - if (cas == 2) - { - if (BIF_LL3(copie)) - { - NODE_LABEL(BIF_LL3(copie)) = label_insection[2*(trouve-1)+1]; - } - } - if (cas == 3) - { - if (BIF_LL1(copie)) - { - NODE_LABEL(BIF_LL1(copie)) = label_insection[2*(trouve-1)+1]; - } - } - - } else - { - if (cas == 1) - BIF_LABEL_USE(copie) = lab; /* outside */ - /* if ((cas == 2) no change */ - } - } - temp = BIF_NEXT(temp); - } - - - /* on met a jour le blob list */ - copie = alloue[1]; - for (temp = body, iii = 0; iii num) - return last; - last =temp; - } - return(NULL); -} - - - -/********* Add a comment to a node *************************************/ - - -/***************************************************************************/ -void LibAddComment(PTR_BFND bif, char *str) -{ - char *pt; - PTR_CMNT cmnt; - - if (!bif || !str) - return; - - if (!BIF_CMNT(bif)) - { - pt = (char *)xmalloc(strlen(str) + 1); - cmnt = (PTR_CMNT)newNode(CMNT_KIND); - strcpy(pt, str); - CMNT_STRING(cmnt) = pt; - BIF_CMNT(bif) = cmnt; - } - else - { - cmnt = BIF_CMNT(bif); - if (CMNT_STRING(cmnt)) - { - pt = (char *)xmalloc(strlen(str) + strlen(CMNT_STRING(cmnt)) + 1); - sprintf(pt, "%s%s", CMNT_STRING(cmnt), str); - CMNT_STRING(cmnt) = pt; - } - else - { - pt = (char *)xmalloc(strlen(str) + 1); - sprintf(pt, "%s", str); - CMNT_STRING(cmnt) = pt; - } - } -} - - -/* ajm */ -/********************** Set a node's comment *******************************/ -//Kolganov 15.11.2017 -void LibDelAllComments(PTR_BFND bif) -{ - PTR_CMNT cmnt; - char *pt; - - if (!bif) - return; - - if (BIF_CMNT(bif)) - { - if (CMNT_STRING(BIF_CMNT(bif))) - { -#ifdef __SPF - removeFromCollection(CMNT_STRING(BIF_CMNT(bif))); -#endif - free(CMNT_STRING(BIF_CMNT(bif))); - CMNT_STRING(BIF_CMNT(bif)) = NULL; - } - - cmnt = BIF_CMNT(bif); - // remove comment from list before free - if (cmnt == PROJ_FIRST_CMNT()) - { - if (cmnt->thread) - PROJ_FIRST_CMNT() = cmnt->thread; - else - PROJ_FIRST_CMNT() = NULL; - } - else - { - PTR_CMNT before = PROJ_FIRST_CMNT(); - while (before->thread) - { - if (before->thread == cmnt) - { - if (cmnt->thread) - { - before->thread = cmnt->thread; - cmnt->thread = NULL; - } - else - before->thread = NULL; - break; - } - before = before->thread; - } - } - /* -#ifdef __SPF - removeFromCollection(BIF_CMNT(bif)); -#endif - free(BIF_CMNT(bif));*/ - BIF_CMNT(bif) = NULL; - } -} - -void LibSetAllComments(PTR_BFND bif, char *str) -{ - PTR_CMNT cmnt; - char *pt; - - if ( !bif || !str ) - return; - - LibDelAllComments(bif); - - pt = (char *) xmalloc(strlen(str) + 1); - cmnt = (PTR_CMNT) newNode(CMNT_KIND); - strcpy(pt, str); - CMNT_STRING(cmnt) = pt; - BIF_CMNT(bif) = cmnt; -} - -/***************************************************************************/ -int patternMatchExpression(ll1,ll2) - PTR_LLND ll1,ll2; -{ - /* char *string1, *string2;*/ /*podd 15.03.99*/ - int *res1, *res2; - - if (ll1 == ll2) - return TRUE; - - if (!ll1 || !ll2) - return FALSE; - - if (NODE_CODE(ll1) != NODE_CODE(ll2)) - return FALSE; - - /* because of identical names does not work also no commutativity - string1 = funparse_llnd(ll1); - string2 = funparse_llnd(ll2); - if (strcmp(string1, string2) == 0) - return TRUE; - */ - /* first test if constant equations identical */ - res1 = evaluateExpression(ll1); - res2 = evaluateExpression(ll2); - if ((res1[0] != -1) && - (res2[0] != -1) && - (res1[1] == res2[1])) - { -#ifdef __SPF - removeFromCollection(res1); - removeFromCollection(res2); -#endif - free(res1); - free(res2); - return TRUE; - } - if ((res1[0] != -1) && (res2[0] == -1)) - { -#ifdef __SPF - removeFromCollection(res1); - removeFromCollection(res2); -#endif - free(res1); - free(res2); - return FALSE; - } - if ((res1[0] == -1) && (res2[0] != -1)) - { -#ifdef __SPF - removeFromCollection(res1); - removeFromCollection(res2); -#endif - free(res1); - free(res2); - return FALSE; - } -#ifdef __SPF - removeFromCollection(res1); - removeFromCollection(res2); -#endif - free(res1); - free(res2); - - /* for each kind of node do the pattern match */ - switch (NODE_CODE(ll1)) - { - case VAR_REF: - if (NODE_SYMB(ll1) == NODE_SYMB(ll2)) - return TRUE; - break; - - /* commutatif operator */ - case EQ_OP: - if ((NODE_SYMB(ll1) == NODE_SYMB(ll2)) && - patternMatchExpression(NODE_OPERAND0(ll1), - NODE_OPERAND1(ll2)) && - patternMatchExpression(NODE_OPERAND0(ll1), - NODE_OPERAND1(ll2))) - return TRUE; - default : - if ((NODE_SYMB(ll1) == NODE_SYMB(ll2)) && - patternMatchExpression(NODE_OPERAND0(ll1), - NODE_OPERAND0(ll2)) && - patternMatchExpression(NODE_OPERAND1(ll1), - NODE_OPERAND1(ll2))) - return TRUE; - } - return FALSE; -} - - -/* - new functions added, they have a match with the one in the C++ - interface library -*/ -/***************************************************************************/ -void SetCurrentFileTo(file) - PTR_FILE file; -{ - if (!file) - return; - if (pointer_on_file_proj == file) - return; - cur_file = file; - /* reset the toolbox and pointers*/ - Init_Tool_Box(); -} - - -/***************************************************************************/ -int LibnumberOfFiles() -{ - PTR_BLOB ptb; - int count = 0; - if (cur_proj) - { - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - count++; - } - } else - if(pointer_on_file_proj) - return 1; - return count; -} - -/***************************************************************************/ -PTR_FILE GetPointerOnFile(dep_file_name) - char *dep_file_name; -{ -/* PTR_FILE pt;*/ /*podd 15.03.99*/ - PTR_BLOB ptb; - if (cur_proj && dep_file_name) - { - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - cur_file = (PTR_FILE) BLOB_VALUE (ptb); - /* reset the toolbox and pointers*/ - SetCurrentFileTo(cur_file); - if (CUR_FILE_NAME() && !strcmp(CUR_FILE_NAME(),dep_file_name)) - return pointer_on_file_proj; - } - } - return NULL; -} - -/***************************************************************************/ -int GetFileNum(dep_file_name) - char *dep_file_name; -{ - PTR_FILE pt; - PTR_BLOB ptb; - int count= 0; - if (cur_proj && dep_file_name) - { - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - count++; - pt = (PTR_FILE) BLOB_VALUE (ptb); - /* reset the toolbox and pointers*/ - SetCurrentFileTo(pt); - if (FILE_FILENAME(pt) && !strcmp(FILE_FILENAME(pt),dep_file_name)) - return count; - } - } - return 0; -} - - -/***************************************************************************/ -int GetFileNumWithPt(dep_file) - PTR_FILE dep_file; -{ - PTR_FILE pt; - PTR_BLOB ptb; - int count= 0; - if (cur_proj && dep_file) - { - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - count++; - pt = (PTR_FILE) BLOB_VALUE (ptb); - /* reset the toolbox and pointers*/ - SetCurrentFileTo(pt); - if (pt==dep_file) - return count; - } - } - return 0; -} - - -/***************************************************************************/ -PTR_FILE GetFileWithNum(num) - int num; -{ - PTR_FILE pt; - PTR_BLOB ptb; - int count= 0; - if (cur_proj) - { - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - pt = (PTR_FILE) BLOB_VALUE (ptb); - /* reset the toolbox and pointers*/ - SetCurrentFileTo(pt); - if (count == num) - return pt; - count++; - } - } - return NULL; -} - -/***************************************************************************/ -void LibsaveDepFile(str) - char *str; -{ - PTR_BFND thebif; - int i; - if (!str) - { - Message("No name specified in saveDepFile",0); - return; - } - thebif = PROJ_FIRST_BIF(); - i = 1; - for (;thebif;thebif=BIF_NEXT(thebif), i++) - BIF_ID(thebif) = i; - - CUR_FILE_NUM_BIFS() = i-1; - - if (write_nodes(cur_file,str) < 0) - Message("Error, write_nodes() failed (001)",0); - -} - -/***************************************************************************/ -int getNumberOfFunction() -{ - PTR_BFND thebif; - int count = 0; - - thebif = PROJ_FIRST_BIF(); - for (; thebif; thebif = BIF_NEXT(thebif)) - { - if ((BIF_CODE(thebif) == FUNC_HEDR) || (BIF_CODE(thebif) == PROC_HEDR) || - (BIF_CODE(thebif) == PROS_HEDR) || (BIF_CODE(thebif) == PROG_HEDR)) - { - if (thebif->control_parent->variant != INTERFACE_STMT && - thebif->control_parent->variant != INTERFACE_OPERATOR && - thebif->control_parent->variant != INTERFACE_ASSIGNMENT) - count++; - } - } - return count; -} - -/***************************************************************************/ -PTR_BFND getFunctionNumHeader(int num) -{ - PTR_BFND thebif; - int count = 0; - - thebif = PROJ_FIRST_BIF(); - for (; thebif; thebif = BIF_NEXT(thebif)) - { - if ((BIF_CODE(thebif) == FUNC_HEDR) || (BIF_CODE(thebif) == PROC_HEDR) || - (BIF_CODE(thebif) == PROS_HEDR) || (BIF_CODE(thebif) == PROG_HEDR)) - { - if (thebif->control_parent->variant != INTERFACE_STMT && - thebif->control_parent->variant != INTERFACE_OPERATOR && - thebif->control_parent->variant != INTERFACE_ASSIGNMENT) - { - if (count == num) - return thebif; - count++; - } - } - } - return NULL; -} - -/***************************************************************************/ -int getNumberOfStruct() -{ - PTR_BFND thebif; - int count =0; - - thebif = PROJ_FIRST_BIF(); - for (;thebif;thebif=BIF_NEXT(thebif)) - { - if (isAStructDeclBif(BIF_CODE(thebif))) - count++; - } - - return count; -} - -/***************************************************************************/ -PTR_BFND getStructNumHeader(num) - int num; -{ - PTR_BFND thebif; - int count =0; - - thebif = PROJ_FIRST_BIF(); - for (;thebif;thebif=BIF_NEXT(thebif)) - { - if (isAStructDeclBif(BIF_CODE(thebif))) - { - if (count == num) - return thebif; - count++; - } - } - return NULL; -} - -/***************************************************************************/ -PTR_BFND getFirstStmt() -{ - return PROJ_FIRST_BIF(); -} - -/***************************************************************************/ -PTR_TYPE GetAtomicType(tt) - int tt; -{ - PTR_TYPE ttype = NULL; - - if(!isAtomicType(tt)) - { - Message("Misuse of GetAtomicType",0); - return NULL; - } - for (ttype = PROJ_FIRST_TYPE () ; ttype; ttype = TYPE_NEXT(ttype)) - { - if (TYPE_CODE(ttype) == tt) - return ttype; - } - return (ttype); -} - -/***************************************************************************/ -PTR_BFND LiblastDeclaration(start) -PTR_BFND start; -{ - PTR_BFND temp; - - if (start) - temp = start; - else - temp = PROJ_FIRST_BIF (); - for ( ; temp; temp = BIF_NEXT(temp)) - { - if ( BIF_NEXT(temp) && !isADeclBif(BIF_CODE(BIF_NEXT(temp)))) - return temp; - } - Message("LiblastDeclaration return NULL",0); - return NULL; -} - -/***************************************************************************/ -int LibIsSymbolInScope(bif,symb) - PTR_BFND bif; - PTR_SYMB symb; -{ - PTR_BFND scope; - - if (!symb || !bif) - return FALSE; - scope = SYMB_SCOPE(symb); -/* return isItInSection(BIF_CP(bif), getLastNodeOfStmt(BIF_CP(bif)), scope);*/ - if (scope) -/* assume scope is the declaration of the variable, otherwise to be removed*/ - return isItInSection(BIF_CP(scope), getLastNodeOfStmt(BIF_CP(scope)), bif); - else - return FALSE; -} - -/***************************************************************************/ -int IsRefToSymb(expr,symb) - PTR_LLND expr; - PTR_SYMB symb; -{ - - if (!expr) - return FALSE; - - if (!hasNodeASymb(NODE_CODE(expr))) - return FALSE; - - if (NODE_SYMB(expr) != symb) - return FALSE; - return TRUE; -} - -/***************************************************************************/ -void LibreplaceSymbByExp(exprold, symb, exprnew) - PTR_SYMB symb; - PTR_LLND exprold, exprnew; -{ - if (!exprold) - return ; - - if (IsRefToSymb(NODE_OPERAND0(exprold),symb)) - NODE_OPERAND0(exprold) = exprnew; - else - LibreplaceSymbByExp(NODE_OPERAND0(exprold), symb, exprnew); - - if (IsRefToSymb(NODE_OPERAND1(exprold),symb)) - NODE_OPERAND1(exprold) = exprnew; - else - LibreplaceSymbByExp(NODE_OPERAND1(exprold), symb, exprnew); -} - -/***************************************************************************/ -void LibreplaceSymbByExpInStmts(debut, fin, symb, expr) - PTR_BFND debut, fin; - PTR_SYMB symb; - PTR_LLND expr; -{ - PTR_BFND temp; - - for (temp = debut; temp ; temp = BIF_NEXT(temp)) - { - if (IsRefToSymb(BIF_LL1(temp),symb)) - BIF_LL1(temp) = expr; - else - LibreplaceSymbByExp(BIF_LL1(temp), symb, expr); - - if (IsRefToSymb(BIF_LL2(temp),symb)) - BIF_LL2(temp) = expr; - else - LibreplaceSymbByExp(BIF_LL2(temp), symb, expr); - - if (IsRefToSymb(BIF_LL3(temp),symb)) - BIF_LL3(temp) = expr; - else - LibreplaceSymbByExp(BIF_LL3(temp), symb, expr); - if (fin && (temp == fin)) - break; - } -} - -/***************************************************************************/ -PTR_LLND LibIsSymbolInExpression(exprold, symb) - PTR_SYMB symb; - PTR_LLND exprold; -{ - PTR_LLND pt =NULL; - if (!exprold) - return NULL; - - if (IsRefToSymb(NODE_OPERAND0(exprold),symb)) - return NODE_OPERAND0(exprold); - else - pt = LibIsSymbolInExpression(NODE_OPERAND0(exprold), symb); - if (pt) - return pt; - - if (IsRefToSymb(NODE_OPERAND1(exprold),symb)) - return NODE_OPERAND1(exprold) ; - else - pt = LibIsSymbolInExpression(NODE_OPERAND1(exprold), symb); - - return pt; -} - -/***************************************************************************/ -PTR_BFND LibWhereIsSymbDeclare(symb) - PTR_SYMB symb; -{ - PTR_BFND scopeof, temp, last; - if (!symb) - return NULL; - - scopeof = SYMB_SCOPE(symb); - if (!scopeof) - return NULL; - - last = getLastNodeOfStmt(scopeof); - - for (temp = scopeof; temp ; temp=BIF_NEXT(temp)) - { -#if __SPF - //SKIP SPF dirs - //for details see dvm_tag.h - if (scopeof->variant >= 950 && scopeof->variant <= 958) - continue; -#endif - if (LibIsSymbolInExpression(BIF_LL1(temp), symb)) - return temp; - if (LibIsSymbolInExpression(BIF_LL2(temp), symb)) - return temp; - if (temp == last) - break; - } - return NULL; -} - - - -/* return a symbol in a declaration list - replace find_suit_declarator() but also more ... - replace also find_parameter_name() -*/ -/***************************************************************************/ -PTR_LLND giveLlSymbInDeclList(expr) -PTR_LLND expr; -{ - PTR_LLND list1, list2; - if (!expr) - return NULL; - - if (NODE_CODE(expr) == EXPR_LIST) - { - for (list1= expr; list1; list1 = NODE_OPERAND1(list1)) - { - if (NODE_OPERAND0(list1)) - { - for (list2= NODE_OPERAND0(list1); list2; ) - { - if (hasNodeASymb(NODE_CODE(list2))) - { - if (NODE_SYMB(list2)) - return list2; - } - if(NODE_CODE(list2) == SCOPE_OP) list2 = NODE_OPERAND1(list2); - else list2 = NODE_OPERAND0(list2); - } - } - } - } else - { - for (list2= expr; list2; ) - { - if (hasNodeASymb(NODE_CODE(list2))) - { - if (NODE_SYMB(list2)) - return list2; - } - if(NODE_CODE(list2) == SCOPE_OP) list2 = NODE_OPERAND1(list2); - else list2 = NODE_OPERAND0(list2); - } - } -/* Message("giveSymbInDeclList did not find the symbol (crash will happen)",0); */ - return NULL; -} - -/* return the first non null type in the base type list */ -/***************************************************************************/ -PTR_TYPE lookForInternalBasetype(type) - PTR_TYPE type; -{ - if (!type) - return NULL; - - if (TYPE_CODE(type) == T_MEMBER_POINTER){ - if (TYPE_COLL_BASE(type)) - return lookForInternalBasetype(TYPE_COLL_BASE(type)); - else - return type; - } - else if (hasTypeBaseType(TYPE_CODE(type))) - { - if (TYPE_BASE(type)) - return lookForInternalBasetype(TYPE_BASE(type)); - else - return type; - } - else - return type; -} - - -/* return the first non null type in the base type list */ -/***************************************************************************/ -PTR_TYPE lookForTypeDescript(type) - PTR_TYPE type; -{ - if (!type) - return NULL; - - if (TYPE_CODE(type) == T_DESCRIPT) - return type; - if (hasTypeBaseType(TYPE_CODE(type))) - { - if (TYPE_BASE(type)) - return lookForTypeDescript(TYPE_BASE(type)); - else - return NULL; - } - else - return NULL; -} - -/***************************************************************************/ -int getTypeNumDimension(type) - PTR_TYPE type; -{ - if (!type) - return 0; - return exprListLength(TYPE_DECL_RANGES(type)); -} - -/***************************************************************************/ -int isElementType(type) -PTR_TYPE type; -{ - if (!type) - return 0; - - if (TYPE_CODE(type) == T_DERIVED_TYPE) - { - if (TYPE_SYMB_DERIVE(type) && - SYMB_IDENT(TYPE_SYMB_DERIVE(type)) && - (strcmp(SYMB_IDENT(TYPE_SYMB_DERIVE(type)), "ElementType") == 0)) - return 1; - } - return 0; -} - -/***************************************************************************/ -PTR_TYPE getDerivedTypeWithName(str) - char *str; -{ - PTR_TYPE ttype = NULL; - for (ttype = PROJ_FIRST_TYPE () ; ttype; ttype = TYPE_NEXT(ttype)) - { - if (TYPE_CODE(ttype) == T_DERIVED_TYPE) - { - if (TYPE_SYMB_DERIVE(ttype) && - SYMB_IDENT(TYPE_SYMB_DERIVE(ttype)) && - (strcmp(SYMB_IDENT(TYPE_SYMB_DERIVE(ttype)), str) == 0)) - return ttype; - } - } - return (ttype); -} - - -/***************************************************************************/ -int sameName(symb1,symb2) - PTR_SYMB symb1,symb2; -{ - if (!symb1 || !symb2) - return FALSE; - - if (!SYMB_IDENT(symb1) || !SYMB_IDENT(symb2)) - return FALSE; - - if (strcmp(SYMB_IDENT(symb1),SYMB_IDENT(symb2)) == 0) - return TRUE; - else - return FALSE; -} - - -/***************************************************************************/ -PTR_SYMB lookForNameInParamList(functor,name) -PTR_SYMB functor; -char *name; -{ - PTR_SYMB list1; - - if (!functor || !name) - return NULL; - - for ( list1 = SYMB_MEMBER_PARAM(functor) ; list1 ; list1 = SYMB_NEXT_DECL(list1)) - { - if (!strcmp(SYMB_IDENT(list1),name)) - return(list1) ; - } - return(NULL); - } - -/***************************************************************************/ -PTR_TYPE FollowTypeBaseAndDerived(type) -PTR_TYPE type; -{ - PTR_TYPE tmp; - PTR_SYMB symb; - if (!type) - return NULL; - if (isAtomicType(TYPE_CODE(type))) - return type; - tmp = lookForInternalBasetype(type); - if (hasTypeSymbol(TYPE_CODE(tmp))) - { - symb = TYPE_SYMB_DERIVE(tmp); - if (symb && SYMB_TYPE(symb)) - return FollowTypeBaseAndDerived(SYMB_TYPE(symb)); - else - return tmp; - } - return tmp; -} - -/* replace chain_up_type() */ -/***************************************************************************/ -PTR_TYPE addToBaseTypeList(type1,type2) - PTR_TYPE type1,type2; -{ - PTR_TYPE tmp; - if (!type2) return(type1); - if (!type1) return(type2); - - tmp = lookForInternalBasetype(type2); - if (tmp) - { - TYPE_BASE(tmp) = type1; - return(type2); - } else - Message("error in addToBaseTypeList",0); - return NULL; -} - -/* return the symbol it inherit from */ -/***************************************************************************/ -PTR_SYMB doesClassInherit(bif) - PTR_BFND bif; -{ - PTR_LLND ll; - int lenght; - if (!bif) - return NULL; - - ll = BIF_LL2(bif); - - - lenght = exprListLength(ll); - if (lenght > 1) - Message("Multiple inheritance not allowed",BIF_LINE(bif)); - ll = giveLlSymbInDeclList(ll); - - if (ll) - return NODE_SYMB(ll); - else - return NULL; -} - -/***************************************************************************/ -PTR_SYMB getClassNextFieldOrMember(symb) - PTR_SYMB symb; -{ - if (!symb) - return NULL; - - if (SYMB_CODE(symb) == FIELD_NAME) - return SYMB_NEXT_FIELD(symb); - else - if (SYMB_CODE(symb) == MEMBER_FUNC) - return SYMB_MEMBER_NEXT(symb); - else - return symb->next_symb; - - /* return NULL; */ -} - -/* find_first_field(pred) and find_first_field_2(pred)*/ -/***************************************************************************/ -PTR_SYMB getFirstFieldOfStruct(pred) -PTR_BFND pred ; -{ - /* PTR_LLND ll_ptr1; */ /* podd 15.03.99*/ - PTR_LLND l2; - /* PTR_BFND bf1 ;*/ /* podd 15.03.99*/ - PTR_BLOB blob; - - if (!pred) - return NULL; - - if (isAStructDeclBif(BIF_CODE(pred)) || isAUnionDeclBif(BIF_CODE(pred)) || - isAEnumDeclBif(BIF_CODE(pred))) - { - if (!(blob= BIF_BLOB1(pred))) - { - return NULL; - } - else - { - for ( ; blob ; blob = BLOB_NEXT(blob)) - { - if (BLOB_VALUE(blob)) - l2 = giveLlSymbInDeclList(BIF_LL1(BLOB_VALUE(blob))); - else - l2 = NULL; - if (l2) - { - return NODE_SYMB(l2); - } - } - } - } - return(NULL); -} - - -/***************************************************************************/ -PTR_LLND addToExprList(expl,ll) -PTR_LLND expl, ll; -{ - PTR_LLND tmp, lptr; - - if (!ll) - return expl; - if (!expl) - return newExpr(EXPR_LIST,NULL,ll,NULL); - - tmp = newExpr(EXPR_LIST,NULL,ll,NULL); - lptr = Follow_Llnd(expl,2); - NODE_OPERAND1(lptr) = tmp; - - return expl; -} - - -/***************************************************************************/ -PTR_LLND addToList(first,pt) -PTR_LLND first, pt; -{ - PTR_LLND tail = first; - - if (!pt) - return first; - if (!first) - return pt; - else { - while (NODE_OPERAND1(tail)) - tail = NODE_OPERAND1(tail); - NODE_OPERAND1(tail) = pt; - return first; - } -} - - -/* was find_class_bfnd(object)*/ -/***************************************************************************/ -PTR_BFND getObjectStmt(object) -PTR_SYMB object; -{ - PTR_TYPE type; - if (!object) - return NULL; - type = FollowTypeBaseAndDerived(SYMB_TYPE(object)); - if (type) - { - if (isStructType(TYPE_CODE(type)) || - isEnumType(TYPE_CODE(type)) || - isUnionType(TYPE_CODE(type)) - ) - { - return TYPE_COLL_ORI_CLASS(type); - } else - Message("unexpected class/struct constructs",0); - } - return NULL; -} - -/* was chain_field_symb() */ -/***************************************************************************/ -void addSymbToFieldList(first_one, current_one) - PTR_SYMB first_one,current_one ; -{ - PTR_SYMB old_symb,symb; - - if (!first_one || !current_one) - return; - for ( old_symb = symb = first_one ;symb ; ) - { - old_symb = symb ; - symb = getClassNextFieldOrMember(symb); - } - if (SYMB_CODE(old_symb) == FIELD_NAME) - SYMB_NEXT_FIELD(old_symb) = current_one ; - else /* if(SYMB_CODE(old_symb) = MEMBER_FUNC) */ - SYMB_MEMBER_NEXT(old_symb) = current_one ; - old_symb->next_symb = current_one; -} - - -/* - look for Array Reference From an expression - There are chained in an expression list -*/ -/***************************************************************************/ -PTR_LLND LibarrayRefs(expr,listin) - PTR_LLND expr,listin; -{ - PTR_LLND list = listin; - - if (!expr) - return listin; - - if (NODE_CODE(expr) == ARRAY_REF) - { - list = addToExprList(list, expr); - } - list = LibarrayRefs(NODE_OPERAND0(expr),list); - list = LibarrayRefs(NODE_OPERAND1(expr),list); - return list; -} - - -/* all reference to a symbol (does not go inside array index expression ...)*/ -/***************************************************************************/ -PTR_LLND LibsymbRefs(expr,listin) - PTR_LLND expr,listin; -{ - PTR_LLND list = listin; - - if (!expr) - return listin; - - if (hasNodeASymb(NODE_CODE(expr))) - { - list = addToExprList(list, expr); - return list; - } - list = LibsymbRefs(NODE_OPERAND0(expr),list); - list = LibsymbRefs(NODE_OPERAND1(expr),list); - return list; -} - -/***************************************************************************/ -void LibreplaceWithStmt(biftoreplace,newbif) - PTR_BFND biftoreplace,newbif; -{ - PTR_BFND before,parent,last; - - if (!biftoreplace|| !newbif) - return; - - before = getNodeBefore(biftoreplace); - parent = BIF_CP(biftoreplace); - last = getLastNodeOfStmt(biftoreplace); - - extractBifSectionBetween(biftoreplace,last); - insertBfndListIn(newbif,before,parent); - -} - -/***************************************************************************/ -PTR_BFND LibdeleteStmt(bif) - PTR_BFND bif; -{ - PTR_BFND last,current; - - if (!bif) - return NULL; - last = getLastNodeOfStmt(bif); - /*podd 03.06.14*/ - current = bif; /*podd 19.11.14*/ - if(BIF_CODE(bif)==IF_NODE || BIF_CODE(bif)==ELSEIF_NODE) - while(current != last && BIF_CODE(last)==ELSEIF_NODE) - { current = last; last = getLastNodeOfStmt(last); } - else if(BIF_CODE(bif)==FOR_NODE || BIF_CODE(bif)==WHILE_NODE) - { while( ((current != last) && (BIF_CODE(last) == FOR_NODE)) || (BIF_CODE(last) == WHILE_NODE) ) - { current = last; last = getLastNodeOfStmt(last); } - if(BIF_CODE(last)==LOGIF_NODE && BIF_CP(BIF_NEXT(last))==last) - last = BIF_NEXT(last); - } - extractBifSectionBetween(bif,last); - return bif; -} - -/***************************************************************************/ -int LibIsSymbolReferenced(bif,symb) - PTR_BFND bif; - PTR_SYMB symb; -{ - PTR_BFND last,temp; - - if (!bif) - return FALSE; - last = getLastNodeOfStmt(bif); - - for (temp = bif; temp; temp = BIF_NEXT (temp)) - { - if (IsRefToSymb(BIF_LL1(temp),symb) || - LibIsSymbolInExpression(BIF_LL1(temp),symb)) - return TRUE; - - if (IsRefToSymb(BIF_LL2(temp),symb) || - LibIsSymbolInExpression(BIF_LL2(temp),symb)) - return TRUE; - - if (IsRefToSymb(BIF_LL3(temp),symb) || - LibIsSymbolInExpression(BIF_LL3(temp),symb)) - return TRUE; - if (temp == last) - break; - } - return FALSE; -} - - -/***************************************************************************/ -PTR_BFND LibextractStmt(bif) - PTR_BFND bif; -{ - /*PTR_BFND last;*/ /* podd 15.03.99*/ - return LibdeleteStmt (bif); -} - - -/***************************************************************************/ -PTR_LLND getPositionInExprList(first,pos) -PTR_LLND first; -int pos; -{ - PTR_LLND tail; - int len = 0; - if (first == NULL) - return NULL; - for (tail = first; (len variant == ARITHIF_NODE || temp->variant == COMGOTO_NODE || temp->variant == ASSGOTO_NODE) - { - PTR_LLND lb; - if (temp->variant == COMGOTO_NODE || temp->variant == ASSGOTO_NODE) - lb = BIF_LL1(temp); - else - lb = BIF_LL2(temp); - PTR_LABEL arith_lab[256]; - - int idx = 0; - while (lb) - { - arith_lab[idx++] = NODE_LABEL(NODE_OPERAND0(lb)); - lb = NODE_OPERAND1(lb); - } - - int z; - for (z = 0; z < idx; ++z) - { - if (arith_lab[z] && (LABEL_STMTNO(arith_lab[z]) == LABEL_STMTNO(label))) - { - if (blob) - { - BLOB_NEXT(blob) = (PTR_BLOB)newNode(BLOB_KIND); - blob = BLOB_NEXT(blob); - BLOB_VALUE(blob) = temp; - } - else - { - blob = (PTR_BLOB)newNode(BLOB_KIND); - BLOB_VALUE(blob) = temp; - first = blob; - } - break; - } - } - } - else - { - if (tl && (LABEL_STMTNO(tl) == LABEL_STMTNO(label))) - { - if (blob) - { - BLOB_NEXT(blob) = (PTR_BLOB)newNode(BLOB_KIND); - blob = BLOB_NEXT(blob); - BLOB_VALUE(blob) = temp; - } - else - { - blob = (PTR_BLOB)newNode(BLOB_KIND); - BLOB_VALUE(blob) = temp; - first = blob; - } - } - } - } - return first; -} - -/***************************************************************************/ - -void LibconvertLogicIf(PTR_BFND ifst) -{ - if (!ifst) - return; - if (BIF_CODE(ifst) == LOGIF_NODE) - {/* Convert to if */ - PTR_BFND last, ctl; - BIF_CODE(ifst) = IF_NODE; - /* need to add a contro_end */ - last = getLastNodeOfStmt(ifst); - ctl = (PTR_BFND)newNode(CONTROL_END); - insertBfndListIn(ctl, last, ifst); - } -} - -/***************************************************************************/ -int convertToEnddoLoop(PTR_BFND loop) -{ - PTR_BFND cend, bif, lastcend; - PTR_BLOB blob, list_ud; - PTR_LABEL label; - PTR_CMNT comment; - - if (!loop) - return 0; - - if (BIF_CODE(loop) != FOR_NODE) - return 0; - - if (!LibisEnddoLoop(loop)) - { - bif = getLastNodeOfStmt(loop); - if (!bif) - return 0; - while (BIF_CODE(bif) == FOR_NODE) - { - /* because of continue stmt shared by loops */ - bif = getLastNodeOfStmt(bif); - if (!bif) - return 0; - } - - if (BIF_CODE(bif) == CONT_STAT) - { - if (BIF_LABEL(bif) != NULL) - { - label = BIF_LABEL(bif); - if (BIF_LABEL_USE(loop) && - (LABEL_STMTNO(BIF_LABEL_USE(loop)) == LABEL_STMTNO(label))) - { - list_ud = getLabelUDChain(label, loop); - if (blobListLength(list_ud) <= 1) - { - cend = (PTR_BFND)newNode(CONTROL_END); - BIF_CP(cend) = loop; - BIF_LABEL_USE(loop) = NULL; - BIF_CMNT(cend) = BIF_CMNT(bif); - BIF_LINE(cend) = BIF_LINE(bif); /*Bakhtin 26.01.10*/ - bif = deleteBfnd(bif); - insertBfndListIn(cend, bif, loop); - } - else - { /* more than on uses of the label check if ok */ - for (blob = list_ud; blob; - blob = BLOB_NEXT(blob)) - { - if (!BLOB_VALUE(blob) || (BIF_CODE(BLOB_VALUE(blob)) != FOR_NODE)) - return 0; - } - /* we insert as much enddo than necessary */ - comment = BIF_CMNT(bif); - bif = deleteBfnd(bif); - lastcend = bif; - for (blob = list_ud; blob; blob = BLOB_NEXT(blob)) - { - if (BLOB_VALUE(blob) && (BIF_CODE(BLOB_VALUE(blob)) == FOR_NODE)) - { - BIF_LABEL_USE(BLOB_VALUE(blob)) = NULL; - cend = (PTR_BFND)newNode(CONTROL_END); - BIF_CMNT(cend) = comment; - BIF_LINE(cend) = BIF_LINE(lastcend); /*Bakhtin 26.01.10*/ - comment = NULL; - BIF_CMNT(bif) = NULL; - insertBfndListIn(cend, lastcend, BLOB_VALUE(blob)); - /*lastcend = Get_Node_Before(cend); */ - } - } - } - return 1; - } - else - return 0; /* something is wrong the label is not the same */ - } - else - { /* should not appear CONTINUE without label */ - cend = (PTR_BFND)newNode(CONTROL_END);/*podd 12.03.99*/ - BIF_CMNT(cend) = BIF_CMNT(bif); - BIF_LINE(cend) = BIF_LINE(bif); /*Bakhtin 26.01.10*/ - bif = deleteBfnd(bif); - insertBfndListIn(cend, bif, loop); - return 0; - } - - } - else - { /* this not a enddo or a cont stat; probably a statement */ - label = BIF_LABEL(bif); - list_ud = getLabelUDChain(label, loop); - if (label && blobListLength(list_ud) <= 1) - { - cend = (PTR_BFND)newNode(CONTROL_END); - BIF_LINE(cend) = BIF_LINE(bif); /*Bakhtin 26.01.10*/ - insertBfndListIn(cend, bif, loop); - BIF_LABEL(bif) = NULL; - BIF_LABEL_USE(loop) = NULL; - } - else - return 0; - } - return 1; - } - else - return 1; -} - - -/* (fbodin) Duplicate Symbol and type routine (modified phb) */ -/***************************************************************************/ -PTR_TYPE duplicateType(type) - PTR_TYPE type; -{ - PTR_TYPE newtype; - if (!type) - return NULL; - - if (!isATypeNode(NODE_CODE(type))) - { - Message("duplicateType; Not a type node",0); - return NULL; - } - if (isAtomicType(TYPE_CODE(type)) && TYPE_CODE(type)!= T_STRING && !TYPE_RANGES(type) && !TYPE_KIND_LEN(type)) - return(GetAtomicType(TYPE_CODE(type))); /*07.06.06*/ /*22.04.14*/ - - /***** Allocate a new node *****/ - newtype = (PTR_TYPE) newNode(TYPE_CODE(type)); - - /* Copy the fields that are NOT in the union */ - TYPE_SYMB(newtype) = TYPE_SYMB(type); - TYPE_LENGTH(newtype) =TYPE_LENGTH(type); - - /* Copy the size of the union (all of the fields) (phb)*/ - memcpy(&(newtype->entry),&(type->entry),sizeof(type->entry)); - - if (isAtomicType(TYPE_CODE(type))) - { - if (TYPE_RANGES(type)) - TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); - if (TYPE_KIND_LEN(type)) - TYPE_KIND_LEN(newtype) = copyLlNode(TYPE_KIND_LEN(type)); /*22.04.14*/ - return newtype; - } - if (hasTypeBaseType(TYPE_CODE(type))) - { - if (TYPE_BASE(type)) - TYPE_BASE(newtype) = duplicateType(TYPE_BASE(type)); - } - if (hasTypeSymbol(TYPE_CODE(type))) - { - TYPE_SYMB_DERIVE(newtype) = TYPE_SYMB_DERIVE(type); - } - switch (TYPE_CODE(type)) - { - case T_ARRAY : - TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); - break; - case T_DESCRIPT : - TYPE_LONG_SHORT(newtype) = TYPE_LONG_SHORT(type); - break; - } - return newtype; -} - -/***************************************************************************/ - -PTR_SYMB duplicateSymbolAcrossFiles(); - -PTR_TYPE duplicateTypeAcrossFiles(type) - PTR_TYPE type; -{ - PTR_TYPE newtype; - if (!type) - return NULL; - - if (!isATypeNode(NODE_CODE(type))) - { - Message("duplicateTypeAcrossFiles; Not a type node",0); - return NULL; - } - if (isAtomicType(TYPE_CODE(type)) && TYPE_CODE(type)!= T_STRING && !TYPE_RANGES(type) && !TYPE_KIND_LEN(type)) - return(GetAtomicType(TYPE_CODE(type))); /*07.06.06*/ /*22.04.14*/ - - /***** Allocate a new node *****/ - newtype = (PTR_TYPE) newNode(TYPE_CODE(type)); - - /* Copy the fields that are NOT in the union */ - TYPE_SYMB(newtype) = TYPE_SYMB(type); - TYPE_LENGTH(newtype) =TYPE_LENGTH(type); - - /* Copy the size of the union (all of the fields) (phb)*/ - memcpy(&(newtype->entry),&(type->entry),sizeof(type->entry)); - - if (isAtomicType(TYPE_CODE(type))) - { - if (TYPE_RANGES(type)) - TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); /*07.06.06*/ - if (TYPE_KIND_LEN(type)) - TYPE_KIND_LEN(newtype) = copyLlNode(TYPE_KIND_LEN(type)); /*22.04.14*/ - - return newtype; - } - - if (hasTypeBaseType(TYPE_CODE(type))) - { - if (TYPE_BASE(type)) - TYPE_BASE(newtype) = duplicateTypeAcrossFiles(TYPE_BASE(type)); - } - if (hasTypeSymbol(TYPE_CODE(type))) - { - TYPE_SYMB_DERIVE(newtype) = duplicateSymbolAcrossFiles(TYPE_SYMB_DERIVE(type)); - } - switch (TYPE_CODE(type)) - { - case T_ARRAY : - TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); - break; - case T_DESCRIPT : - TYPE_LONG_SHORT(newtype) = TYPE_LONG_SHORT(type); - break; - } - return newtype; -} - - -/***************************************************************************/ -PTR_SYMB duplicateParamList(symb) - PTR_SYMB symb; -{ - PTR_SYMB first, previous, ptsymb,ts; - ptsymb = SYMB_FUNC_PARAM (symb); - ts = NULL; - first = NULL; - previous = NULL; - while (ptsymb) - { - ts = duplicateSymbol(ptsymb); - if (!first) - first = ts; - if (previous) - SYMB_NEXT_DECL (previous) = ts; - previous = ts; - ptsymb = SYMB_NEXT_DECL (ptsymb); - } - if (ts) - SYMB_NEXT_DECL (ts) = NULL; - return first; -} - - -/***************************************************************************/ -PTR_SYMB duplicateSymbol(symb) - PTR_SYMB symb; -{ - PTR_SYMB newsymb; - /* char *str;*/ /* podd 15.03.99*/ - if (!symb) - return NULL; - - if (!isASymbNode(NODE_CODE(symb))) - { - Message("duplicateSymbol; Not a symbol node",0); - return NULL; - } - newsymb = (PTR_SYMB) newSymbol(SYMB_CODE(symb),SYMB_IDENT(symb),SYMB_TYPE(symb)); - - SYMB_ATTR(newsymb) = SYMB_ATTR(symb); - - /* Copy the size of the union (all of the fields) (phb)*/ - memcpy(&(newsymb->entry.Template),&(symb->entry.Template), - sizeof(newsymb->entry.Template)); - - /*dirty trick for debug, to identify copie/ - str = (char *) xmalloc(512); - sprintf(str,"DEBUG%d%s",newsymb,SYMB_IDENT(newsymb)); - SYMB_IDENT(newsymb) = str; - */ - /* copy the expression for Constant Node */ - if (SYMB_CODE(newsymb) == CONST_NAME) - SYMB_VAL(newsymb) = copyLlNode(SYMB_VAL(newsymb)); - return newsymb; -} - -/***************************************************************************/ -PTR_SYMB duplicateSymbolLevel1(symb) - PTR_SYMB symb; -{ - PTR_SYMB newsymb; - - if (!symb) - return NULL; - - if (!isASymbNode(NODE_CODE(symb))) - { - Message("duplicateSymbolLevel1; Not a symbol node",0); - return NULL; - } - newsymb = duplicateSymbol(symb); - - /* to be updated later Not that simple*/ - switch (SYMB_CODE(symb)) - { - case MEMBER_FUNC: - case FUNCTION_NAME: - case PROCEDURE_NAME: - case PROCESS_NAME: - SYMB_FUNC_PARAM (newsymb) = duplicateParamList(symb); - break; - } - return newsymb; -} - -/***************************************************************************/ -PTR_BFND getBodyOfSymb(symb) -PTR_SYMB symb; -{ - /* PTR_SYMB newsymb = NULL;*/ - PTR_BFND body = NULL; - PTR_TYPE type; - if (!symb) - return NULL; - - if (!isASymbNode(NODE_CODE(symb))) - { - Message("getbodyofsymb; not a symbol node",0); - return NULL; - } - switch (SYMB_CODE(symb)) - { - case MEMBER_FUNC: - case FUNCTION_NAME: - case PROCEDURE_NAME: - case PROCESS_NAME: - case MODULE_NAME: - body = SYMB_FUNC_HEDR(symb); - if (!body) - body = getFunctionHeaderAllFile(symb); - break; - case PROGRAM_NAME: - body = symb->entry.prog_decl.prog_hedr; - if (!body) - body = getFunctionHeaderAllFile(symb); - break; - - case CLASS_NAME: - case TECLASS_NAME: - case COLLECTION_NAME: - type = SYMB_TYPE(symb); - if (type) - { - body = TYPE_COLL_ORI_CLASS(type); - } else - { - Message("body of collection or class not found",0); - return NULL; - } - break; - } - return body; -} - - -/***************************************************************************/ -void replaceSymbInExpression(PTR_LLND exprold, PTR_SYMB symb, PTR_SYMB new) -{ - if (!exprold || !symb || !new) - return; - if (!isASymbNode(SYMB_CODE(symb))) - { - Message(" not a symbol node in replaceSymbInExpression", 0); - return; - } - if (!isASymbNode(SYMB_CODE(new))) - { - Message(" not a symbol node in replaceSymbInExpression", 0); - return; - } - - if (hasNodeASymb(NODE_CODE(exprold))) - { - if (NODE_SYMB(exprold) == symb) - NODE_SYMB(exprold) = new; - } - replaceSymbInExpression(NODE_OPERAND0(exprold), symb, new); - replaceSymbInExpression(NODE_OPERAND1(exprold), symb, new); -} - -/***************************************************************************/ -void replaceSymbInStmts(debut, fin, symb, new) - PTR_BFND debut, fin; - PTR_SYMB symb,new; -{ - PTR_BFND temp; - - for (temp = debut; temp; temp = BIF_NEXT(temp)) - { - if (BIF_SYMB(temp) == symb) - BIF_SYMB(temp) = new; - replaceSymbInExpression(BIF_LL1(temp), symb, new); - replaceSymbInExpression(BIF_LL2(temp), symb, new); - replaceSymbInExpression(BIF_LL3(temp), symb, new); - if (fin && (temp == fin)) - break; - } -} - -/***************************************************************************/ -void replaceSymbInExpressionSameName(exprold,symb, new) - PTR_LLND exprold; - PTR_SYMB symb, new; -{ - if (!exprold || !symb || !new) - return; - if (!isASymbNode(SYMB_CODE(symb))) - { - Message(" not a symbol node in replaceSymbInExpressionSameName",0); - return; - } - if (!isASymbNode(SYMB_CODE(new))) - { - Message(" not a symbol node in replaceSymbInExpressionSameName",0); - return; - } - if (hasNodeASymb(NODE_CODE(exprold))) - { - if (sameName(NODE_SYMB(exprold),symb)) - { - NODE_SYMB(exprold) = new; - } - } - replaceSymbInExpressionSameName(NODE_OPERAND0(exprold), symb, new); - replaceSymbInExpressionSameName(NODE_OPERAND1(exprold), symb, new); -} - - -/***************************************************************************/ -void replaceSymbInStmtsSameName(debut, fin, symb, new) - PTR_BFND debut, fin; - PTR_SYMB symb,new; -{ - PTR_BFND temp; - - for (temp = debut; temp ; temp = BIF_NEXT(temp)) - { - if (sameName(BIF_SYMB(temp),symb)) - BIF_SYMB(temp) = new; - replaceSymbInExpressionSameName(BIF_LL1(temp), symb,new); - replaceSymbInExpressionSameName(BIF_LL2(temp), symb,new); - replaceSymbInExpressionSameName(BIF_LL3(temp), symb,new); - if (fin && (temp == fin)) - break; - } -} - -/***************************************************************************/ -PTR_SYMB duplicateSymbolLevel2(symb) - PTR_SYMB symb; -{ - PTR_SYMB newsymb; - PTR_BFND body,newbody,last,before,cp; - PTR_SYMB ptsymb,ptref; - if (!symb) - return NULL; - - if (!isASymbNode(NODE_CODE(symb))) - { - Message("duplicateSymbolLevel2; Not a symbol node",0); - return NULL; - } - newsymb = duplicateSymbolLevel1(symb); - - /* to be updated later Not that simple*/ - switch (SYMB_CODE(symb)) - { - case MEMBER_FUNC: - case FUNCTION_NAME: - case PROCEDURE_NAME: - case PROCESS_NAME: - /* duplicate the body */ - body = getBodyOfSymb(symb); - if (body) - { - before = getNodeBefore(body); - cp = BIF_CP(body); - last = getLastNodeOfStmt(body); - body = extractBifSectionBetween(body,last); - newbody = duplicateStmts (body); - insertBfndListIn (body, before,cp); - insertBfndListIn (newbody, before,cp); - BIF_SYMB(newbody) = newsymb; - SYMB_FUNC_HEDR(newsymb) = newbody; - /* we have to propagate change in the param list in the new body */ - ptsymb = SYMB_FUNC_PARAM (newsymb); - ptref = SYMB_FUNC_PARAM (symb); - last = getLastNodeOfStmt(newbody); - while (ptsymb) - { - replaceSymbInStmts(newbody,last,ptref,ptsymb); - ptsymb = SYMB_NEXT_DECL (ptsymb); - ptref = SYMB_NEXT_DECL (ptref); - } - } - break; - case CLASS_NAME: - case TECLASS_NAME: - case COLLECTION_NAME: - case STRUCT_NAME: - case UNION_NAME: - body = getBodyOfSymb(symb); - if (body) - { - before = getNodeBefore(body); - cp = BIF_CP(body); - last = getLastNodeOfStmt(body); - body = extractBifSectionBetween(body,last); - newbody = duplicateStmts (body); - insertBfndListIn (body, before,cp); - insertBfndListIn (newbody, before,cp); - BIF_SYMB(newbody) = newsymb; - /* probably more to do here */ - SYMB_TYPE(newsymb) = duplicateType(SYMB_TYPE(symb)); - /* set the new body for the symbol */ - TYPE_COLL_ORI_CLASS(SYMB_TYPE(newsymb)) = newbody; - } - break; - } - return newsymb; -} - -/***************************************************************************/ -int arraySymbol(symb) - PTR_SYMB symb; -{ - PTR_TYPE type; - if (!symb) - return FALSE; - type = SYMB_TYPE(symb); - if (!type) - return FALSE; - if (TYPE_CODE(type) == T_ARRAY) - return TRUE; - return FALSE; -} - -/***************************************************************************/ -int pointerType(type) - PTR_TYPE type; -{ - if (!type) - return FALSE; - return isPointerType(TYPE_CODE(type)); -} - -/***************************************************************************/ -int isIntegerType(type) - PTR_TYPE type; -{ - if (!type) - return FALSE; - return (TYPE_CODE(type) == T_INT); -} - -/***************************************************************************/ -/* this function was all wrong, fixed May 25 1994, BW */ -PTR_SYMB getFieldOfStructWithName(name,typein) - char *name; - PTR_TYPE typein; -{ - PTR_TYPE type; - PTR_SYMB ptsymb = NULL; - if (!typein || !name) - return NULL; - - type = SYMB_TYPE(TYPE_SYMB_DERIVE(typein)); - - - if(TYPE_CODE(type) == T_DESCRIPT) - type = TYPE_BASE(type); - /* the if statement above is necessary because of another bug */ - /* with "friend" specifier */ - ptsymb = TYPE_COLL_FIRST_FIELD(type); - - - if (! (ptsymb)) Message("did not find the first field\n",0); - - while (ptsymb) - { - if (!strcmp(SYMB_IDENT(ptsymb), name)) - return ptsymb; - ptsymb = getClassNextFieldOrMember (ptsymb); - } - return NULL; -} - -/***************************************************************************/ -PTR_LLND addLabelRefToExprList(expl,label) - PTR_LLND expl; - PTR_LABEL label; -{ - PTR_LLND tmp, lptr,pt; - - if (!label) - return expl; - pt = (PTR_LLND) newNode(LABEL_REF); - NODE_LABEL(pt) = label; - tmp = newExpr(EXPR_LIST,NULL,pt,NULL); - if (!expl) - return tmp; - lptr = Follow_Llnd(expl,2); - NODE_OPERAND1(lptr) = tmp; - return expl; -} - -/***************************************************************************/ -PTR_BFND getStatementNumber(bif,pos) - int pos; - PTR_BFND bif; -{ - PTR_BFND ptbfnd = NULL; - /* PTR_TYPE type;*/ /* podd 15.03.99*/ - int count = 0; - if (!bif) - return NULL; - ptbfnd = bif; - while (ptbfnd) - { - count++; - if (count == pos) - return ptbfnd; - ptbfnd = BIF_NEXT(ptbfnd); - } - return NULL; - -} - -/***************************************************************************/ -PTR_LLND deleteNodeInExprList(first,pos) -PTR_LLND first; -int pos; -{ - PTR_LLND tail,old = NULL; - int len = 0; - if (first == NULL) - return NULL; - - if (pos == 0) - return NODE_OPERAND1(first); - for (tail = first; tail; tail = NODE_OPERAND1(tail) ) - { - len++; - if (len == pos) - { - NODE_OPERAND1(old) = NODE_OPERAND1(tail); - return first; - } - old = tail; - } - - return first; -} - -/***************************************************************************/ -PTR_LLND deleteNodeWithItemInExprList(first,ll) -PTR_LLND first,ll; -{ - PTR_LLND tail,old = NULL; - if (first == NULL) - return NULL; - - if (NODE_OPERAND0(first) == ll) - return NODE_OPERAND1(first); - for (tail = first; tail; tail = NODE_OPERAND1(tail) ) - { - if (NODE_OPERAND0(tail) == ll) - { - NODE_OPERAND1(old) = NODE_OPERAND1(tail); - return first; - } - old = tail; - } - return first; -} - -/***************************************************************************/ -PTR_LLND addSymbRefToExprList(expl,symb) - PTR_LLND expl; - PTR_SYMB symb; -{ - PTR_LLND tmp, lptr,pt; - - if (!symb) - return expl; - pt = newExpr(VAR_REF,SYMB_TYPE(symb), symb); - tmp = newExpr(EXPR_LIST,NULL,pt,NULL); - if (!expl) - return tmp; - lptr = Follow_Llnd(expl,2); - NODE_OPERAND1(lptr) = tmp; - return expl; -} - -/* functions mainly dedicated to libcreatecollectionwithtype */ -/***************************************************************************/ -void duplicateAllSymbolDeclaredInStmt(symb,stmt, oldident) - PTR_SYMB symb; /* symb is not to duplicate */ - PTR_BFND stmt; - char *oldident; -{ - PTR_SYMB oldsymb, newsymb, ptsymb, ptref; - PTR_BFND cur,last,last1; - /*PTR_BFND body;*/ /* podd 15.03.99*/ - PTR_BFND cur1,last2; - PTR_LLND ll1, ll2; - char str[512], *str1 = NULL; - PTR_SYMB tabsymbold[MAX_SYMBOL_FOR_DUPLICATE]; - PTR_SYMB tabsymbnew[MAX_SYMBOL_FOR_DUPLICATE]; - int nbintabsymb = 0; - int i; - if (!stmt || !symb ) - return; - - last = getLastNodeOfStmt(stmt); - - /* if that is a class/collection we have to take care of the constructor and destructor */ - if (oldident) - { - str1 = (char *) xmalloc(strlen(SYMB_IDENT(symb))+2); - if ((int)strlen(oldident) >= 511) - { - Message("internal error: string too long exit",0); - exit(1); - } - sprintf(str1,"~%s",SYMB_IDENT(symb)); - sprintf(str,"~%s",oldident); - } - for (cur = stmt; cur ; cur = BIF_NEXT(cur)) - { - if ((BIF_CODE(cur) == FUNC_HEDR) && (isInStmt(stmt,cur))) - { /* local declaration, update the owner */ - if (BIF_SYMB(cur)) - { - oldsymb = BIF_SYMB(cur); - newsymb = duplicateSymbolLevel1(BIF_SYMB(cur)); - -/* str1 = (char *) xmalloc(512); - sprintf(str1,"COPYFORDEBUG%d%s",newsymb,SYMB_IDENT(newsymb)); - SYMB_IDENT(newsymb) = str1;*/ - tabsymbold[nbintabsymb] = oldsymb; - tabsymbnew[nbintabsymb] = newsymb; - nbintabsymb ++; - if (nbintabsymb >= MAX_SYMBOL_FOR_DUPLICATE) - { - Message("To many symbol in duplicateAllSymbolDeclaredInStmt",0); - exit(1); - } - BIF_SYMB(cur) = newsymb; - SYMB_FUNC_HEDR(newsymb) = cur; - SYMB_SCOPE(newsymb) = stmt; - ptsymb = SYMB_FUNC_PARAM (newsymb); - ptref = SYMB_FUNC_PARAM (oldsymb); - last2 = getLastNodeOfStmt(cur); - while (ptsymb) - { - replaceSymbInStmts(cur,last2,ptref,ptsymb); - ptsymb = SYMB_NEXT_DECL (ptsymb); - ptref = SYMB_NEXT_DECL (ptref); - } - duplicateAllSymbolDeclaredInStmt(newsymb,cur,oldident); - if (SYMB_CODE(newsymb) == MEMBER_FUNC) - { /* there is more to do here */ - SYMB_MEMBER_BASENAME(newsymb) = symb; - } - if (oldident) - { /* change name of constructor and destructor */ - if (!strcmp(SYMB_IDENT(newsymb),oldident)) - { - SYMB_IDENT(newsymb) = SYMB_IDENT(symb); - } - if (!strcmp(SYMB_IDENT(newsymb),str)) - { - SYMB_IDENT(newsymb) = str1; - } - } - cur = getLastNodeOfStmt(cur); - } - } - if ((BIF_CODE(cur) == VAR_DECL) && (isInStmt(stmt,cur))) - { /* we have to declare what is declare there */ - /* ll1= BIF_LL1(cur); this is the declaration */ - - for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) - { - ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); - if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) - { - oldsymb = NODE_SYMB(ll2); - NODE_SYMB(ll2) = duplicateSymbolLevel2(NODE_SYMB(ll2)); - tabsymbold[nbintabsymb] = oldsymb; - tabsymbnew[nbintabsymb] = NODE_SYMB(ll2); - nbintabsymb ++; - if (nbintabsymb >= MAX_SYMBOL_FOR_DUPLICATE) - { - Message("To many symbol in duplicateAllSymbolDeclaredInStmt",0); - exit(1); - } - /* apply recursively */ - if (getBodyOfSymb(NODE_SYMB(ll2)) && (!isInStmt(stmt,getBodyOfSymb(NODE_SYMB(ll2))))) - { - duplicateAllSymbolDeclaredInStmt(NODE_SYMB(ll2), getBodyOfSymb(NODE_SYMB(ll2)),oldident); - } - /* if member function we must attach the new symbol of - collection also true for field name */ - if (SYMB_CODE(NODE_SYMB(ll2)) == MEMBER_FUNC) - { /* there is more to do here */ - SYMB_MEMBER_BASENAME(NODE_SYMB(ll2)) = symb; - } - if (SYMB_CODE(NODE_SYMB(ll2)) == FIELD_NAME) - { /* there is more to do here */ - SYMB_FIELD_BASENAME(NODE_SYMB(ll2)) = symb; - } - SYMB_SCOPE(NODE_SYMB(ll2)) = stmt; /* is that correct??? */ - - if (oldident) - { /* change name of constructor and destructor */ - - if (!strcmp(SYMB_IDENT(NODE_SYMB(ll2)),oldident)) - { - SYMB_IDENT(NODE_SYMB(ll2)) = SYMB_IDENT(symb); - } - if (!strcmp(SYMB_IDENT(NODE_SYMB(ll2)),str)) - { - SYMB_IDENT(NODE_SYMB(ll2)) = str1; - } - - } - /* we have to replace the old symbol in the section */ - replaceSymbInStmts(stmt,last,oldsymb,NODE_SYMB(ll2)); - } - } - } - if (cur == last) - break; - } - - /* we need to replace in the member function the symbol declared in the structure */ - for (cur = stmt; cur ; cur = BIF_NEXT(cur)) - { - if ((BIF_CODE(cur) == FUNC_HEDR) && isInStmt(stmt,cur)) - { /* local declaration, update the owner */ - if (BIF_SYMB(cur)) - { - cur1 = stmt; - last1 = getLastNodeOfStmt(cur1); - for (i=0; i */ - symb1 = TYPE_SYMB_DERIVE(type1); - symb2 = TYPE_SYMB_DERIVE(type2); - if (symb1 && symb2) - { - if (symb1 == symb2) - return isTypeEquivalent(TYPE_COLL_BASE(type1), TYPE_COLL_BASE(type2)); - else - if (sameName(symb1,symb2)) /* this is a type name, the same ident should be enough*/ - return isTypeEquivalent(TYPE_COLL_BASE(type1), TYPE_COLL_BASE(type2)); - else - return 0; - } - } else - if (hasTypeSymbol(TYPE_CODE(type1))) - { - symb1 = TYPE_SYMB_DERIVE(type1); - symb2 = TYPE_SYMB_DERIVE(type2); - if (symb1 && symb2) - { - if (symb1 == symb2) - return 1; - else - if (sameName(symb1,symb2)) /* this is a type name, the same ident should be enough*/ - return 1; - else - return 0; - } - } - return(0); -} - - -/***************************************************************************/ -int lookForTypeInType(type,comp) - PTR_TYPE type,comp; -{ - if (!type) - return 0; - if (!isATypeNode(TYPE_CODE(type))) - { - Message("lookForTypeInType; arg1 Not a type node",0); - return 0; - } - if (hasTypeBaseType(TYPE_CODE(type))) - { - if (TYPE_BASE(type)) - { - if (isTypeEquivalent(TYPE_BASE(type), comp)) - { - return 1; - } - return lookForTypeInType(TYPE_BASE(type),comp); - } - } - return 0; -} - -/***************************************************************************/ -int replaceTypeInType(type,comp,new) - PTR_TYPE type,comp,new; -{ - if (!type) - return 0; - if (!isATypeNode(TYPE_CODE(type))) - { - Message("replaceTypeInType; arg1 Not a type node",0); - return 0; - } - if (hasTypeBaseType(TYPE_CODE(type))) - { - if (TYPE_BASE(type)) - { - if (isTypeEquivalent(TYPE_BASE(type), comp)) - { - TYPE_BASE(type) = new; - return 1; - } - return replaceTypeInType(TYPE_BASE(type),comp,new); - } - } - return 0; -} - -/***************************************************************************/ -void replaceTypeForSymb(symb, type, new) -PTR_SYMB symb; -PTR_TYPE type, new; -{ - PTR_TYPE ts; - PTR_SYMB ptsymb; - if (!symb || !type || !new) - return; - - if (!isATypeNode(TYPE_CODE(type))) - { - Message(" not a type node in replaceTypeForSymb",0); - return; - } - if (!isASymbNode(SYMB_CODE(symb))) - { - Message(" not a symbol node in replaceTypeForSymb",0); - return; - } - ts = SYMB_TYPE(symb); - if (isTypeEquivalent(ts,type)) - { - SYMB_TYPE(symb) = new; - } else - if (lookForTypeInType(ts,type)) - { - SYMB_TYPE(symb) = duplicateType(SYMB_TYPE(symb)); - replaceTypeInType(SYMB_TYPE(symb),type, new); - } - /* look if have a param list */ - switch (SYMB_CODE(symb)) - { - case MEMBER_FUNC: - case FUNCTION_NAME: - case PROCEDURE_NAME: - case PROCESS_NAME: - ptsymb = SYMB_FUNC_PARAM (symb); - while (ptsymb) - { - replaceTypeForSymb(ptsymb,type,new); - ptsymb = SYMB_NEXT_DECL (ptsymb); - } - break; - } -} - -/***************************************************************************/ -void replaceTypeInExpression(exprold, type, new) - PTR_LLND exprold; - PTR_TYPE type, new; -{ - /* PTR_SYMB symb, newsymb;*/ /* podd 15.03.99*/ - - if (!exprold || !type || !new) - return; - - if (!isATypeNode(TYPE_CODE(type))) - { - Message(" not a type node in replaceTypeInExpression",0); - return; - } - if (!isATypeNode(TYPE_CODE(new))) - { - Message(" not a type node in replaceTypeInExpression",0); - return; - } - - if (isTypeEquivalent(NODE_TYPE(exprold),type)) - { - NODE_TYPE(exprold) = new; - } else - { - if (lookForTypeInType(NODE_TYPE(exprold),type)) - { - NODE_TYPE(exprold) = duplicateType(NODE_TYPE(exprold)); - replaceTypeInType(NODE_TYPE(exprold),type,new); - } - } - -/* if (hasNodeASymb(NODE_CODE(exprold))) do not do that it will alias some symbols not to be changes - { - if (symb = NODE_SYMB(exprold)) - { - replaceTypeForSymb(symb,type,new); - } - }*/ - - replaceTypeInExpression(NODE_OPERAND0(exprold), type, new); - replaceTypeInExpression(NODE_OPERAND1(exprold), type, new); - -} - - -/***************************************************************************/ -void replaceTypeInStmts(debut, fin, type, new) - PTR_BFND debut, fin; - PTR_TYPE type,new; -{ - PTR_BFND temp; - - for (temp = debut; temp ; temp = BIF_NEXT(temp)) - { -/* if (BIF_SYMB(temp)) do not do that it will alias some symbols not to be changes - { - replaceTypeForSymb(BIF_SYMB(temp),type,new); - }*/ - replaceTypeInExpression(BIF_LL1(temp), type,new); - replaceTypeInExpression(BIF_LL2(temp), type,new); - replaceTypeInExpression(BIF_LL3(temp), type,new); - if (fin && (temp == fin)) - break; - } -} - -/* the following fonction are mainly dedicated to libcreatecollectionwithtype - used in the C++ library also with symb == NULL */ -/***************************************************************************/ -void replaceTypeUsedInStmt(symb,stmt,type,new) - PTR_SYMB symb; /* symb is not to duplicate */ - PTR_BFND stmt; - PTR_TYPE type,new; -{ - PTR_SYMB oldsymb; - PTR_BFND cur,last,body; - PTR_LLND ll1, ll2; - if (!stmt) - return; - last = getLastNodeOfStmt(stmt); - if (symb) - replaceTypeForSymb(symb,type,new); - replaceTypeInStmts(stmt,last,type,new); - for (cur = stmt; cur ; cur = BIF_NEXT(cur)) - { - if (symb) - { - if (isADeclBif(BIF_CODE(cur)) && (isInStmt(stmt,cur))) - { /* we have to declare what is declare there */ - for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) - { - ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); - if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) - { - oldsymb = NODE_SYMB(ll2); - /*symbol is declared here so change the type*/ - replaceTypeForSymb(oldsymb,type,new); - /* apply recursively */ - body = getBodyOfSymb(NODE_SYMB(ll2)); - if (body && (!isInStmt(stmt,body))) - { - replaceTypeUsedInStmt(NODE_SYMB(ll2),body,type,new); - replaceTypeInStmts(body,getLastNodeOfStmt(body),type,new); - } - } - } - } - } else - { /* simpler we have just to look the stmt - this is an replacement for everywhere */ - if (isADeclBif(BIF_CODE(cur))) - { /* we have to declare what is declare there */ - for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) - { - ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); - if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) - { - oldsymb = NODE_SYMB(ll2); - /*symbol is declared here so change the type*/ - replaceTypeForSymb(oldsymb,type,new); - } - } - } - } - if (cur == last) - break; - } -} - -/***************************************************************************/ -PTR_TYPE createDerivedCollectionType(col,etype) - PTR_SYMB col; - PTR_TYPE etype; -{ - PTR_TYPE newtc; - newtc = (PTR_TYPE) newNode(T_DERIVED_COLLECTION); /*wasted*/ - TYPE_COLL_BASE(newtc) = etype; - TYPE_SYMB_DERIVE(newtc) = col; - return newtc; -} - -/* the following function is not trivial - take a collection and generate the right - instance of the collection with name - collection_typename. - replace the type in the new body by the right one - needs many duplication, not only - duplicate for the code, but also for symbol type and so on - this function is presently use in the translator pc++2c++ - make basically an identical work as Templates........ - elemtype is going to replace elementtype; - - warning, all the symbol are not duplicated, expression are not duplicated too - useless to to it for all (at least for the moment) - */ - -/***************************************************************************/ -PTR_BFND LibcreateCollectionWithType(colltype, elemtype) - PTR_TYPE colltype, elemtype; -{ - PTR_SYMB coltoduplicate, copystruct,se = NULL; - PTR_TYPE etype,newt,newtc; - int len; - char *newname; - if (!colltype || !elemtype) - return NULL; - - /* the symbol we are duplicating */ - coltoduplicate = TYPE_SYMB_DERIVE(colltype); - etype = getDerivedTypeWithName("ElementType"); - if (!coltoduplicate || !etype) - { - Message("internal error in libcreatecollectionwithtype",0); - return NULL; - } - if (TYPE_CODE(elemtype) == T_DERIVED_TYPE) - { - se = TYPE_SYMB_DERIVE(elemtype); - if (!se) - { - Message("The element type must be a class type-1",0); - exit(1); - } - if (!SYMB_TYPE(se)) - { - Message("The element type must be a class type-2",0); - exit(1); - } - if (SYMB_TYPE(se) && ((TYPE_CODE(SYMB_TYPE(se)) != T_CLASS) - && (TYPE_CODE(SYMB_TYPE(se)) != T_TECLASS))) - { - Message("The element type must be a class type-3",0); - exit(1); - } - } - /* look for element type is given by iselementtype(type) */ - /* first we have to duplicate the code look at all the symbol */ - /* first duplicate the collection structure then we will do the methods - declare outside of the structure */ - copystruct = duplicateSymbolLevel2(coltoduplicate); - if (!copystruct) - Message("internal error in LibcreateCollectionWithType",0); - - /* duplicate at level 2 so must it is not necessary to do more - for duplicating */ - /* we have to set the new ID for the symbol according to the element type */ - len = strlen(SYMB_IDENT(copystruct)) + strlen(SYMB_IDENT(se))+10; - newname = (char *) xmalloc(len); - memset(newname, 0, len); - sprintf(newname,"%s__%s",SYMB_IDENT(copystruct),SYMB_IDENT(se)); - - SYMB_IDENT(copystruct) = newname; - - /* duplicate the symbol declared inside so we can attach a new type eventually */ - duplicateAllSymbolDeclaredInStmt(copystruct, getBodyOfSymb(copystruct),SYMB_IDENT(coltoduplicate)); - - /* the collection body and the method have been duplicated no we have to replace the type */ - /* first replace element type */ - replaceTypeUsedInStmt(copystruct, getBodyOfSymb(copystruct),etype,elemtype); - - /* now replace type like DistributedArray but first construct the new type - corresponding to that */ - newt = (PTR_TYPE) newNode(T_DERIVED_CLASS); - TYPE_SYMB_DERIVE(newt) = copystruct; - /* need to create a type for reference */ - newtc = createDerivedCollectionType(coltoduplicate,etype); - replaceTypeUsedInStmt(copystruct, getBodyOfSymb(copystruct),newtc,newt); - - /* replacing DistributedArray for instance is done elsewhere*/ - return getBodyOfSymb(copystruct); -} - -/***************************************************************************/ -int LibisMethodOfElement(symb) - PTR_SYMB symb; -{ - if (!symb) return FALSE; - if ((int) SYMB_ATTR(symb) & (int) ELEMENT_FIELD) - return TRUE; - else - return FALSE; -} - -/***************************************************************************/ -PTR_BFND LibfirstElementMethod(coll) - PTR_BFND coll; -{ - PTR_BFND pt,last; - PTR_SYMB symb; - PTR_LLND ll; - if (!coll ) - return NULL; - last = getLastNodeOfStmt(coll); - for (pt = coll; pt && (pt != BIF_NEXT(last)); pt = BIF_NEXT(pt)) - { - if (isADeclBif(BIF_CODE(pt)) - && (BIF_CP(pt) == coll)) - { - ll = giveLlSymbInDeclList(BIF_LL1(pt)); - if (ll && NODE_SYMB(ll)) - { - symb = NODE_SYMB(ll); - if (LibisMethodOfElement(symb)) - return pt; - } - } - } - return NULL; -} - - -/***************************************************************************/ -int buildLinearRep(exp,coef,symb,size,last) - PTR_LLND exp; - int *coef; - PTR_SYMB *symb; - int size; - int *last; -{ - return buildLinearRepSign(exp,coef,symb,size, last,1,1); -} - - -/* initialy coeff are 0, return 1 if Ok, 0 if abort*/ -/***************************************************************************/ -int buildLinearRepSign(exp,coef,symb,size, last,sign,factor) - PTR_LLND exp; - int *coef; - PTR_SYMB *symb; - int size; - int *last; - int sign; - int factor; -{ - int code; - int i, *res1,*res2; - - if (!exp) - return TRUE; - - code = NODE_CODE(exp); - switch (code) - { - case VAR_REF: - for (i=0; i< size; i++) - { - if (NODE_SYMB(exp) == symb[i]) - { - coef[i] = coef[i] + sign*factor; - return TRUE; - } - } - return FALSE; - - case SUBT_OP: - if (!buildLinearRepSign(NODE_OPERAND0(exp),coef,symb,size,last,sign,factor)) - return FALSE; - if (!buildLinearRepSign(NODE_OPERAND1(exp),coef,symb,size,last,-1*sign,factor)) - return FALSE; - break; - case ADD_OP: - if (!buildLinearRepSign(NODE_OPERAND0(exp),coef,symb,size,last,sign,factor)) - return FALSE; - if (!buildLinearRepSign(NODE_OPERAND1(exp),coef,symb,size,last,sign,factor)) - return FALSE; - break; - case MULT_OP: - res1 = evaluateExpression (NODE_OPERAND0(exp)); - res2 = evaluateExpression (NODE_OPERAND1(exp)); - if ((res1[0] != -1) && (res2[0] != -1)) - { - *last = *last + factor*sign*(res1[1]*res2[1]); - } else - { - int found; - if (res1[0] != -1) - { - /* la constante est le fils gauche */ - if (NODE_CODE(NODE_OPERAND1(exp)) != VAR_REF) - return buildLinearRepSign(NODE_OPERAND1(exp),coef,symb,size, last,sign,res1[1]*factor); - found = 0; - for (i=0; i< size; i++) - { - if (NODE_SYMB(NODE_OPERAND1(exp)) == symb[i]) - { - coef[i] = coef[i] + factor*sign*(res1[1]); - found = 1; - break; - } - } - if (!found) return FALSE; - } else - if (res2[0] != -1) - { - /* la constante est le fils droit */ - if (NODE_CODE(NODE_OPERAND0(exp)) != VAR_REF) - return buildLinearRepSign(NODE_OPERAND0(exp),coef,symb,size, last,sign,res2[1]*factor); - found =0; - for (i=0; i< size; i++) - { - if (NODE_SYMB(NODE_OPERAND0(exp)) == symb[i]) - { - coef[i] = coef[i] + factor*sign*(res2[1]); - found = 1; - break; - } - } - if (!found) return FALSE; - } else - return FALSE; - } - break; - case INT_VAL: - *last = *last + factor*sign*(NODE_INT_CST_LOW(exp)); - break; - default: - - return FALSE; - } - return TRUE; -} - - -/********************** FB ADDED JULY 94 *********************** - * ALLOW TO COPY A FULL SYMBOL ACCROSS FILE * - * THIS IS A FRAGILE FUNCTION BE CAREFUL WITH IT * - ***************************************************************/ - - -void resetDoVarForSymb() -{ - PTR_FILE ptf, saveptf; - PTR_BLOB ptb; - /* PTR_BFND tmp;*/ /* podd 15.03.99*/ - PTR_SYMB tsymb; - - saveptf = pointer_on_file_proj; - for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) - { - ptf = (PTR_FILE) BLOB_VALUE (ptb); - cur_file = ptf; - /* reset the toolbox and pointers*/ - Init_Tool_Box(); - for (tsymb = PROJ_FIRST_SYMB() ; tsymb; tsymb = SYMB_NEXT(tsymb)) - { - tsymb->dovar = 0; - } - } - cur_file = saveptf; - Init_Tool_Box(); -} - - -void updateTypesAndSymbolsInBody(symb, stmt, where) - PTR_BFND stmt, where; - PTR_SYMB symb; -{ - PTR_SYMB oldsymb, newsymb, param; - PTR_BFND cur,last; - PTR_LLND ll1, ll2; - PTR_TYPE type,new; - int isparam; - if (!stmt) - return; - last = getLastNodeOfStmt(stmt); - for (cur = stmt; cur ; cur = BIF_NEXT(cur)) - { - if (isADeclBif(BIF_CODE(cur))) - { /* we have to declare what is declare there */ - for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) - { - ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); - if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) - { - oldsymb = NODE_SYMB(ll2); - if (oldsymb != symb) - { - /* should check for param since already propagated - needs TO BE WRITTEN EXPRESSION?????? */ - param = SYMB_FUNC_PARAM (symb); - isparam = 0; - while (param) - { - if (param == oldsymb ) - { - isparam = 1; - break; - } - param = SYMB_NEXT_DECL (param ); - } - if (! isparam) - { - newsymb = duplicateSymbolAcrossFiles(oldsymb, where); - SYMB_SCOPE(newsymb) = stmt; - type = SYMB_TYPE(oldsymb); - new = duplicateTypeAcrossFiles(type); - SYMB_TYPE(newsymb) = new; - replaceTypeInStmts(stmt, last, type, new); - replaceSymbInStmts(stmt,last,oldsymb,newsymb); - } - } - } - } - } - if (cur == last) - break; - } -} - - - -PTR_SYMB duplicateSymbolAcrossFiles(symb, where) - PTR_SYMB symb; - PTR_BFND where; -{ - PTR_SYMB newsymb; - PTR_BFND body,newbody,last,before,cp; - PTR_SYMB ptsymb,ptref; - if (!symb) - return NULL; - - if (!isASymbNode(NODE_CODE(symb))) - { - Message("duplicateSymbolAcrossFiles; Not a symbol node",0); - return NULL; - } - if (symb->dovar) - { - /* already duplicated don't do it again */ - return symb; - } - newsymb = duplicateSymbolLevel1(symb); - newsymb->dovar = 1; - symb->dovar = 1; - /* need a function resetDovar for all files and all symb to be called before*/ - SYMB_SCOPE(newsymb) = where; - /* to be updated later Not that simple*/ - switch (SYMB_CODE(symb)) - { - case MEMBER_FUNC: - case FUNCTION_NAME: - case PROCEDURE_NAME: - case PROCESS_NAME: - /* find the body in the right file????*/ - body = getBodyOfSymb(symb); - if (body) - { - before = getNodeBefore(body); - cp = BIF_CP(body); - last = getLastNodeOfStmt(body); - newbody = duplicateStmtsNoExtract(body); - if (BIF_CODE (where) == GLOBAL) - insertBfndListIn (newbody, where,where); - else - insertBfndListIn (newbody, where,BIF_CP(where)); - BIF_SYMB(newbody) = newsymb; - SYMB_FUNC_HEDR(newsymb) = newbody; - /* we have to propagate change in the param list in the new body */ - ptsymb = SYMB_FUNC_PARAM (newsymb); - ptref = SYMB_FUNC_PARAM (symb); - last = getLastNodeOfStmt(newbody); - while (ptsymb) - { - SYMB_SCOPE(ptsymb) = newbody; - replaceSymbInStmts(newbody,last,ptref,ptsymb); - ptsymb = SYMB_NEXT_DECL (ptsymb); - ptref = SYMB_NEXT_DECL (ptref); - } - /* update the all the symbol and type used in the statement */ - updateTypesAndSymbolsInBody(newsymb,newbody, where); -/* printf(">>>>>>>>>>>>>>>>>>>>>>\n"); - UnparseProgram(stdout); - printf("<<<<<<<<<<<<<<<<<<<<<<\n");*/ - } - break; - case TECLASS_NAME: - case CLASS_NAME: - case COLLECTION_NAME: - case STRUCT_NAME: - case UNION_NAME: - body = getBodyOfSymb(symb); - if (body) - { - cp = BIF_CP(body);/*podd 12.03.99*/ - before = getNodeBefore(body);/*podd 12.03.99*/ - newbody = duplicateStmtsNoExtract(body); - insertBfndListIn (newbody, before,cp); - BIF_SYMB(newbody) = newsymb; - /* probably more to do here */ - SYMB_TYPE(newsymb) = duplicateTypeAcrossFiles(SYMB_TYPE(symb)); - /* set the new body for the symbol */ - TYPE_COLL_ORI_CLASS(SYMB_TYPE(newsymb)) = newbody; - updateTypesAndSymbolsInBody(newsymb,newbody, where); - } - break; - } - return newsymb; -} -/*-----------------------------------------------------------------*/ -/*podd 20.03.07*/ - -void updateExpression(exp, symb, newsymb) - PTR_LLND exp; - PTR_SYMB symb, newsymb; -{ - PTR_SYMB param,newparam; - param = SYMB_FUNC_PARAM (symb); - newparam = SYMB_FUNC_PARAM (newsymb); - while(param) - { - replaceSymbInExpression(exp,param, newparam); - param=SYMB_NEXT_DECL(param); - newparam=SYMB_NEXT_DECL(newparam); - } -} - -/*podd 06.06.06*/ -void updateTypeAndSymbolInStmts(PTR_BFND stmt, PTR_BFND last, PTR_SYMB oldsymb, PTR_SYMB newsymb) -{ - PTR_TYPE type, new; - - type = SYMB_TYPE(oldsymb); - new = duplicateTypeAcrossFiles(type); - SYMB_TYPE(newsymb) = new; - replaceTypeInStmts(stmt, last, type, new); - replaceSymbInStmts(stmt, last, oldsymb, newsymb); -} - -/*podd 26.02.19*/ -void replaceSymbByNameInExpression(PTR_LLND exprold, PTR_SYMB new) -{ - if(!exprold) - return; - if (hasNodeASymb(NODE_CODE(exprold))) - { - if ( !strcmp(SYMB_IDENT(NODE_SYMB(exprold)), new->ident) ) - NODE_SYMB(exprold) = new; - } - replaceSymbByNameInExpression(NODE_OPERAND0(exprold), new); - replaceSymbByNameInExpression(NODE_OPERAND1(exprold), new); -} - -/*podd 26.02.19*/ -void replaceSymbByNameInConstantValues(PTR_SYMB first_const_name, PTR_SYMB new) -{ - PTR_SYMB s; - for (s=first_const_name; s; s = SYMB_LIST(s)) - { - replaceSymbByNameInExpression (SYMB_VAL(s),new); - } -} -/*podd 26.02.19*/ -void updateConstantSymbolsInParameterValues(PTR_SYMB first_const_name) -{ - PTR_SYMB symb, prev_symb; - for (symb=first_const_name; symb; symb = SYMB_LIST(symb)) - { - replaceSymbByNameInConstantValues(first_const_name,symb); - } - - symb=first_const_name; - while (symb) - { - prev_symb = symb; - symb = SYMB_LIST(symb); - SYMB_LIST(prev_symb) = SMNULL; - } -} - -/*podd 26.02.19*/ -void replaceSymbInType(PTR_TYPE type, PTR_SYMB newsymb) -{ - if (!type) - return; - - if (!isATypeNode(NODE_CODE(type))) - { - Message("duplicateTypeAcrossFiles; Not a type node",0); - return ; - } - - if (isAtomicType(TYPE_CODE(type))) - { - replaceSymbByNameInExpression(TYPE_RANGES(type),newsymb); - replaceSymbByNameInExpression(TYPE_KIND_LEN(type),newsymb); - } - - if (hasTypeBaseType(TYPE_CODE(type))) - replaceSymbInType(TYPE_BASE(type), newsymb); - - - if ( TYPE_CODE(type) == T_ARRAY) - replaceSymbByNameInExpression(TYPE_RANGES(type),newsymb); -} - -/*podd 26.02.19*/ -void replaceSymbInTypeOfSymbols(PTR_SYMB newsymb,PTR_SYMB first_new) -{ - PTR_SYMB symb; - for( symb=first_new; symb; symb = SYMB_NEXT(symb) ) - replaceSymbInType(SYMB_TYPE(symb),newsymb); -} - -/*podd 26.02.19*/ -void updatesSymbolsInTypeExpressions(PTR_BFND new_stmt) -{ - PTR_SYMB symb, first_new; - first_new= BIF_SYMB(new_stmt); - for( symb=first_new; symb; symb = SYMB_NEXT(symb)) - replaceSymbInTypeOfSymbols(symb,first_new); -} -/*podd 05.12.20*/ -void updateSymbInInterfaceBlock(PTR_BFND block) -{ - PTR_BFND last, stmt; - PTR_SYMB symb, newsymb; - last = getLastNodeOfStmt(block); - stmt = BIF_NEXT(block); - while(stmt != last) - { - symb = BIF_SYMB(stmt); - if(symb && (BIF_CODE(stmt) == FUNC_HEDR || BIF_CODE(stmt) == PROC_HEDR)) - { - newsymb = duplicateSymbolLevel1(symb); - SYMB_SCOPE(newsymb) = block; - updateTypesAndSymbolsInBodyOfRoutine(newsymb, stmt, stmt); - stmt = BIF_NEXT(getLastNodeOfStmt(stmt)); - } - else - stmt = BIF_NEXT(stmt); - } -} - -void updateSymbolsOfList(PTR_LLND slist, PTR_BFND struct_stmt) -{ - PTR_LLND ll; - PTR_SYMB symb, newsymb; - for(ll=slist; ll; ll=ll->entry.Template.ll_ptr2) - { - symb = NODE_SYMB(ll->entry.Template.ll_ptr1); - if(symb) - { - newsymb = duplicateSymbolLevel1(symb); - SYMB_SCOPE(newsymb) = struct_stmt; - NODE_SYMB(ll->entry.Template.ll_ptr1) = newsymb; - } - } -} - -void updateSymbolsOfStructureFields(PTR_BFND struct_stmt) -{ - PTR_BFND last, stmt; - last = getLastNodeOfStmt(struct_stmt); - for(stmt=BIF_NEXT(struct_stmt); stmt!=last; stmt=BIF_NEXT(stmt)) - { - if(BIF_CODE(stmt) == VAR_DECL || BIF_CODE(stmt) == VAR_DECL_90) - updateSymbolsOfList(stmt->entry.Template.ll_ptr1, struct_stmt); - } -} - -void updateSymbolsInStructures(PTR_BFND new_stmt) -{ - PTR_BFND last, stmt; - last = getLastNodeOfStmt(new_stmt); - for(stmt=BIF_NEXT(new_stmt); stmt!=last; stmt=BIF_NEXT(stmt)) - { - if( BIF_CODE(stmt) == STRUCT_DECL) - { - updateSymbolsOfStructureFields(stmt); - stmt = getLastNodeOfStmt(stmt); - } - } -} - -void updateSymbolsInInterfaceBlocks(PTR_BFND new_stmt) -{ - PTR_BFND last, stmt; - last = getLastNodeOfStmt(new_stmt); - for(stmt=BIF_NEXT(new_stmt); stmt!=last; stmt=BIF_NEXT(stmt)) - { - if(BIF_CODE(stmt) == INTERFACE_STMT || BIF_CODE(stmt) == INTERFACE_ASSIGNMENT || BIF_CODE(stmt) == INTERFACE_OPERATOR ) - { - updateSymbInInterfaceBlock(stmt); - stmt = getLastNodeOfStmt(stmt); - } - } -} - -PTR_BFND getHedrOfSymb(PTR_SYMB symb, PTR_BFND new_stmt) -{ - PTR_BFND last, stmt; - last = getLastNodeOfStmt(new_stmt); - for(stmt = new_stmt; stmt != last; stmt = BIF_NEXT(stmt)) - { - if((stmt->variant == FUNC_HEDR || stmt->variant == PROC_HEDR) && BIF_SYMB(stmt) && !strcmp(symb->ident,BIF_SYMB(stmt)->ident)) - return stmt; - } - return NULL; -} - -void updateTypesAndSymbolsInBodyOfRoutine(PTR_SYMB new_symb, PTR_BFND stmt, PTR_BFND new_stmt) -{ - PTR_SYMB oldsymb, newsymb, until, const_list, first_const_name; - PTR_BFND last, last_new; - PTR_TYPE type; - PTR_SYMB symb, ptsymb, ptref; - if (!stmt || !new_stmt) - return; - symb = BIF_SYMB(stmt); - BIF_SYMB(new_stmt) = new_symb; - new_symb->decl = 1; - if(SYMB_CODE(new_symb) == PROGRAM_NAME) - new_symb->entry.prog_decl.prog_hedr = new_stmt; - else - SYMB_FUNC_HEDR(new_symb) = new_stmt; - last_new = getLastNodeOfStmt(new_stmt); - updateTypeAndSymbolInStmts(new_stmt, last_new, symb, new_symb); - - /* we have to propagate change in the param list in the new body */ - if(SYMB_CODE(new_symb) == PROGRAM_NAME || SYMB_CODE(new_symb) == MODULE_NAME) - ptsymb = ptref = SMNULL; - else - { - ptsymb = SYMB_FUNC_PARAM(new_symb); - ptref = SYMB_FUNC_PARAM(symb); - } - while (ptsymb) - { - SYMB_SCOPE(ptsymb) = new_stmt; - updateTypeAndSymbolInStmts(new_stmt, last_new, ptref, ptsymb); - ptsymb = SYMB_NEXT_DECL(ptsymb); - ptref = SYMB_NEXT_DECL(ptref); - } - - const_list = first_const_name = SMNULL; /* to make a list of constant names */ - - last = getLastNodeOfStmt(stmt); - if (BIF_NEXT(last) && BIF_CODE(BIF_NEXT(last)) != COMMENT_STAT && stmt != new_stmt) - until = BIF_SYMB(BIF_NEXT(last)); - else - until = SYMB_NEXT(last_file_symbol); /*last_file_symbol is last symbol of source file's Symbol Table */ - - for (oldsymb = SYMB_NEXT(symb); oldsymb && oldsymb != until; oldsymb = SYMB_NEXT(oldsymb)) - { - if (SYMB_SCOPE(oldsymb) == stmt) - { - if (SYMB_TEMPLATE_DUMMY1(oldsymb) != IO) /*is not a dummy parameter */ - { - newsymb = duplicateSymbolLevel1(oldsymb); - if(SYMB_CODE(newsymb)==CONST_NAME) - { - if(first_const_name == SMNULL) - { - first_const_name = const_list = newsymb; - newsymb->id_list = SMNULL; - } - const_list->id_list = newsymb; - newsymb->id_list = SMNULL; - const_list = newsymb; - } - - if((SYMB_CODE(newsymb)==FUNCTION_NAME || SYMB_CODE(newsymb)==PROCEDURE_NAME) && SYMB_FUNC_HEDR(oldsymb)) - updateTypesAndSymbolsInBodyOfRoutine(newsymb, SYMB_FUNC_HEDR(oldsymb), getHedrOfSymb(oldsymb,new_stmt)); - - SYMB_SCOPE(newsymb) = new_stmt; - updateTypeAndSymbolInStmts(new_stmt, last_new, oldsymb, newsymb); - } - } - } - updateConstantSymbolsInParameterValues(first_const_name); /*podd 26.02.19*/ - updatesSymbolsInTypeExpressions(new_stmt); /*podd 26.02.19*/ - updateSymbolsInInterfaceBlocks(new_stmt); /*podd 07.12.20*/ - updateSymbolsInStructures(new_stmt); /*podd 07.12.20*/ -} - -PTR_SYMB duplicateSymbolOfRoutine(PTR_SYMB symb, PTR_BFND where) -{ - PTR_SYMB newsymb; - PTR_BFND body, newbody, last; - - if (!symb) - return NULL; - - if (!isASymbNode(NODE_CODE(symb))) - { - Message("duplicateSymbolAcrossFiles; Not a symbol node", 0); - return NULL; - } - - newsymb = duplicateSymbolLevel1(symb); - - SYMB_SCOPE(newsymb) = SYMB_SCOPE(symb); /*where*/ - - /* to be updated later Not that simple*/ - switch (SYMB_CODE(symb)) - { - case FUNCTION_NAME: - case PROCEDURE_NAME: - case PROGRAM_NAME: - case MODULE_NAME: - - body = getBodyOfSymb(symb); - last = getLastNodeOfStmt(body); - newbody = duplicateStmtsNoExtract(body); - if (where) - { - if (BIF_CODE(where) == GLOBAL) - insertBfndListIn(newbody, where, where); - else - insertBfndListIn(newbody, where, BIF_CP(where)); - } - /* update the all the symbol and type used in the program unit */ - updateTypesAndSymbolsInBodyOfRoutine(newsymb, body, newbody); - - /* printf(">>>>>>>>>>>>>>>>>>>>>>\n"); - UnparseProgram(stdout); - printf("<<<<<<<<<<<<<<<<<<<<<<\n"); */ - - break; - } - return newsymb; -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.uni b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.uni deleted file mode 100644 index 4d468b7..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.uni +++ /dev/null @@ -1,40 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/lib/newsrc/makefile.sgi - -LIBDIR = ../../../lib - -OLDHEADERS = ../../h - -# Directory in which include file can be found -TOOLBOX_INCLUDE = ../include - -INCL = -I$(OLDHEADERS) -I../include - -TOOLBOX_SRC = low_level.c unparse.c - -TOOLBOX_HDR = $(TOOLBOX_INCLUDE)/macro.h $(TOOLBOX_INCLUDE)/bif_node.def \ - $(TOOLBOX_INCLUDE)/type.def $(TOOLBOX_INCLUDE)/symb.def - -CFLAGS = $(INCL) -c -DSYS5 -Wall - -low_level.o: low_level.c $(TOOLBOX_HDR) - -unparse.o: unparse.c $(TOOLBOX_HDR) $(TOOLBOX_INCLUDE)/unparse.def \ - $(TOOLBOX_INCLUDE)/unparseC++.def - -TOOLBOX_OBJ = low_level.o unparse.o - -$(LIBDIR)/libsage.a: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) - ar qc $(LIBDIR)/libsage.a $(TOOLBOX_OBJ) - -all: $(LIBDIR)/libsage.a - @echo "*** COMPILING LIBRARY newsrc DONE" - -clean: - rm -f $(TOOLBOX_OBJ) -cleanall: - rm -f $(TOOLBOX_OBJ) diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.win b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.win deleted file mode 100644 index a75c78b..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/makefile.win +++ /dev/null @@ -1,54 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/lib/newsrc/makefile.win - -OUTDIR = ../../../obj -LIBDIR = ../../../lib - -OLDHEADERS = ../../h - -# Directory in which include file can be found -TOOLBOX_INCLUDE = ../include - -INCL = -I$(OLDHEADERS) -I../include - -TOOLBOX_SRC = low_level.c unparse.c - -TOOLBOX_HDR = $(TOOLBOX_INCLUDE)/macro.h $(TOOLBOX_INCLUDE)/bif_node.def \ - $(TOOLBOX_INCLUDE)/type.def $(TOOLBOX_INCLUDE)/symb.def - -# -w don't issue warning now. -#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ -# /Fp"$(OUTDIR)/newsrc.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c -CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ - /Fp"$(OUTDIR)/newsrc.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c - -.c{$(OUTDIR)/}.obj: - $(CC) $(CFLAGS) $< - -LIB32=$(LINKER) -lib -LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libsage.lib" - - -$(OUTDIR)/low_level.obj: low_level.c $(TOOLBOX_HDR) - -$(OUTDIR)/unparse.obj: unparse.c $(TOOLBOX_HDR) $(TOOLBOX_INCLUDE)/unparse.def \ - $(TOOLBOX_INCLUDE)/unparseC++.def - -TOOLBOX_OBJ = $(OUTDIR)/low_level.obj $(OUTDIR)/unparse.obj - -$(LIBDIR)/libsage.lib: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) - $(LIB32) @<< - $(LIB32_FLAGS) $(TOOLBOX_OBJ) -<< - -all: $(LIBDIR)/libsage.lib - @echo "*** COMPILING LIBRARY newsrc DONE" - - -clean: - -cleanall: diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/toolsann.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/toolsann.c deleted file mode 100644 index ec02171..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/toolsann.c +++ /dev/null @@ -1,1043 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993,1995 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/************************************************************************** -* * * Annotation toolbox for Sigma * * * * * -**************************************************************************/ - -#include -#include - -#include "compatible.h" /* Make different system compatible... (PHB) */ -#ifdef SYS5 -#include -#else -#include -#endif - -#include "macro.h" -#include "ext_lib.h" -#include "ext_low.h" - -#define ASYMBOLEXT "_%d_" /* must have a %d field for number */ -#define MAX_ANNOTATION 10000 -#define ForCOMMENTSTART "C$ann\0" /* For fortran Must start with big C */ -#define ForCOMMENTCONT "C$cont\0" /* idem */ -#define C_COMMENTSTART "//$ann\0" /* For C Must start with big / */ -#define C_COMMENTCONT "-+-++++--\0" /* not in C */ - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -extern void removeFromCollection(void *pointer); -#endif - -int TRACEANN = 0; - -/* Assertion Tab */ - -extern int Number_of_proc; -extern PTR_FILE pointer_on_file_proj; -extern PTR_LLND ANNOTATE_NODE; -extern char *STRINGTOPARSE; -extern int LENSTRINGTOPARSE; -extern int PTTOSTRINGTOPARSE; -extern PTR_BFND ANNOTATIONSCOPE; -extern PTR_TYPE global_int_annotation; -extern char AnnExTensionNumber[]; -extern int yyparse_annotate(void); - -/* FORWARD DECLARATION */ -int Get_Scope_Of_Annotation(); -void Propagate_defined_value(); -int Set_The_Define_Field(); -char *Unparse_Annotation(); -PTR_LLND Parse_Annotation(); - - -char * -Remove_Ann_Cont(str) -char *str; -{ - int i =0; - int j; - - if (str == NULL) - return NULL; - - if (Check_Lang_Fortran(cur_proj)) - { /* does not apply to C */ - while (str[i] != '\0') - { - if (str[i] == 'C') - { - if (strncmp(&(str[i]),ForCOMMENTCONT,strlen(ForCOMMENTCONT)) == 0) - { - for (j = 0; j < (int)strlen(ForCOMMENTCONT); j++) - str[i+j] = ' '; - i = i+j; - } - } - i++; - } - } - return str; -} - - -/* Init annotation System, mainly gathers annotation */ -/* we use array to store annotation can be modify to count the size and alloc - things */ - -static char *Annotation_PT[MAX_ANNOTATION]; /* the string */ -static PTR_BFND Annotation_BIFND[MAX_ANNOTATION]; /* the bif node next */ -PTR_LLND Annotation_LLND[MAX_ANNOTATION]; /* result of unparse */ -static PTR_CMNT Annotation_CMNT[MAX_ANNOTATION]; /* to the comment */ -static int Annotation_Def[MAX_ANNOTATION]; /* is it define */ -static int Nb_Annotation; /* number of annotation found */ -static char *Defined_Value_Str[MAX_ANNOTATION]; -static int Defined_Value_Value[MAX_ANNOTATION]; - -/* Indicate if comment is an annotation */ -int Is_Annotation(str) -char *str; -{ - - if (!str) - return FALSE; - - if (Check_Lang_Fortran(cur_proj)) - { - if (strncmp(ForCOMMENTSTART,str, strlen(ForCOMMENTSTART)) == 0) - return TRUE; - else - return FALSE; - } else - { - if (strncmp(C_COMMENTSTART,str, strlen(C_COMMENTSTART)) == 0) - return TRUE; - else - return FALSE; - } -} - -int Is_Annotation_Cont(str) -char *str; -{ - - if (!str) - return FALSE; - - if (!Check_Lang_Fortran(cur_proj)) - return FALSE; - if (strncmp(ForCOMMENTCONT,str, strlen(ForCOMMENTCONT)) == 0) - return TRUE; - else - return FALSE; -} - - -char * -Get_Annotation_String(str) -char * str; -{ - char * pt, *pt1; - int i,goahead; - char * stra = NULL; - pt = str; - - if (!str) - return NULL; - - while((*pt != '\0') && (*pt != '[')) - { - pt++; - } - if (*pt != '[') - Message("Annotation failed",0); - /* count the length */ - pt1 = pt; - i = 0; - goahead = TRUE; - while(goahead) - { - goahead = FALSE; - while((*pt1 != '\0') && (*pt1 != '\n')) - { - pt1++; - i++; - } - - if (*pt1 != '\0') - { - if (Is_Annotation_Cont(pt1+1)) - { - goahead = TRUE; - pt1++; - i++; - } - } - } - if (i > 1024) - { - stra = (char *) xmalloc(i+2); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,stra, 0); -#endif - memset(stra, 0, i+2); - } - else - { - stra = (char *) xmalloc(1024); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,stra, 0); -#endif - memset(stra, 0,1024); - } - strncpy(stra,pt,i); - stra = Remove_Carriage_Return(stra); - stra = Remove_Ann_Cont(stra); - return stra; -} - -/* basically got to the carriage return */ -char * -Get_to_Next_Annotation_String(str) -char *str; -{ - char * pt; - pt = str; - if (!Check_Lang_Fortran(cur_proj)) - return NULL; - pt++; /* avoid pb of looping */ - while((*pt != '\0')) - { - if (*pt == 'C') - { - if (strncmp(pt,ForCOMMENTSTART, strlen(ForCOMMENTSTART)) == 0) - break; - } - pt++; - } - if (*pt == '\n') - pt++; - if (*pt == '\0') - return NULL; - return pt; -} - -/* basically go thrue the program and parse annotation, and set - if they are defined */ -int initAnnotation() -{ - PTR_CMNT cmnt; - PTR_BFND ptbif; - int count =0; - int i; - char *str; - - global_int_annotation = GetAtomicType(T_INT); - memset((char *) Annotation_PT, 0, sizeof(char) *MAX_ANNOTATION); - memset((char *) Annotation_BIFND, 0, sizeof(PTR_BFND) *MAX_ANNOTATION); - memset((char *) Annotation_LLND, 0, sizeof(PTR_LLND) *MAX_ANNOTATION); - memset((char *) Annotation_CMNT, 0, sizeof(PTR_CMNT) *MAX_ANNOTATION); - memset((char *) Annotation_Def, 0, sizeof(int) *MAX_ANNOTATION); - - ptbif = PROJ_FIRST_BIF(); - count =0; - while (ptbif) - { - if (BIF_CMNT(ptbif)) - { - cmnt = BIF_CMNT(ptbif); - str = CMNT_STRING(cmnt); - while (str) - { - if (Is_Annotation(str)) - { - Annotation_PT[count] = Get_Annotation_String(str); - Annotation_CMNT[count] = cmnt; - Annotation_BIFND[count] = ptbif; - count++; - if (MAX_ANNOTATION <= count) - { - Message("Too many annotations",0); - exit(1); - } - } - str = Get_to_Next_Annotation_String(str); - } - - } - ptbif = BIF_NEXT(ptbif); - } - Nb_Annotation = count; - - for (i=0; i < Nb_Annotation; i++) - { - if (TRACEANN) printf("See annotation %s\n",Annotation_PT[i]); - } - - - /* unparse the annotation */ - if (TRACEANN) printf("---------------------------------------------\n\n\n"); - for (i=0; i < Nb_Annotation; i++) - { - sprintf(AnnExTensionNumber,ASYMBOLEXT,i); - Annotation_LLND[i] = Parse_Annotation(Annotation_PT[i], - Annotation_BIFND[i]); - if (!Annotation_LLND[i]) - Message("Annotation Parse Error",BIF_LINE(Annotation_BIFND[i])); - - if (TRACEANN) printf("Unparse :: %s\n",Unparse_Annotation(Annotation_LLND[i])); - } - if (TRACEANN) printf("---------------------------------------------\n\n\n"); - /* setup which annotation is defined */ - Set_The_Define_Field(); - /* propagate the defined value */ - Propagate_defined_value(); - if (TRACEANN) - { - PTR_BFND first,last; - printf("---------------------------------------------\n\n\n"); - for (i=0; i < Nb_Annotation; i++) - { - Get_Scope_Of_Annotation(i,&first,&last); - if (first) - printf("A(%d) Scope first (line %d) :: %s", i,BIF_LINE(first), funparse_bfnd(first)); - if (last) - printf("A(%d) Scope last (line %d) :: %s", i, BIF_LINE(last), funparse_bfnd(last)); - } - } - - /* unparse the annotation */ - if (TRACEANN) - { - - printf("---------------------------------------------\n\n\n"); - for (i=0; i < Nb_Annotation; i++) - { - printf("Unparse :: %s\n",Unparse_Annotation(Annotation_LLND[i])); - } - } - return 1; -} - - -PTR_LLND -Parse_Annotation(string,scope) - char * string; - PTR_BFND scope; -{ - PTTOSTRINGTOPARSE = 0; - STRINGTOPARSE = string; - ANNOTATIONSCOPE = scope; - ANNOTATE_NODE = NULL; - LENSTRINGTOPARSE = strlen(string) +1; - - yyparse_annotate(); - - return ANNOTATE_NODE; -} - - -PTR_LLND -Get_Define_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - int i; - if (!ann) - return(NULL); - pt = ann; - for(i =0 ; i < 0; i++) - pt = NODE_OPERAND1(pt); - - return(NODE_OPERAND0(pt)); - -} - - -char * -Get_Define_Label_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - - pt = ann; - - if(!pt) - return NULL; - if (!NODE_OPERAND0(pt)) - return NULL; - - /* it a function call name with one parameter */ - pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); - /* pt is Expr_list */ - - if (pt && NODE_OPERAND0(pt)) - return(NODE_STRING_POINTER(NODE_OPERAND0(pt))); - else - return NULL; -} - - -char * -Get_Label_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - int i; - - if(!ann) - return NULL; - - pt = ann; - for(i =0 ; i < 1; i++) - pt = NODE_OPERAND1(pt); - - - if (!NODE_OPERAND0(pt)) - return NULL; - - /* it a function call name with one parameter */ - pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); - /* pt is Expr_list */ - - if (pt && NODE_OPERAND0(pt)) - return(NODE_STRING_POINTER(NODE_OPERAND0(pt))); - else - return NULL; -} - - -PTR_LLND -Get_ApplyTo_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - int i; - - if(!ann) - return NULL; - - pt = ann; - for(i =0 ; i < 2; i++) - pt = NODE_OPERAND1(pt); - - if(!pt) - return NULL; - if (!NODE_OPERAND0(pt)) - return NULL; - - /* it a function call name with one parameter */ - pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); - /* pt is Expr_list */ - - if (pt && NODE_OPERAND0(pt)) - return(NODE_OPERAND0(pt)); - else - return NULL; - -} - -PTR_LLND -Get_ApplyToIf_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - int i; - - pt = ann; - for(i =0 ; i < 2; i++) - pt = NODE_OPERAND1(pt); - - - if(!pt) - return NULL; - if (!NODE_OPERAND0(pt)) - return NULL; - - /* it a function call name with two parameters, we want the second one */ - pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); - /* pt is Expr_list */ - - if (pt && NODE_OPERAND1(pt)) - return(NODE_OPERAND0(NODE_OPERAND1(pt))); - else - return NULL; -} - - -PTR_LLND -Get_LocalVar_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - int i; - - if(!ann) - return NULL; - - pt = ann; - for(i =0 ; i < 3; i++) - pt = NODE_OPERAND1(pt); - - return(NODE_OPERAND0(pt)); - -} - - -PTR_LLND -Get_Annotation_Field(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - int i; - - if(!ann) - return NULL; - - pt = ann; - for(i =0 ; i < 4; i++) - pt = NODE_OPERAND1(pt); - - return(NODE_OPERAND0(pt)); - -} - - -char * -Get_Annotation_Field_Label(ann) -PTR_LLND ann; -{ - PTR_LLND pt; - - if (!ann) - return NULL; - - pt = Get_Annotation_Field(ann); - - if (!pt) - return NULL; - - if (NODE_CODE(pt) != FUNC_CALL) - { - Message("Pb in annotation field",0); - return NULL; - } - - return Get_Function_Name_For_Call(pt); -} - -char * -Unparse_Annotation(ann) -PTR_LLND ann; -{ - char *str; - char temp[256]; - - if(!ann) - return NULL; - - str = (char *) xmalloc(1024); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,str, 0); -#endif - sprintf(str,"["); - if (Get_Define_Label_Field(ann)) - { - sprintf(temp,"IfDef(\"%s\");",Get_Define_Label_Field(ann)); - strcat(str,temp); - } - - if (Get_Label_Field(ann)) - { - sprintf(temp,"Label(\"%s\");",Get_Label_Field(ann)); - strcat(str,temp); - } - - if (Get_ApplyTo_Field(ann)) - { /* need more than that */ - sprintf(temp,"ApplyTo( %s) ",Remove_Carriage_Return(cunparse_llnd(Get_ApplyTo_Field(ann)))); - strcat(str,temp); - if (Get_ApplyToIf_Field(ann)) - { - sprintf(temp,"If ( %s) ;",Remove_Carriage_Return(cunparse_llnd(Get_ApplyToIf_Field(ann)))); - strcat(str,temp); - } else - strcat(str,";"); - } - - if (Get_LocalVar_Field(ann)) - { - sprintf(temp,"%s; ",Remove_Carriage_Return(cunparse_llnd(Get_LocalVar_Field(ann)))); - strcat(str,temp); - } - - if (Get_Annotation_Field(ann)) - { - sprintf(temp,"%s",Remove_Carriage_Return(cunparse_llnd(Get_Annotation_Field(ann)))); - strcat(str,temp); - } - - strcat(str,"]"); - return(str); -} - - -char * -Does_Annotation_Defines(ann, value) -int *value; -PTR_LLND ann; -{ - PTR_LLND pt,pt1; - char *name; - int *res1; - - if (! (pt = Get_Annotation_Field(ann))) - return NULL; - - name = Get_Function_Name_For_Call(pt); - - if(strcmp(name,"Define") == 0) - if ((pt1 = Get_First_Parameter_For_Call(pt))) - { - res1 = evaluateExpression(Get_Second_Parameter_For_Call(pt)); - if (res1[0] != -1) - *value = res1[1]; - - return NODE_STRING_POINTER(pt1); - } - - return NULL; -} - -/* set all the annotation that are defined */ -int Set_The_Define_Field() -{ - int i,j; - char *str, *tsrt; - int value; - int found; - /* set up those field - Annotation_Def[] - char *Defined_Value_Str[MAX_ANNOTATION]; - int Defined_Value_Value[MAX_ANNOTATION]; - */ - - for (i = 0; i < Nb_Annotation; i++) - { - if (Get_Define_Field(Annotation_LLND[i]) == NULL) - { - /* independant defined */ - if (TRACEANN) - printf("Annotation Defined : %s\n", tsrt = Unparse_Annotation(Annotation_LLND[i])); -#ifdef __SPF - removeFromCollection(tsrt); -#endif - free(tsrt); - - Annotation_Def[i] = TRUE; - /* check if it defined something */ - Defined_Value_Str[i] = - Does_Annotation_Defines(Annotation_LLND[i] - , &value); - Defined_Value_Value[i] = value; - } - } - /* end of initial setup */ - /* propagate forward only */ - for (i=0; i< Nb_Annotation ; i++) - { - str = Get_Define_Label_Field(Annotation_LLND[i]); - if (str) - { /* look if the word is defined */ - found = FALSE; - for (j = i-1; j>= 0 ; j--) - { - if (Defined_Value_Str[j]) - { - if (strcmp(str,Defined_Value_Str[j]) == 0) - { - found = TRUE; - break; - } - } - } - if (found) - { - Annotation_Def[i] = TRUE; - if (TRACEANN) printf("Annotation Defined : %s\n",Unparse_Annotation(Annotation_LLND[i])); - /* check if it defined something */ - Defined_Value_Str[i] = - Does_Annotation_Defines(Annotation_LLND[i] - , &value); - Defined_Value_Value[i] = value; - } - - } - } - return 0; -} - - -/* return the annotation with label -1 for not found */ -int -Get_Annotation_With_Label(str) -char *str; -{ int i; - char *strc; - - - for (i=0; i < Nb_Annotation; i++) - { - strc = Get_Label_Field(Annotation_LLND[i]); - if (strc) - { - if (strcmp(strc, str) == 0) - { - return i; - } - } - } - return -1; -} - - -/* Compute the first and last bif node a annotation applies */ - -int Get_Scope_Of_Annotation(nb,first,last) -int nb; -PTR_BFND *first, *last; -{ - PTR_LLND ann,f1,f2; - PTR_LLND field_apply; - char *str; - int nb2; - - ann = Annotation_LLND[nb]; - if (!ann) - { - *first = NULL; - *last = NULL; - return FALSE; - } - if (!Annotation_Def[nb]) - { - *first = NULL; - *last = NULL; - return TRUE; - } - - /* the first case is easy */ - field_apply = Get_ApplyTo_Field(ann); - if (!field_apply) - { - *first = Annotation_BIFND[nb]; - *last = Annotation_BIFND[nb]; - return TRUE; - } - - /* depend on */ - f1 = field_apply; - if (!f1) - { - *first = Annotation_BIFND[nb]; - *last = Annotation_BIFND[nb]; - return FALSE; - } - switch(NODE_CODE(f1)) - { - case VAR_REF: - Message("Function Call in Get_Scope_Of_Annotation not yet implemented, sorry",0); - break; - case STRING_VAL : - str = NODE_STRING_POINTER(f1); - if (strcmp(str,"NextStmt") == 0) - { - *first = Annotation_BIFND[nb]; - *last = Annotation_BIFND[nb]; - return TRUE; - } - if (strcmp(str,"NextAnnotation") == 0) - { - *first = Annotation_BIFND[nb]; - *last = Annotation_BIFND[nb+1]; - if (*last == NULL) - *last = Get_Last_Node_Of_Project(); - return TRUE; - } - if (strcmp(str,"EveryWhere") == 0) - { - *first = PROJ_FIRST_BIF(); - *last = Get_Last_Node_Of_Project(); - return TRUE; - } - if (strcmp(str,"Follow") == 0) - { - *first = Annotation_BIFND[nb]; - *last = Get_Last_Node_Of_Project(); - return TRUE; - } - if (strcmp(str,"CurrentScope") == 0) - { - *first = BIF_CP(Annotation_BIFND[nb]); - if (*first) - *last = getLastNodeOfStmt(*first); - else - *last = NULL; - return TRUE; - } - Message("Pb in Get_Scope_Of_Annotation",0); - break; - case EXPR_LIST : - *first = Annotation_BIFND[nb]; - if (NODE_OPERAND0(f1)) - { - f2 = NODE_OPERAND0(f1); - if (f2 && (NODE_CODE(f2) == STRING_VAL)) - { - str = NODE_STRING_POINTER(f2); - nb2 = Get_Annotation_With_Label(str); - if (nb2!= -1) - { - *first = Annotation_BIFND[nb2]; - } else - Message("Pb in Get_Scope_Of_Annotation",0); - } else - Message("Pb in Get_Scope_Of_Annotation",0); - } - f2 = NODE_OPERAND0(NODE_OPERAND1(f1)); - if (f2 && (NODE_CODE(f2) == STRING_VAL)) - { - str = NODE_STRING_POINTER(f2); - nb2 = Get_Annotation_With_Label(str); - if (nb2!= -1) - { - *last = getNodeBefore(Annotation_BIFND[nb2]); - } else - Message("Pb in Get_Scope_Of_Annotation",0); - } else - Message("Pb in Get_Scope_Of_Annotation",0); - - break; - default: - { - Message("Pb in Get_Scope_Of_Annotation",0); - return FALSE; - } - } - return TRUE; -} - - -/* for all defined value, propagate forward */ - -void Propagate_defined_value() -{ - int i; - int j; - PTR_LLND val; - char *str; - for (i=0 ; i< Nb_Annotation ; i++) - { - if (Defined_Value_Str[i]) - { - val = makeInt(Defined_Value_Value[i]); - str = Defined_Value_Str[i]; - for (j = i+1 ; j< Nb_Annotation ; j++) - { - if (Annotation_LLND[j]) - if (Get_Annotation_Field_Label(Annotation_LLND[j])) - { - if (strcmp(Get_Annotation_Field_Label(Annotation_LLND[j]), - "Define") != 0) - Replace_String_In_Expression(NODE_OPERAND1(NODE_OPERAND1(Annotation_LLND[j])), str, val); - } else - Replace_String_In_Expression(NODE_OPERAND1(NODE_OPERAND1(Annotation_LLND[j])), str, val); - } - } - } -} - -/* return NULL if not annotation of kind apply, otherwise return the - llnd expression corresponding to the annotation - Very dumb version, but simple one (warning, because of label an annotation - does not apply where it is necessarely, except for defined annotation )*/ - -PTR_LLND -Does_Annotation_Apply(kind,bif) - char *kind; - PTR_BFND bif; -{ - int i; - PTR_BFND first,last; - - for (i=0 ; i< Nb_Annotation ; i++) - { - if (Annotation_Def[i]) - { - if (kind) - { - if (strcmp(Get_Annotation_Field_Label(Annotation_LLND[i]), kind) == 0) - { - if (Get_Scope_Of_Annotation(i,&first,&last)) - { - if (isItInSection(first, last, bif)) - return Get_Annotation_Field(Annotation_LLND[i]); - } - } - }else - { - if (Get_Scope_Of_Annotation(i,&first,&last)) - { - if (isItInSection(first, last, bif)) - return Get_Annotation_Field(Annotation_LLND[i]); - } - } - } - } - return NULL; -} - - -PTR_LLND -Get_Annotation_Field_List_For_Stmt(bif) - PTR_BFND bif; -{ - int i; - PTR_BFND first,last; - PTR_LLND list = NULL, pt =NULL; - - - for (i=0 ; i< Nb_Annotation ; i++) - { - if (Annotation_Def[i]) - { - if (Get_Scope_Of_Annotation(i,&first,&last)) - { - if (isItInSection(first, last, bif)) - { - if (!list) - { - list = newExpr(EXPR_LIST,NULL, - Get_Annotation_Field(Annotation_LLND[i]), - NULL); - pt = list; - }else - { - NODE_OPERAND1(pt) = newExpr(EXPR_LIST,NULL, - Get_Annotation_Field(Annotation_LLND[i]), - NULL); - pt = NODE_OPERAND1(pt); - } - - } - } - } - } - return list; -} - - - -PTR_LLND -Get_Annotation_List_For_Stmt(bif) - PTR_BFND bif; -{ - int i; - PTR_BFND first,last; - PTR_LLND list = NULL, pt =NULL; - - - for (i=0 ; i< Nb_Annotation ; i++) - { - if (Annotation_Def[i]) - { - if (Get_Scope_Of_Annotation(i,&first,&last)) - { - if (isItInSection(first, last, bif)) - { - if (!list) - { - list = newExpr(EXPR_LIST,NULL, - Annotation_LLND[i], - NULL); - pt = list; - }else - { - NODE_OPERAND1(pt) = newExpr(EXPR_LIST,NULL, - Annotation_LLND[i], - NULL); - pt = NODE_OPERAND1(pt); - } - - } - } - } - } - return list; -} - -/* Access functions */ -int -Get_Number_of_Annotation() -{ - return Nb_Annotation; -} - - -PTR_BFND -Get_Annotation_Bif(id) - int id; -{ - return Annotation_BIFND[id]; -} - - -PTR_LLND -Get_Annotation_Expr(id) - int id; -{ - return Annotation_LLND[id]; -} - -char * -Get_String_of_Annotation(id) - int id; -{ - return Annotation_PT[id]; -} - -PTR_CMNT -Get_Annotation_Comment(id) - int id; -{ - return Annotation_CMNT[id]; -} - - -int -Is_Annotation_Defined(id) - int id; -{ - return Annotation_Def[id]; -} - - -char * -Annotation_Defines_string(id) - int id; -{ - return Defined_Value_Str[id]; -} - -int -Annotation_Defines_string_Value(id) - int id; -{ - return Defined_Value_Value[id]; -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/unparse.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/unparse.c deleted file mode 100644 index cc70fb9..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/newsrc/unparse.c +++ /dev/null @@ -1,3265 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - - /************************************************************************** - * * - * Unparser for toolbox * - * * - *************************************************************************/ - -#include -#include /* podd 15.03.99*/ -#include - -#include "compatible.h" /* Make different system compatible... (PHB) */ -#ifdef SYS5 -#include -#else -#include -#endif - -#include "macro.h" -#include "ext_lib.h" -#include "ext_low.h" -/*static FILE *finput;*/ -/*static FILE *outfile;*/ -static int TabNumber = 0; -static int TabNumberCopy = 0; -static int Number_Of_Flag = 0; -#define MAXFLAG 64 -#define MAXLFLAG 256 -#define MAXLEVEL 256 -static char TabOfFlag[MAXFLAG][MAXLFLAG]; -static int FlagLenght[MAXFLAG]; -static int FlagLevel[MAXFLAG]; -static int FlagOn[MAXLEVEL][MAXFLAG]; - -//#define MAXLENGHTBUF 5000000 -//static char UnpBuf[MAXLENGHTBUF]; - -#define INIT_LEN 500000 -static int Buf_pointer = 0; -static int max_lenght_buf = 0; -static char* allocated_buf = NULL; -static char* Buf_address = NULL; -static char* UnpBuf = NULL; - -int CommentOut = 0; -int HasLabel = 0; -#define C_Initialized 1 -#define Fortran_Initialized 2 -static int Parser_Initiated = 0; -static int Function_Language = 0; /* 0 - undefined, 1 - C language, 2 - Fortran language */ - -extern void Message(); -extern int out_free_form; - -/* FORWARD DECLARATIONS */ -int BufPutString(); - -/* usage exemple - Init_Unparser(); or Reset_Unparser(); if Init_Unparser(); has been done - - fprintf(outfile,"%s",Tool_Unparse_Bif(PROJ_FIRST_BIF ())); -*/ - -/*****************************************************************************/ -/*****************************************************************************/ -/***** *****/ -/***** UNPARSE.C: Gregory HOGDAL / Eric MARCHAND July 1992 *****/ -/***** Modified F. Bodin 08/92 . Modified D. Gannon 3/93 - 6/93 *****/ -/***** *****/ -/*****************************************************************************/ -/*****************************************************************************/ - -/***********************************/ -/* function de unparse des bif node */ -/***********************************/ - -#include "f90.h" - -typedef struct -{ - char *str; - char *(* fct)(); -} UNP_EXPR; - - -static UNP_EXPR Unparse_Def[LAST_CODE]; - -/************ Unparse Flags **************/ -static int In_Write_Flag = 0; -static int Rec_Port_Decl = 0; -static int In_Param_Flag = 0; -static int In_Impli_Flag = 0; -static int In_Class_Flag = 0; -static int Type_Decl_Ptr = 0; -/*****************************************/ -static PTR_SYMB construct_name; - -/*************** TYPE names in ASCII form ****************/ -static char *ftype_name[] = {"integer", - "real", - "double precision", - "character", - "logical", - "character", - "gate", - "event", - "sequence", - "", - "", - "", - "", - "complex", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "double complex", - "" -};static char *ctype_name[] = {"int", - "float", - "double", - "char", - "logical", - "char", - "gate", - "event", - "sequence", - "error1", - "error2", - "error3", - "error4", - "complex", - "void", - "error6", - "error7", - "error8", - "error9", - "error10", - "error11", - "error12", - "ElementType", - "error14", - "error15", - "error16", - "error17", - "error18", - "error19", - "error20", - "error21", - "error22", - "error23", - "long" -}; - -static -char *ridpointers[] = { - "-error1-", /* unused */ - "-error2-", /* int */ - "char", /* char */ - "float", /* float */ - "double", /* double */ - "void", /* void */ - "-error3-", /* unused1 */ - "unsigned", /* unsigned */ - "short", /* short */ - "long", /* long */ - "auto", /* auto */ - "static", /* static */ - "extern", /* extern */ - "register", /* register */ - "typedef", /* typedef */ - "signed", /* signed */ - "const", /* const */ - "volatile", /* volatile */ - "private", /* private */ - "future", /* future */ - "virtual", /* virtual */ - "inline", /* inline */ - "friend", /* friend */ - "-error4-", /* public */ - "-error5-", /* protected */ - "Sync", /* CC++ sync */ - "global", /* CC++ global */ - "atomic", /* CC++ atomic */ - "__private", /* for KSR */ - "restrict", - "_error6-", - "__global__", /* Cuda */ - "__shared__", /* Cuda */ - "__device__" /* Cuda */ -}; - -/*********************************************************/ - -/******* Precedence table of operators for C++ *******/ -static short precedence_C[RSHIFT_ASSGN_OP-EQ_OP+1]= - {6, /* == */ - 5, /* < */ - 5, /* > */ - 6, /* != */ - 5, /* <= */ - 5, /* >= */ - 3, /* + */ - 3, /* - */ - 11, /* || */ - 2, /* * */ - 2, /* / */ - 2, /* % */ - 10, /* && */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 8, /* ^ */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 1, /* Minus_op*/ - 1, /* ! */ - 13, /* = */ - 1, /* * (by adr)*/ - 0, /* -> */ - 0, /* function */ - 1, /* -- */ - 1, /* ++ */ - 7, /* & */ - 9 /* | */ - }; -static short precedence2_C[]= {1, /* ~ */ - 12, /* ? */ - 0, /* none */ - 0, /* none */ - 4, /* << */ - 4, /* >> */ - 0, /* none */ - 1, /*sizeof*/ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 1, /*(type)*/ - 1, /*&(address)*/ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 13, /* += */ - 13, /* -= */ - 13, /* &= */ - 13, /* |= */ - 13, /* *= */ - 13, /* /= */ - 13, /* %= */ - 13, /* ^= */ - 13, /* <<= */ - 13 /* >>= */ - }; - -/******* Precedence table of operators for Fortran *******/ -static char precedence[] = {5, /* .eq. */ - 5, /* .lt. */ - 5, /* .gt. */ - 5, /* .ne. */ - 5, /* .le. */ - 5, /* .ge. */ - 3, /* + */ - 3, /* - */ - 8, /* .or. */ - 2, /* * */ - 2, /* / */ - 0, /* none */ - 7, /* .and. */ - 1, /* ** */ - 0, /* none */ - 4, /* // */ - 8, /* .xor. */ - 9, /* .eqv. */ - 9, /* .neqv. */ - 0, /* none */ - 0, /* none */ - 0, /* none */ - 1, /* Minus_op*/ - 1 /* not op */ - }; - -#define type_index(X) (X-T_INT) /* gives the index of a type to access the Table "ftype_name" from a type code */ -#define binop(n) (n >= EQ_OP && n <= NEQV_OP) /* gives the boolean value of the operation "n" being binary (not unary) */ -#define C_op(n) (n >= EQ_OP && n <= RSHIFT_ASSGN_OP) - -/* manage the unparse buffer */ - -void -DealWith_Rid(typei, flg) - PTR_TYPE typei; - int flg; /* if 1 then do virtual */ -{ int j; - - int index; - PTR_TYPE type; - if (!typei) - return; - - for (type = typei; type; ) - { - switch(TYPE_CODE(type)) - { - case T_POINTER : - case T_REFERENCE : - case T_FUNCTION : - case T_ARRAY : - type = TYPE_BASE(type); - break; - case T_MEMBER_POINTER: - type = TYPE_COLL_BASE(type); - case T_DESCRIPT : - index = TYPE_LONG_SHORT(type); - /* printf("index = %d\n", index); */ - if( index & BIT_RESTRICT) { - BufPutString(ridpointers[(int)RID_RESTRICT],0); - BufPutString(" ", 0); - } - if( index & BIT_KSRPRIVATE) { - BufPutString(ridpointers[(int)RID_KSRPRIVATE],0); - BufPutString(" ", 0); - } - if( index & BIT_EXTERN) { - BufPutString(ridpointers[(int)RID_EXTERN],0); - BufPutString(" ", 0); - } - if( index & BIT_TYPEDEF) { - BufPutString(ridpointers[(int)RID_TYPEDEF],0); - BufPutString(" ", 0); - } - for (j=1; j< MAX_BIT; j= j*2) - { - switch (index & j) - { - case (int) BIT_PRIVATE: BufPutString(ridpointers[(int)RID_PRIVATE],0); - break; - case (int) BIT_FUTURE: BufPutString(ridpointers[(int)RID_FUTURE],0); - break; - case (int) BIT_VIRTUAL: if(flg) BufPutString(ridpointers[(int)RID_VIRTUAL],0); - break; - case (int) BIT_ATOMIC: if(flg) BufPutString(ridpointers[(int)RID_ATOMIC],0); - break; - case (int) BIT_INLINE: BufPutString(ridpointers[(int)RID_INLINE],0); - break; - case (int) BIT_UNSIGNED: BufPutString(ridpointers[(int)RID_UNSIGNED],0); - break; - case (int) BIT_SIGNED : BufPutString(ridpointers[(int)RID_SIGNED],0); - break; - case (int) BIT_SHORT : BufPutString(ridpointers[(int)RID_SHORT],0); - break; - case (int) BIT_LONG : BufPutString(ridpointers[(int)RID_LONG],0); - break; - case (int) BIT_VOLATILE: BufPutString(ridpointers[(int)RID_VOLATILE],0); - break; - case (int) BIT_CONST : BufPutString(ridpointers[(int)RID_CONST],0); - break; - case (int) BIT_GLOBL : BufPutString(ridpointers[(int)RID_GLOBL],0); - break; - case (int) BIT_SYNC : BufPutString(ridpointers[(int)RID_SYNC],0); - break; - case (int) BIT_TYPEDEF : /* BufPutString(ridpointers[(int)RID_TYPEDEF],0); */ - break; - case (int) BIT_EXTERN : /* BufPutString(ridpointers[(int)RID_EXTERN],0); */ - break; - case (int) BIT_AUTO : BufPutString(ridpointers[(int)RID_AUTO],0); - break; - case (int) BIT_STATIC : BufPutString(ridpointers[(int)RID_STATIC],0); - break; - case (int) BIT_REGISTER: BufPutString(ridpointers[(int)RID_REGISTER],0); - break; - case (int) BIT_FRIEND: BufPutString(ridpointers[(int)RID_FRIEND],0); - - } - if ((index & j) != 0) - BufPutString(" ",0); - } - type = TYPE_DESCRIP_BASE_TYPE(type); - break; - default: - type = NULL; - } - } -} - -int is_overloaded_type(bif) - PTR_BFND bif; -{ - PTR_LLND ll; - if(!bif) return 0; - ll = BIF_LL1(bif); - while(ll && (NODE_SYMB(ll) == NULL)) ll = NODE_OPERAND0(ll); - if(ll == NULL) return 0; - if(SYMB_ATTR(NODE_SYMB(ll)) & OVOPERATOR) return 1; - else return 0; -} - -PTR_TYPE Find_Type_For_Bif(bif) - PTR_BFND bif; -{ - PTR_TYPE type = NULL; - if (BIF_LL1(bif) && (NODE_CODE(BIF_LL1(bif)) == EXPR_LIST)) - { PTR_LLND tp; - tp = BIF_LL1(bif); - for (tp = NODE_OPERAND0(tp); tp && (type == NULL); ) - { - switch (NODE_CODE(tp)) { - case BIT_NUMBER: - case ASSGN_OP : - case ARRAY_OP: - case FUNCTION_OP : - case CLASSINIT_OP: - case ADDRESS_OP: - case DEREF_OP : - tp = NODE_OPERAND0(tp); - break ; - case SCOPE_OP: - tp = NODE_OPERAND1(tp); - break; - case FUNCTION_REF: - case ARRAY_REF: - case VAR_REF: - if (tp) - { - if (!NODE_SYMB(tp)){ - printf("syntax error at line %d\n", bif->g_line); - exit(1); - } - else - type = SYMB_TYPE(NODE_SYMB(tp)); - } - tp = NULL; - break ; - default: - type = NODE_TYPE(tp); - break; - } - } - } - return type; -} - - -int Find_Protection_For_Bif(bif) - PTR_BFND bif; -{ - int protect = 0; - if (BIF_LL1(bif) && (BIF_CODE(BIF_LL1(bif)) == EXPR_LIST)) - { PTR_LLND tp; - tp = BIF_LL1(bif); - for (tp = NODE_OPERAND0(tp); tp && (protect == 0); ) - { - switch (NODE_CODE(tp)) { - case BIT_NUMBER: - case ASSGN_OP : - case ARRAY_OP: - case FUNCTION_OP : - case CLASSINIT_OP: - case ADDRESS_OP: - case DEREF_OP : - tp = NODE_OPERAND0(tp); - break ; - case SCOPE_OP: - tp = NODE_OPERAND1(tp); - break; - case FUNCTION_REF: - case ARRAY_REF: - case VAR_REF: - if (tp) - protect = SYMB_ATTR(NODE_SYMB(tp)); - tp = NULL; - break ; - } - } - } - return protect; -} - -PTR_TYPE Find_BaseType(ptype) - PTR_TYPE ptype; -{ - PTR_TYPE pt; - - if (!ptype) - return NULL; - pt = TYPE_BASE (ptype); - if (pt) - { int j; - j = 0; - while ((j < 100) && pt) - { - if (TYPE_CODE(pt) == DEFAULT) break; - if (TYPE_CODE(pt) == T_INT) break; - if (TYPE_CODE(pt) == T_FLOAT) break; - if (TYPE_CODE(pt) == T_DOUBLE) break; - if (TYPE_CODE(pt) == T_CHAR) break; - if (TYPE_CODE(pt) == T_BOOL) break; - if (TYPE_CODE(pt) == T_STRING) break; - if (TYPE_CODE(pt) == T_COMPLEX) break; - if (TYPE_CODE(pt) == T_DCOMPLEX) break; - if (TYPE_CODE(pt) == T_VOID) break; - if (TYPE_CODE(pt) == T_UNKNOWN) break; - if (TYPE_CODE(pt) == T_DERIVED_TYPE) break; - if (TYPE_CODE(pt) == T_DERIVED_COLLECTION) break; - if (TYPE_CODE(pt) == T_DERIVED_TEMPLATE) break; - if (TYPE_CODE(pt) == T_DERIVED_CLASS) break; - if (TYPE_CODE(pt) == T_CLASS) break; - if (TYPE_CODE(pt) == T_COLLECTION) break; - if (TYPE_CODE(pt) == T_DESCRIPT) break; /* by dbg */ - if (TYPE_CODE(pt) == T_LONG) break; /*15.11.12*/ - - pt = TYPE_BASE (pt); - j++; - } - if (j == 100) - { - Message("Looping in getting the Basetype; sorry",0); - exit(1); - } - } - return pt; -} - -PTR_TYPE Find_BaseType2(ptype) /* breaks out of the loop for pointers and references BW */ - PTR_TYPE ptype; -{ - PTR_TYPE pt; - - if (!ptype) - return NULL; - pt = TYPE_BASE (ptype); - if (pt) - { int j; - j = 0; - while ((j < 100) && pt) - { - if (TYPE_CODE(pt) == T_REFERENCE) break; - if (TYPE_CODE(pt) == T_POINTER) break; - if (TYPE_CODE(pt) == DEFAULT) break; - if (TYPE_CODE(pt) == T_INT) break; - if (TYPE_CODE(pt) == T_FLOAT) break; - if (TYPE_CODE(pt) == T_DOUBLE) break; - if (TYPE_CODE(pt) == T_CHAR) break; - if (TYPE_CODE(pt) == T_BOOL) break; - if (TYPE_CODE(pt) == T_STRING) break; - if (TYPE_CODE(pt) == T_COMPLEX) break; - if (TYPE_CODE(pt) == T_DCOMPLEX) break; - if (TYPE_CODE(pt) == T_VOID) break; - if (TYPE_CODE(pt) == T_UNKNOWN) break; - if (TYPE_CODE(pt) == T_DERIVED_TYPE) break; - if (TYPE_CODE(pt) == T_DERIVED_COLLECTION) break; - if (TYPE_CODE(pt) == T_DERIVED_CLASS) break; - if (TYPE_CODE(pt) == T_CLASS) break; - if (TYPE_CODE(pt) == T_COLLECTION) break; - if (TYPE_CODE(pt) == T_DESCRIPT) break; /* by dbg */ - - pt = TYPE_BASE (pt); - j++; - } - if (j == 100) - { - Message("Looping in getting the Basetype; sorry",0); - exit(1); - } - } - return pt; -} - - - -char *create_unp_str(str) - char *str; -{ - char *pt; - - if (!str) - return NULL; - - pt = (char *) xmalloc(strlen(str)+1); - memset(pt, 0, strlen(str)+1); - strcpy(pt,str); - return pt; -} - - -char *alloc_str(size) - int size; -{ - char *pt; - - if (!(size++)) return NULL; - pt = (char *) xmalloc(size); - memset(pt, 0, size); - return pt; -} - -int next_letter(str) - char *str; -{ - int i = 0; - while(isspace(str[i])) - i++; - return i; -} - -char *unparse_stmt_str(str) - char *str; -{ - char *pt; - int i,j,len; - char c; - if(!out_free_form) - return str; - if (!str) - return NULL; - pt = (char *) xmalloc(strlen(str)+2); - - i = next_letter(str); /*first letter*/ - c = tolower(str[i]); - if(c == 'd') - len = 4; - else if (c == 'f') - len = 6; - - for(j=1; j < len; j++) - i = i + next_letter(str+i+1) + 1; - - if(len == 4) - strcpy(pt,"data "); - else - strcpy(pt,"format "); - - strcpy(pt+len+1,str+i+1); - return pt; -} - -void Reset_Unparser() -{ - int i,j; - - /* initialize the number of flag */ - Number_Of_Flag = 0; - for (i=0; i < MAXFLAG ; i++) - { - TabOfFlag[i][0] = '\0'; - FlagLenght[i] = 0; - for(j=0; j= max_lenght_buf) //MAXLENGHTBUF) - { - realocBuf(Buf_pointer + 1); - //Message("Unparse Buffer Full",0); - /*return 0;*/ /*podd*/ - //exit(1); - } - Buf_address[Buf_pointer] = c; - Buf_pointer++; - return 1; -} - -int BufPutString(char* s, int len) -{ - int length; - if (!s) - { - Message("Null String in BufPutString", 0); - return 0; - } - - length = len; - if (length <= 0) - length = strlen(s); - - if (Buf_pointer + length >= max_lenght_buf) //MAXLENGHTBUF) - { - realocBuf(Buf_pointer + length); - //Message("Unparse Buffer Full", 0); - /*return 0;*/ /*podd*/ - //exit(1); - } - strncpy(&(Buf_address[Buf_pointer]), s, length); - Buf_pointer += length; - return 1; -} - - -int BufPutInt(int i) -{ - int length; - char s[MAXLFLAG]; - - sprintf(s, "%d", i); - length = strlen(s); - - if (Buf_pointer + length >= max_lenght_buf) //MAXLENGHTBUF) - { - realocBuf(Buf_pointer + length); - //Message("Unparse Buffer Full", 0); - /*return 0;*/ /*podd*/ - //exit(1); - } - strncpy(&(Buf_address[Buf_pointer]), s, length); - Buf_pointer += length; - return 1; -} - -int Get_Flag_val(str, i) - char *str; - int *i; -{ - int j, con; - char sflag[MAXLFLAG]; - (*i)++; /* skip the paranthesis */ - /* extract the flag name */ - j = *i; - con = 0; - - while ((str[j] != '\0') && (str[j] != ')')) - { - sflag[con] = str[j]; - con ++; - j ++; - } - sflag[con] = '\0'; - con ++; - - /* look in table if flag is in */ - - for (j = 0 ; j < Number_Of_Flag; j++) - { - if (strncmp(TabOfFlag[j],sflag, con) == 0) - break; - } - *i += con; - if (j >= Number_Of_Flag) - { - /* not found */ - return 0; - } - else - return FlagOn[FlagLevel[j]][j]; - -} - -void Treat_Flag(str, i, val) - char *str; - int *i; - int val; -{ - int j, con; - char sflag[MAXLFLAG]; - (*i)++; /* skip the paranthesis */ - /* extract the flag name */ - j = *i; - con = 0; - - while ((str[j] != '\0') && (str[j] != ')')) - { - sflag[con] = str[j]; - con ++; - j ++; - } - sflag[con] = '\0'; - con ++; - - /* look in table if flag is in */ - - for (j = 0 ; j < Number_Of_Flag; j++) - { - if (strncmp(TabOfFlag[j],sflag, con) == 0) - break; - } - if (j >= Number_Of_Flag) - { - /* not found */ - strcpy(TabOfFlag[Number_Of_Flag],sflag); - FlagOn[0][Number_Of_Flag] = val; - FlagLenght[Number_Of_Flag] = con-1; - Number_Of_Flag++; - } else - FlagOn[FlagLevel[j]][j] += val; - *i += con; -} - - -void PushPop_Flag(str, i, val) - char *str; - int *i; - int val; -{ - int j, con; - char sflag[MAXLFLAG]; - (*i)++; /* skip the paranthesis */ - /* extract the flag name */ - j = *i; - con = 0; - - while ((str[j] != '\0') && (str[j] != ')')) - { - sflag[con] = str[j]; - con ++; - j ++; - } - sflag[con] = '\0'; - con ++; - - /* look in table if flag is in */ - - for (j = 0 ; j < Number_Of_Flag; j++) - { - if (strncmp(TabOfFlag[j],sflag, con) == 0) - break; - } - if (j < Number_Of_Flag) - { - /* if a pop, clear old value befor poping */ - if(val< 0) FlagOn[FlagLevel[j]][j] = 0; /* added by dbg to make sure initialized */ - FlagLevel[j] += val; - if (FlagLevel[j] < 0) - FlagLevel[j] = 0; - if (FlagLevel[j] >= MAXLEVEL) - { - Message("Stack of flag overflow; abort()",0); - abort(); - } - } - /* else printf("WARNING(unparser): unknow flag pushed or popped:%s\n",sflag); */ - *i += con; -} - -char * Tool_Unparse_Type(); - -char * -Tool_Unparse_Symbol (symb) - PTR_SYMB symb; -{ - PTR_TYPE ov_type; - if (!symb) - return NULL; - if (SYMB_IDENT(symb)) - { - if((SYMB_ATTR(symb) & OVOPERATOR)){ - ov_type = SYMB_TYPE(symb); - if(TYPE_CODE(ov_type) == T_DESCRIPT){ - if(TYPE_LONG_SHORT(ov_type) == BIT_VIRTUAL && In_Class_Flag){ - BufPutString ("virtual ",0); - if(TYPE_LONG_SHORT(ov_type) == BIT_ATOMIC) BufPutString ("atomic ",0); - ov_type = TYPE_DESCRIP_BASE_TYPE(ov_type); - } - if(TYPE_LONG_SHORT(ov_type) == BIT_INLINE){ - BufPutString ("inline ",0); - ov_type = TYPE_DESCRIP_BASE_TYPE(ov_type); - } - } - } else ov_type = NULL; - -/* if ((SYMB_ATTR(symb) & OVOPERATOR) || - (strcmp(SYMB_IDENT(symb),"()")==0) || - (strcmp(SYMB_IDENT(symb),"*")==0) || - (strcmp(SYMB_IDENT(symb),"+")==0) || - (strcmp(SYMB_IDENT(symb),"-")==0) || - (strcmp(SYMB_IDENT(symb),"/")==0) || - (strcmp(SYMB_IDENT(symb),"=")==0) || - (strcmp(SYMB_IDENT(symb),"%")==0) || - (strcmp(SYMB_IDENT(symb),"&")==0) || - (strcmp(SYMB_IDENT(symb),"|")==0) || - (strcmp(SYMB_IDENT(symb),"!")==0) || - (strcmp(SYMB_IDENT(symb),"~")==0) || - (strcmp(SYMB_IDENT(symb),"^")==0) || - (strcmp(SYMB_IDENT(symb),"+=")==0) || - (strcmp(SYMB_IDENT(symb),"-=")==0) || - (strcmp(SYMB_IDENT(symb),"*=")==0) || - (strcmp(SYMB_IDENT(symb),"/=")==0) || - (strcmp(SYMB_IDENT(symb),"%=")==0) || - (strcmp(SYMB_IDENT(symb),"^=")==0) || - (strcmp(SYMB_IDENT(symb),"&=")==0) || - (strcmp(SYMB_IDENT(symb),"|=")==0) || - (strcmp(SYMB_IDENT(symb),"<<")==0) || - (strcmp(SYMB_IDENT(symb),">>")==0) || - (strcmp(SYMB_IDENT(symb),"<<=")==0) || - (strcmp(SYMB_IDENT(symb),">>=")==0) || - (strcmp(SYMB_IDENT(symb),"==")==0) || - (strcmp(SYMB_IDENT(symb),"!=")==0) || - (strcmp(SYMB_IDENT(symb),"<=")==0) || - (strcmp(SYMB_IDENT(symb),">=")==0) || - (strcmp(SYMB_IDENT(symb),"<")==0) || - (strcmp(SYMB_IDENT(symb),">")==0) || - (strcmp(SYMB_IDENT(symb),"&&")==0) || - (strcmp(SYMB_IDENT(symb),"||")==0) || - (strcmp(SYMB_IDENT(symb),"++")==0) || - (strcmp(SYMB_IDENT(symb),"--")==0) || - (strcmp(SYMB_IDENT(symb),"->")==0) || - (strcmp(SYMB_IDENT(symb),"->*")==0) || - (strcmp(SYMB_IDENT(symb),",")==0) || - (strcmp(SYMB_IDENT(symb),"[]")==0) ) - BufPutString ("operator ",0); -*/ - } - /* - if(ov_type) Tool_Unparse_Type(ov_type, 0); - else */ - BufPutString (SYMB_IDENT(symb),0); - return Buf_address; -} - - -typedef struct -{ - int typ; - union {char *S; -// int I; - long I; - } val; -} operand; - -/* macro def. of operand type */ -#define UNDEF_TYP 0 -#define STRING_TYP 1 -#define INTEGER_TYP 2 - -/* macro def. of comparison operators */ -#define COMP_UNDEF -1 /* Bodin */ -#define COMP_EQUAL 0 -#define COMP_DIFF 1 - - - -void Get_Type_Operand (str, iptr, ptype,Op) - char *str; - int *iptr; - PTR_TYPE ptype; - operand *Op; -{ - - Op->typ = UNDEF_TYP; - if (strncmp(&(str[*iptr]),"%CHECKFLAG", strlen("%CHECKFLAG"))== 0) - { - Op->typ = INTEGER_TYP; - *iptr += strlen("%CHECKFLAG"); - Op->val.I = Get_Flag_val(str, iptr); - } else - if (strncmp(&(str[*iptr]),"%STRCST", strlen("%STRCST"))== 0) /* %STRCST : String Constant */ - { - int i_save; - - *iptr += strlen("%STRCST"); - while (str[*iptr] == ' ') {(*iptr)++;} /* skip spaces before string */ - if (str[*iptr] != '\'') - { - Message (" *** Missing \"'\" after %STRCST *** ",0); - } - i_save = ++(*iptr); - while ((str[*iptr] != '\0') && (str[*iptr] != '\'')) (*iptr)++; - Op->val.S = alloc_str ((*iptr) - i_save); - strncpy (Op->val.S, &(str[i_save]), (*iptr) - i_save); - Op->typ = STRING_TYP; - } else - if (strncmp(&(str[*iptr]),"%NULL", strlen("%NULL"))== 0) /* %NULL : Integer Constant (or false boolean) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = 0; - *iptr += strlen("%NULL"); - } else - if (strncmp(&(str[*iptr]),"%INIMPLI", strlen("%INIMPLI"))== 0) /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = In_Impli_Flag; - *iptr += strlen("%INIMPLI"); - } else - { - Message (" *** Unknown operand in %IF (condition) for Type Node *** ",0); - } -} - -void Get_LL_Operand (str, iptr, ll, Op) - char *str; - int *iptr; - PTR_LLND ll; - operand *Op; -{ - - Op->typ = UNDEF_TYP; - if (strncmp(&(str[*iptr]),"%CHECKFLAG", strlen("%CHECKFLAG"))== 0) - { - Op->typ = INTEGER_TYP; - *iptr += strlen("%CHECKFLAG"); - Op->val.I = Get_Flag_val(str, iptr); - } else - if (strncmp(&(str[*iptr]),"%STRCST", strlen("%STRCST"))== 0) /* %STRCST : String Constant */ - { - int i_save; - - *iptr += strlen("%STRCST"); - while (str[*iptr] == ' ') {(*iptr)++;} /* skip spaces before string */ - if (str[*iptr] != '\'') - { - Message (" *** Missing \"'\" after %STRCST *** ",0); - } - i_save = ++(*iptr); - while ((str[*iptr] != '\0') && (str[*iptr] != '\'')) (*iptr)++; - Op->val.S = alloc_str ((*iptr) - i_save); - strncpy (Op->val.S, &(str[i_save]), (*iptr) - i_save); - Op->typ = STRING_TYP; - } else - if (strncmp(&(str[*iptr]),"%SYMBOL", strlen("%SYMBOL"))== 0) /* %SYMBOL : Symbol pointer (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) NODE_SYMB (ll); - *iptr += strlen("%SYMBOL"); - } else - if (strncmp(&(str[*iptr]),"%SYMBID", strlen("%SYMBID"))== 0) /* %SYMBID : Symbol identifier (string) */ - { - Op->typ = STRING_TYP; - if (NODE_SYMB (ll)) - Op->val.S = SYMB_IDENT (NODE_SYMB (ll)); - else - Op->val.S = NULL; - *iptr += strlen("%SYMBID"); - } else - if (strncmp(&(str[*iptr]),"%VALUE", strlen("%VALUE"))== 0) /* %VALUE: Symbol value */ - { - Op->typ = INTEGER_TYP; - if (NODE_TEMPLATE_LL1 (ll) && NODE_SYMB (NODE_TEMPLATE_LL1 (ll)) && NODE_CODE(NODE_SYMB (NODE_TEMPLATE_LL1 (ll)))==CONST_NAME) - Op->val.I = (long) (NODE_SYMB (NODE_TEMPLATE_LL1(ll)))->entry.const_value; - else - Op->val.I = 0; - *iptr += strlen("%VALUE"); - } else - if (strncmp(&(str[*iptr]),"%NULL", strlen("%NULL"))== 0) /* %NULL : Integer Constant (or false boolean) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = 0; - *iptr += strlen("%NULL"); - } else - if (strncmp(&(str[*iptr]),"%LL1", strlen("%LL1"))== 0) /* %LL1 : Low Level Node 1 (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) NODE_TEMPLATE_LL1 (ll); - *iptr += strlen("%LL1"); - } else - if (strncmp(&(str[*iptr]),"%LL2", strlen("%LL2"))== 0) /* %LL2 : Low Level Node 2 (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) NODE_TEMPLATE_LL2 (ll); - *iptr += strlen("%LL2"); - } else - if (strncmp(&(str[*iptr]),"%LABUSE", strlen("%LABUSE"))== 0) /* %LABUSE : label ptr (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) NODE_LABEL (ll); - *iptr += strlen("%LABUSE"); - } else - if (strncmp(&(str[*iptr]),"%L1CODE", strlen("%L1CODE"))== 0) /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ - { - Op->typ = INTEGER_TYP; - if (NODE_TEMPLATE_LL1 (ll)) - Op->val.I = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - else - Op->val.I = 0; - *iptr += strlen("%L1CODE"); - } else - if (strncmp(&(str[*iptr]),"%L2CODE", strlen("%L2CODE"))== 0) /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ - { - Op->typ = INTEGER_TYP; - if (NODE_TEMPLATE_LL2 (ll)) - Op->val.I = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - else - Op->val.I = 0; - *iptr += strlen("%L2CODE"); - } else - if (strncmp(&(str[*iptr]),"%INWRITE", strlen("%INWRITE"))== 0) /* %INWRITE : In_Write_Statement (integer / boolean flag) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = In_Write_Flag; - *iptr += strlen("%INWRITE"); - } else - if (strncmp(&(str[*iptr]),"%RECPORT", strlen("%RECPORT"))== 0) /* %RECPORT : reccursive_port_decl (integer / boolean flag) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = Rec_Port_Decl; - *iptr += strlen("%RECPORT"); - } else - if (strncmp(&(str[*iptr]),"%INPARAM", strlen("%INPARAM"))== 0) /* %INPARAM : In_Param_Statement (integer / boolean flag) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = In_Param_Flag; - *iptr += strlen("%INPARAM"); - } else - if (strncmp(&(str[*iptr]),"%INIMPLI", strlen("%INIMPLI"))== 0) /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = In_Impli_Flag; - *iptr += strlen("%INIMPLI"); - } else - if (strncmp(&(str[*iptr]),"%L1L2*L1CODE", strlen("%L1L2*L1CODE"))== 0) /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ - { - PTR_LLND temp; - - Op->typ = INTEGER_TYP; - if (NODE_OPERAND0(ll)) - { - temp = NODE_OPERAND0(ll); - while (temp && NODE_OPERAND1(temp)) temp = NODE_OPERAND1(temp); - if (temp && NODE_OPERAND0(temp)) - Op->val.I = NODE_CODE (NODE_OPERAND0(temp)); - else - Op->val.I = 0; - } - else - Op->val.I = 0; - *iptr += strlen("%L1L2*L1CODE"); - } else - if (strncmp(&(str[*iptr]),"%TYPEDECL", strlen("%TYPEDECL"))== 0) /* %TYPEDECL */ - { - Op->typ = INTEGER_TYP; - Op->val.I = Type_Decl_Ptr; - *iptr += strlen("%TYPEDECL"); - } else - if (strncmp(&(str[*iptr]),"%TYPEBASE", strlen("%TYPEBASE"))== 0) /* %TYPEBASE */ - { PTR_TYPE type; - Op->typ = INTEGER_TYP; - if (NODE_SYMB(ll)) - type = SYMB_TYPE( NODE_SYMB (ll)); - else - type = NULL; - if (type && (TYPE_CODE(type) == T_ARRAY)) - { - type = Find_BaseType(type); - } - Op->val.I = (long) type; - *iptr += strlen("%TYPEBASE"); - - } else - { - Message (" *** Unknown operand in %IF (condition) for LL Node *** ",0); - } -} - - -void Get_Bif_Operand (str, iptr, bif,Op) - char *str; - int *iptr; - PTR_BFND bif; - operand *Op; -{ - - Op->typ = UNDEF_TYP; - if (strncmp(&(str[*iptr]),"%ELSIFBLOB2", strlen("%ELSIFBLOB2"))== 0) - { - Op->typ = INTEGER_TYP; - *iptr += strlen("%ELSIFBLOB2"); - if (BIF_BLOB2(bif) && (BIF_CODE(BLOB_VALUE(BIF_BLOB2(bif))) == ELSEIF_NODE)) - Op->val.I = 1; - else - Op->val.I = 0; - } else - if (strncmp(&(str[*iptr]),"%ELSWHBLOB2", strlen("%ELSWHBLOB2"))== 0) - { - Op->typ = INTEGER_TYP; - *iptr += strlen("%ELSWHBLOB2"); - if (BIF_BLOB2(bif) && (BIF_CODE(BLOB_VALUE(BIF_BLOB2(bif))) == ELSEWH_NODE)) - Op->val.I = 1; - else - Op->val.I = 0; - } else - if (strncmp(&(str[*iptr]),"%LABEL", strlen("%LABEL"))== 0) - { - Op->typ = INTEGER_TYP; - *iptr += strlen("%LABEL"); - Op->val.I = (long) BIF_LABEL(bif); - } else - if (strncmp(&(str[*iptr]),"%CHECKFLAG", strlen("%CHECKFLAG"))== 0) - { - Op->typ = INTEGER_TYP; - *iptr += strlen("%CHECKFLAG"); - Op->val.I = Get_Flag_val(str, iptr); - } else - if (strncmp(&(str[*iptr]),"%BLOB1", strlen("%BLOB1"))== 0) - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_BLOB1(bif); - *iptr += strlen("%BLOB1"); - } else - if (strncmp(&(str[*iptr]),"%BLOB2", strlen("%BLOB2"))== 0) - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_BLOB2(bif); - *iptr += strlen("%BLOB2"); - } else - if (strncmp(&(str[*iptr]),"%BIFCP", strlen("%BIFCP"))== 0) - { - Op->typ = INTEGER_TYP; - if (BIF_CP(bif)) - Op->val.I = BIF_CODE(BIF_CP(bif)); - else - Op->val.I = 0; - *iptr += strlen("%BIFCP"); - - } else - if (strncmp(&(str[*iptr]),"%CPBIF", strlen("%CPBIF"))== 0) - { - Op->typ = INTEGER_TYP; - if (BIF_CP(bif) && BIF_CP(BIF_CP(bif))) - Op->val.I = BIF_CODE(BIF_CP(BIF_CP(bif))); - else - Op->val.I = 0; - *iptr += strlen("%CPBIF"); - - } else - if (strncmp(&(str[*iptr]),"%VALINT", strlen("%VALINT"))== 0) - { - Op->typ = INTEGER_TYP; - Op->val.I = atoi(&(str[*iptr + strlen("%VALINT")])); /* %VALINT-12232323 space is necessary after the number*/ - /* skip to next statement */ - while (str[*iptr] != ' ') (*iptr)++; - } else - if (strncmp(&(str[*iptr]),"%RECURSBIT", strlen("%RECURSBIT"))== 0) /* %RECURSBIT : Symbol Attribut (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = RECURSIVE_BIT; - *iptr += strlen("%RECURSBIT"); - } else - if (strncmp(&(str[*iptr]),"%EXPR_LIST", strlen("%EXPR_LIST"))== 0) /* %EXPR_LIST : int constant EXPR_LIST code for Low Level Node (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = EXPR_LIST; - *iptr += strlen("%EXPR_LIST"); - } else - if (strncmp(&(str[*iptr]),"%SPEC_PAIR", strlen("%SPEC_PAIR"))== 0) /* %SPEC_PAIR : int constant SPEC_PAIR code for Low Level Node (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = SPEC_PAIR; - *iptr += strlen("%SPEC_PAIR"); - } else - if (strncmp(&(str[*iptr]),"%IOACCESS", strlen("%IOACCESS"))== 0) /* %IOACCESS : int constant IOACCESS code for Low Level Node (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = IOACCESS; - *iptr += strlen("%IOACCESS"); - } else - if (strncmp(&(str[*iptr]),"%STRCST", strlen("%STRCST"))== 0) /* %STRCST : String Constant */ - { - int i_save; - - *iptr += strlen("%STRCST"); - while (str[*iptr] == ' ') {(*iptr)++;} /* skip spaces before string */ - if (str[*iptr] != '\'') - { - Message (" *** Missing \"'\" after %STRCST *** ",0); - } - i_save = ++(*iptr); - while ((str[*iptr] != '\0') && (str[*iptr] != '\'')) (*iptr)++; - Op->val.S = alloc_str ((*iptr) - i_save); - strncpy (Op->val.S, &(str[i_save]), (*iptr) - i_save); - Op->typ = STRING_TYP; - (*iptr)++; /* skip the ' */ - } else - if (strncmp(&(str[*iptr]),"%SYMBOL", strlen("%SYMBOL"))== 0) /* %SYMBOL : Symbol pointer (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_SYMB (bif); - *iptr += strlen("%SYMBOL"); - } else - if (strncmp(&(str[*iptr]),"%SATTR", strlen("%SATTR"))== 0) /* %SATTR : Symbol Attribut (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (BIF_SYMB (bif))->attr; - *iptr += strlen("%SATTR"); - } else - if (strncmp(&(str[*iptr]),"%SYMBID", strlen("%SYMBID"))== 0) /* %SYMBID : Symbol identifier (string) */ - { - Op->typ = STRING_TYP; - if (BIF_SYMB (bif)) - Op->val.S = SYMB_IDENT (BIF_SYMB (bif)); - else - Op->val.S = NULL; - *iptr += strlen("%SYMBID"); - } else - if (strncmp(&(str[*iptr]),"%NULL", strlen("%NULL"))== 0) /* %NULL : Integer Constant (or false boolean) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = 0; - *iptr += strlen("%NULL"); - } else - if (strncmp(&(str[*iptr]),"%LL1", strlen("%LL1"))== 0) /* %LL1 : Low Level Node 1 (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_LL1 (bif); - *iptr += strlen("%LL1"); - } else - if (strncmp(&(str[*iptr]),"%LL2", strlen("%LL2"))== 0) /* %LL2 : Low Level Node 2 (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_LL2 (bif); - *iptr += strlen("%LL2"); - } else - if (strncmp(&(str[*iptr]),"%LL3", strlen("%LL3"))== 0) /* %LL3 : Low Level Node 3 (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_LL3 (bif); - *iptr += strlen("%LL3"); - } else - if (strncmp(&(str[*iptr]),"%LABUSE", strlen("%LABUSE"))== 0) /* %LABUSE : label ptr (used for do : doend) (integer) */ - { - Op->typ = INTEGER_TYP; - Op->val.I = (long) BIF_LABEL_USE (bif); - *iptr += strlen("%LABUSE"); - } else - if (strncmp(&(str[*iptr]),"%L1CODE", strlen("%L1CODE"))== 0) /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ - { - Op->typ = INTEGER_TYP; - if (BIF_LL1 (bif)) - Op->val.I = NODE_CODE (BIF_LL1 (bif)); - else - Op->val.I = 0; - *iptr += strlen("%L1CODE"); - } else - if (strncmp(&(str[*iptr]),"%L2CODE", strlen("%L2CODE"))== 0) /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ - { - Op->typ = INTEGER_TYP; - if (BIF_LL2 (bif)) - Op->val.I = NODE_CODE (BIF_LL2 (bif)); - else - Op->val.I = 0; - *iptr += strlen("%L2CODE"); - } else - if (strncmp(&(str[*iptr]),"%L1L2L1CODE", strlen("%L1L2L1CODE"))== 0) /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ - { - Op->typ = INTEGER_TYP; - if (BIF_LL1 (bif) && NODE_TEMPLATE_LL2 (BIF_LL1 (bif)) && NODE_TEMPLATE_LL1 (NODE_TEMPLATE_LL2 (BIF_LL1 (bif)))) - Op->val.I = NODE_CODE (NODE_TEMPLATE_LL1 (NODE_TEMPLATE_LL2 (BIF_LL1 (bif)))); - else - Op->val.I = 0; - *iptr += strlen("%L1L2L1CODE"); - } else - if (strncmp(&(str[*iptr]),"%L1L2*L1CODE", strlen("%L1L2*L1CODE"))== 0) /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ - { - PTR_LLND temp; - - Op->typ = INTEGER_TYP; - if (BIF_LL1 (bif) && NODE_TEMPLATE_LL2 (BIF_LL1 (bif)) && NODE_TEMPLATE_LL1 (NODE_TEMPLATE_LL2 (BIF_LL1 (bif)))) - { - temp = BIF_LL1 (bif); - while (NODE_OPERAND1(temp)) temp = NODE_OPERAND1(temp); - if (NODE_TEMPLATE_LL1 (temp)) - Op->val.I = NODE_CODE (NODE_TEMPLATE_LL1 (temp)); - else - Op->val.I = 0; - } - else - Op->val.I = 0; - *iptr += strlen("%L1L2*L1CODE"); - } else - if (strncmp(&(str[*iptr]),"%L2L1STR", strlen("%L2L1STR"))== 0) /* %L2L1STR : String (string_val) of Low Level Node 1 of Low Level Node 2 (string) */ - { - Op->typ = STRING_TYP; - if (BIF_LL2 (bif) && NODE_TEMPLATE_LL1 (BIF_LL2 (bif))) - Op->val.S = NODE_STR (NODE_TEMPLATE_LL1 (BIF_LL2 (bif))); - else - Op->val.S = NULL; - *iptr += strlen("%L2L1STR"); - - } else - { - Message (" *** Unknown operand in %IF (condition) for Bif Node *** ",0); - } -} - - -int -GetComp (str, iptr) - char *str; - int *iptr; -{ - int Comp; - - if (strncmp(&(str[*iptr]),"==", strlen("==")) == 0) /* == : Equal */ - { - Comp = COMP_EQUAL; - *iptr += strlen("=="); - } else - if (strncmp(&(str[*iptr]),"!=", strlen("!=")) == 0) /* != : Different */ - { - Comp = COMP_DIFF; - *iptr += strlen("!="); - } else - { - Message (" *** Unknown comparison operator in %IF (condition) *** ",0); - Comp = COMP_UNDEF; - } - return Comp; -} - -int -Eval_Type_Condition(str, ptype) - char *str; - PTR_TYPE ptype; -{ - int Result = 0; - int i = 0; - operand Op1, Op2; - int Comp; - - while (str[i] == ' ') {i++;} /* skip spaces before '(condition)' */ - if (str[i++] != '(') - { - Message (" *** Missing (condition) after %IF *** ",0); - - return 0; - } else - while (str[i] == ' ') {i++;} /* skip spaces before first operand */ - Get_Type_Operand(str, &i, ptype, &Op1); - while (str[i] == ' ') {i++;} /* skip spaces before the comparison operator */ - Comp = GetComp(str, &i); - while (str[i] == ' ') {i++;} /* skip spaces before second operand */ - Get_Type_Operand(str, &i, ptype, &Op2); - while (str[i] == ' ') {i++;} /* skip spaces before the closing round bracket */ - if (str[i] != ')') - { - Message (" *** Missing ')' after %IF (condition *** ",0); - return i; - } else - i++; - if ((Op1.typ != UNDEF_TYP) && (Op1.typ == Op2.typ) && (Comp !=COMP_UNDEF)) - { - switch (Op1.typ) - { - case STRING_TYP : Result = strcmp (Op1.val.S, Op2.val.S); - break; - case INTEGER_TYP : Result = Op1.val.I - Op2.val.I; - break; - } - if (Comp == COMP_EQUAL) Result = !Result; - if (Result) return i; /* continue from here to the corresponding %ELSE if exists */ - else /* continue at the corresponding %ELSE */ - { - int ifcount_local = 1; - while (str[i]) - { - while (str[i] != '%') { - if (str[i]) i++; - else return i; - } - i++; - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ - { - ifcount_local++; - i += strlen("IF"); - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ - { - ifcount_local--; - i += strlen("ENDIF"); - if (ifcount_local == 0) return i; - } else - if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* Counts %ELSE ; stop skipping if corresponding*/ - { - i += strlen("ELSE"); - if (ifcount_local == 1) return i; - } - } - return i; - } - } else - { - Message (" *** Error in condition for %IF command *** 1",0); - return i; - } -} - - -int -Eval_LLND_Condition(str, ll) - char *str; - PTR_LLND ll; -{ - int Result = 0; - int i = 0; - operand Op1, Op2; - int Comp = 0; - - while (str[i] == ' ') {i++;} /* skip spaces before '(condition)' */ - if (str[i++] != '(') - { - Message (" *** Missing (condition) after %IF *** ",0); - return 0; - } else - while (str[i] == ' ') {i++;} /* skip spaces before first operand */ - Get_LL_Operand(str, &i, ll, &Op1); - while (str[i] == ' ') {i++;} /* skip spaces before the comparison operator */ - Comp = GetComp(str, &i); - while (str[i] == ' ') {i++;} /* skip spaces before second operand */ - Get_LL_Operand(str, &i, ll, &Op2); - while (str[i] == ' ') {i++;} /* skip spaces before the closing round bracket */ - if (str[i] != ')') - { - Message (" *** Missing ')' after %IF (condition *** ",0); - i++; - return i; - } else - i++; - - if ((Op1.typ != UNDEF_TYP) && (Op1.typ == Op2.typ) && (Comp != COMP_UNDEF)) - { - switch (Op1.typ) - { - case STRING_TYP : Result = strcmp (Op1.val.S, Op2.val.S); - break; - case INTEGER_TYP : Result = Op1.val.I - Op2.val.I; - break; - } - if (Comp == COMP_EQUAL) Result = !Result; - if (Result) return i; /* continue from here to the corresponding %ELSE if exists */ - else /* continue at the corresponding %ELSE */ - { - int ifcount_local = 1; - while (str[i]) - { - while (str[i] != '%') { - if (str[i]) i++; - else return i; - } - i++; - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ - { - ifcount_local++; - i += strlen("IF"); - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ - { - ifcount_local--; - i += strlen("ENDIF"); - if (ifcount_local == 0) return i; - } else - if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* Counts %ELSE ; stop skipping if corresponding*/ - { - i += strlen("ELSE"); - if (ifcount_local == 1) return i; - } - } - return i; - } - } else - { - Message (" *** Error in condition for %IF command *** 2",0); - return i; - } -} - - -int -Eval_Bif_Condition(str, bif) - char *str; - PTR_BFND bif; -{ - int Result = 0; - int i = 0; - operand Op1, Op2; - int Comp; - - while (str[i] == ' ') {i++;} /* skip spaces before '(condition)' */ - if (str[i++] != '(') - { - Message (" *** Missing (condition) after %IF *** ",0); - return 0; - } else - while (str[i] == ' ') {i++;} /* skip spaces before first operand */ - Get_Bif_Operand(str, &i, bif, &Op1); - while (str[i] == ' ') {i++;} /* skip spaces before the comparison operator */ - Comp = GetComp(str, &i); - while (str[i] == ' ') {i++;} /* skip spaces before second operand */ - Get_Bif_Operand(str, &i, bif, &Op2); - while (str[i] == ' ') {i++;} /* skip spaces before the closing round bracket */ - - if (str[i] != ')') - { - Message (" *** Missing ')' after %IF (condition *** ",0); - return i; - } else - i++; - if ((Op1.typ != UNDEF_TYP) && (Op1.typ == Op2.typ) && (Comp != COMP_UNDEF)) - { - switch (Op1.typ) - { - case STRING_TYP : Result = strcmp (Op1.val.S, Op2.val.S); - break; - case INTEGER_TYP : Result = Op1.val.I - Op2.val.I; - break; - } - if (Comp == COMP_EQUAL) Result = !Result; - if (Result) return i; /* continue from here to the corresponding %ELSE if exists */ - else /* continue at the corresponding %ELSE */ - { - int ifcount_local = 1; - while (str[i]) - { - while (str[i] != '%') { - if (str[i]) i++; - else return i; - } - i++; - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ - { - ifcount_local++; - i += strlen("IF"); - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ - { - ifcount_local--; - i += strlen("ENDIF"); - if (ifcount_local == 0) return i; - } else - if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* Counts %ELSE ; stop skipping if corresponding*/ - { - i += strlen("ELSE"); - if (ifcount_local == 1) return i; - } - } - return i; - } - } else - { - Message (" *** Error in condition for %IF command *** 3",0); - return i; - } -} - - -int -SkipToEndif (str) - char *str; -{ - int ifcount_local = 1; - int i = 0; - - while (str[i]) - { - while (str[i] != '%') { - if (str[i]) i++; - else return i; - } - i++; - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ - { - ifcount_local++; - i += strlen("IF"); - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ - { - ifcount_local--; - i += strlen("ENDIF"); - if (ifcount_local == 0) return i; - } - } - return i; -} - -char *Tool_Unparse2_LLnode (); - -char * -Tool_Unparse_Type (ptype) - PTR_TYPE ptype; - /*int def;*/ /* def = 1 : defined type*/ - /* def = 0 : named type */ -{ - int variant; - int kind; - char *str; - char c; - int i; - - if (!ptype) - return NULL; - - variant = TYPE_CODE (ptype); - kind = (int) node_code_kind [(int) variant]; - if (kind != (int)TYPENODE) - Message ("Error in Unparse, not a type node", 0); - - str = Unparse_Def [variant].str; - - /* now we have to interpret the code to unparse it */ - - if (str == NULL) - return NULL; - if (strcmp ( str, "n") == 0) - { - Message("Node not define for unparse",0); - return NULL; - } - - - i = 0 ; - c = str[i]; - while (c != '\0') - { - if (c == '%') - { - i++; - c = str[i]; - /******** WE HAVE TO INTERPRET THE COMMAND *********/ - if (c == '%') /* %% : Percent Sign */ - { - BufPutString ("%",0); - i++; - } else - if (strncmp(&(str[i]),"ERROR", strlen("ERROR"))== 0) /* %ERROR : Generate error message */ - { - Message("Error Node not defined",0); - BufPutInt(variant); - BufPutString ("-----TYPE ERROR--------",0); - i += strlen("ERROR"); - } else - if (strncmp(&(str[i]),"NL", strlen("NL"))== 0) /* %NL : NewLine */ - { - /*int j;*/ /* podd 15.03.99*/ - BufPutChar ('\n'); -/* for (j = 0; j < TabNumber; j++) - if (j>1) - BufPutString (" ",0); - else - BufPutString (" ",0);*/ - i += strlen("NL"); - } else - if (strncmp(&(str[i]),"NOTABNL", strlen("NOTABNL"))== 0) /* %NL : NewLine */ - { - BufPutChar ('\n'); - i += strlen("NOTABNL"); - } else - if (strncmp(&(str[i]),"RIDPT", strlen("RIDPT"))== 0) - { /*int j;*/ /* podd 15.03.99*/ - DealWith_Rid(ptype,In_Class_Flag); - i += strlen("RIDPT"); - } else - if (strncmp(&(str[i]),"TABNAME", strlen("TABNAME"))== 0) /* %TABNAME : Self Name from Table */ - { - if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - BufPutString (ftype_name [type_index (TYPE_CODE (ptype))],0); - else - { - BufPutString (ctype_name [type_index (TYPE_CODE (ptype))],0); - } - i += strlen("TABNAME"); - } else - if (strncmp(&(str[i]),"TAB", strlen("TAB"))== 0) /* %TAB : Tab */ - { - BufPutString (" ",0); /* cychen */ - i += strlen("TAB"); - } else - if (strncmp(&(str[i]),"SETFLAG", strlen("SETFLAG"))== 0) - { - i = i + strlen("SETFLAG"); - Treat_Flag(str, &i,1); - } else - if (strncmp(&(str[i]),"UNSETFLAG", strlen("UNSETFLAG"))== 0) - { - i = i + strlen("UNSETFLAG"); - Treat_Flag(str, &i,-1); - } else - if (strncmp(&(str[i]),"PUSHFLAG", strlen("PUSHFLAG"))== 0) - { - i = i + strlen("PUSHFLAG"); - PushPop_Flag(str, &i,1); - } else - if (strncmp(&(str[i]),"POPFLAG", strlen("POPFLAG"))== 0) - { - i = i + strlen("POPFLAG"); - PushPop_Flag(str, &i,-1); - } else - if (strncmp(&(str[i]),"PUTTAB", strlen("PUTTAB"))== 0) /* %TAB : Tab */ - { - int j, k; - - if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - for (j = 0; j < TabNumber; j++) - if (j>0) - BufPutString (" ",0); - else { - for (k=0; k<6; k++) { - if (HasLabel == 0) - BufPutString (" ",0); /* cychen */ - HasLabel = HasLabel/10; - }; - } - else - for (j = 0; j < TabNumber; j++) - if (j>0) - BufPutString (" ",0); - else - BufPutString (" ",0); /* cychen */ - - i += strlen("PUTTAB"); - - } else - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - { - i += strlen("IF"); - i += Eval_Type_Condition(&(str[i]), ptype); - } else - if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* %ELSE : Else */ - { - i += strlen("ELSE"); - i += SkipToEndif(&(str[i])); /* skip to the corresponding endif */ - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* %ENDIF : End of If */ - { - i += strlen("ENDIF"); - } else - if (strncmp(&(str[i]),"SUBTYPE", strlen("SUBTYPE"))== 0) /* %SUBTYPE : find the next type for (CAST) */ - { - PTR_TYPE pt; - pt = TYPE_BASE(ptype); - if(pt) Tool_Unparse_Type(pt); - i += strlen("SUBTYPE"); - } else - if (strncmp(&(str[i]),"BASETYPE", strlen("BASETYPE"))== 0) /* %BASETYPE : Base Type Name Identifier */ - { - if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - BufPutString (ftype_name [type_index (TYPE_CODE (TYPE_BASE (ptype)))],0); - else - { - PTR_TYPE pt; - pt = Find_BaseType(ptype); - if (pt) - { - Tool_Unparse_Type(pt); - } else{ - /* printf("offeding node type node: %d\n", ptype->id); - Message("basetype not found",0); - */ - } - } - i += strlen("BASETYPE"); - } else - - if (strncmp(&(str[i]),"FBASETYPE", strlen("FBASETYPE"))== 0) /* %FBASETYPE : Base Type Name Identifier */ - { - PTR_TYPE pt; - pt = Find_BaseType2(ptype); - if (pt) - { - Tool_Unparse_Type(pt); - } else{ - /* printf("offeding node type node: %d\n", ptype->id); - Message("basetype not found",0); - */ - } - i += strlen("FBASETYPE"); - } else - - - if (strncmp(&(str[i]),"STAR", strlen("STAR"))== 0) - { - PTR_TYPE pt; - int flg; - pt = ptype; - /* while (pt) */ - { - if (TYPE_CODE(pt) == T_POINTER){ - BufPutString ("*",0); - flg = pt->entry.Template.dummy5; - if(flg & BIT_RESTRICT) BufPutString(" restrict ",0); - if(flg & BIT_CONST) BufPutString(" const ",0); - if(flg & BIT_GLOBL) BufPutString(" global ",0); - if(flg & BIT_SYNC) BufPutString(" Sync ",0); - if(flg & BIT_VOLATILE) BufPutString(" volatile ",0); - } - else - if (TYPE_CODE(pt) == T_REFERENCE){ - BufPutString ("&",0); - flg = pt->entry.Template.dummy5; - if(flg & BIT_RESTRICT) BufPutString(" restrict ",0); - if(flg & BIT_CONST) BufPutString(" const ",0); - if(flg & BIT_GLOBL) BufPutString(" global ",0); - if(flg & BIT_SYNC) BufPutString(" Sync ",0); - if(flg & BIT_VOLATILE) BufPutString(" volatile ",0); - } - /* else - break; - if(TYPE_CODE(pt) == T_MEMBER_POINTER) - pt = TYPE_COLL_BASE(pt); - else pt = TYPE_BASE(pt); */ - } - i += strlen("STAR"); - } else - if (strncmp(&(str[i]),"RANGES", strlen("RANGES"))== 0) /* %RANGES : Ranges */ - { - Tool_Unparse2_LLnode (TYPE_RANGES (ptype)); - if(TYPE_KIND_LEN(ptype)){ - BufPutString("(",0); - Tool_Unparse2_LLnode (TYPE_KIND_LEN(ptype)); - BufPutString(")",0); - } - i += strlen("RANGES"); - } else - if (strncmp(&(str[i]),"NAMEID", strlen("NAMEID"))== 0) /* %NAMEID : Name Identifier */ - { - if (ptype->name) - BufPutString ( ptype->name->ident,0); - else - { - BufPutString ("-------TYPE ERROR (NAMEID)------",0); - } - i += strlen("NAMEID"); - } else - if (strncmp(&(str[i]),"SYMBID", strlen("SYMBID"))== 0) /* %NAMEID : Name Identifier */ - { - if (TYPE_SYMB_DERIVE(ptype)){ - PTR_SYMB cname; - cname = TYPE_SYMB_DERIVE(ptype); - if(TYPE_CODE(ptype) == T_DERIVED_TYPE){ - if((SYMB_CODE(cname) == STRUCT_NAME) && (SYMB_TYPE(cname) == NULL) - &&(BIF_CODE(SYMB_SCOPE(cname)) == GLOBAL)) - BufPutString("struct ", 0); - if((SYMB_CODE(cname) == CLASS_NAME) && (SYMB_TYPE(cname) == NULL) - &&(BIF_CODE(SYMB_SCOPE(cname)) == GLOBAL)) - BufPutString("class ", 0); - if((SYMB_CODE(cname) == UNION_NAME) && (SYMB_TYPE(cname) == NULL) - &&(BIF_CODE(SYMB_SCOPE(cname)) == GLOBAL)) - BufPutString("union ", 0); - } - if(TYPE_SCOPE_SYMB_DERIVE(ptype) && TYPE_CODE(ptype) != T_DERIVED_TEMPLATE && TYPE_CODE(ptype) != T_DERIVED_COLLECTION) { - Tool_Unparse_Symbol(TYPE_SCOPE_SYMB_DERIVE(ptype)); - BufPutString("::",0); - } - Tool_Unparse_Symbol(cname); - } - else if(TYPE_CODE(ptype) == T_MEMBER_POINTER) - Tool_Unparse_Symbol(TYPE_COLL_NAME(ptype)); - else - { - printf("node = %d, variant = %d\n",TYPE_ID(ptype), TYPE_CODE(ptype)); - BufPutString ("-------TYPE ERROR (ISYMBD)------",0); - } - i += strlen("SYMBID"); - } else - if (strncmp(&(str[i]),"RANGLL1", strlen("RANGLL1"))== 0) /* %RANGLL1 : Low Level Node 1 of Ranges */ - { - if (TYPE_RANGES (ptype)) - Tool_Unparse2_LLnode (NODE_TEMPLATE_LL1 (TYPE_RANGES (ptype))); - i += strlen("RANGLL1"); - } else - if (strncmp(&(str[i]),"COLLBASE", strlen("COLLBASE"))== 0) /* %COLL BASE */ - { - if (TYPE_COLL_BASE(ptype)) - Tool_Unparse_Type(TYPE_COLL_BASE(ptype)); - i += strlen("COLLBASE"); - } else - if (strncmp(&(str[i]),"TMPLARGS", strlen("TMPLARGS"))== 0) /* %RANGLL1 : Low Level Node 1 of Ranges */ - { - if (TYPE_TEMPL_ARGS(ptype)) - Tool_Unparse2_LLnode(TYPE_TEMPL_ARGS(ptype)); - i += strlen("TMPLARGS"); - } else - Message (" *** Unknown type node COMMAND *** ",0); - } - - else - { - BufPutChar (c); - i++; - } - c = str[i]; - } - return Buf_address; -} - - -char * -Tool_Unparse2_LLnode(ll) - PTR_LLND ll; -{ - int variant; - int kind; - char *str; - char c; - int i; - - if (!ll) - return NULL; - - variant = NODE_CODE (ll); - kind = (int) node_code_kind[(int) variant]; - if (kind != (int)LLNODE) - { - Message("Error in Unparse, not a llnd node",0); - BufPutInt(variant); - BufPutString ("------ERROR--------",0); - return NULL; - } - - str = Unparse_Def[variant].str; - - /* now we have to interpret the code to unparse it */ - - if (str == NULL) - return NULL; - if (strcmp( str, "n") == 0) - return NULL; - - i = 0 ; - c = str[i]; - while (c != '\0') - { - if (c == '%') - { - i++; - c = str[i]; - /******** WE HAVE TO INTERPRET THE COMMAND *********/ - if (c == '%') /* %% : Percent Sign */ - { - BufPutString ("%",0); - i++; - } else - if (strncmp(&(str[i]),"ERROR", strlen("ERROR"))== 0) /* %ERROR : Generate error message */ - { - Message ("--- unparsing error[0] : ",0); - BufPutInt(variant); - BufPutString ("------ERROR--------",0); - i += strlen("ERROR"); - } else - if (strncmp(&(str[i]),"NL", strlen("NL"))== 0) /* %NL : NewLine */ - { - /* int j;*/ /* podd 15.03.99*/ - BufPutChar ('\n'); -/* for (j = 0; j < TabNumber; j++) - if (j>1) - BufPutString (" ",0); - else - BufPutString (" ",0);*/ - i += strlen("NL"); - } else - if (strncmp(&(str[i]),"TAB", strlen("TAB"))== 0) /* %TAB : Tab */ - { - BufPutString (" ",0); /* cychen */ - i += strlen("TAB"); - } else - if (strncmp(&(str[i]),"DELETE_COMMA", strlen("DELETE_COMMA"))== 0) /* %DELETE_COMMA : , */ - { - if (Buf_address[Buf_pointer-1]==',') - { - Buf_address[Buf_pointer-1]=' '; - Buf_pointer--; - } - i += strlen("DELETE_COMMA"); - } else - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - { - i += strlen("IF"); - i += Eval_LLND_Condition(&(str[i]), ll); - } else - if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* %ELSE : Else */ - { - i += strlen("ELSE"); - i += SkipToEndif(&(str[i])); /* skip to the corresponding endif */ - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* %ENDIF : End of If */ - { - i += strlen("ENDIF"); - } else - if (strncmp(&(str[i]),"LL1", strlen("LL1"))== 0) /* %LL1 : Low Level Node 1 */ - { - Tool_Unparse2_LLnode(NODE_TEMPLATE_LL1(ll)); - i += strlen("LL1"); - } else - if (strncmp(&(str[i]),"LL2", strlen("LL2"))== 0) /* %LL2 : Low Level Node 2 */ - { - Tool_Unparse2_LLnode(NODE_TEMPLATE_LL2(ll)); - i += strlen("LL2"); - } else - if (strncmp(&(str[i]),"SYMBID", strlen("SYMBID"))== 0) /* %SYMBID : Symbol identifier */ - { - Tool_Unparse_Symbol (NODE_SYMB (ll)); - i += strlen("SYMBID"); - } else - if (strncmp(&(str[i]),"DOPROC", strlen("DOPROC"))== 0) /* for subclass qualification */ - { int flg; - if(NODE_TYPE(ll) && (NODE_CODE(NODE_TYPE(ll)) == T_DESCRIPT)){ - flg = (NODE_TYPE(ll))->entry.Template.dummy5; - if(flg & BIT_VIRTUAL) BufPutString(" virtual ",0); - if(flg & BIT_ATOMIC) BufPutString(" atomic ",0); - if(flg & BIT_PRIVATE) BufPutString(" private ",0); - if(flg & BIT_PROTECTED) BufPutString(" protected ",0); - if(flg & BIT_PUBLIC) BufPutString(" public ",0); - } - else BufPutString(" public ", 0); - /* note: this last else condition is to fix a bug in - the dep2C++ which does not create the right types - when converting a collection to a class. - */ - i += strlen("DOPROC"); - } else - if (strncmp(&(str[i]),"TYPE", strlen("TYPE"))== 0) /* %TYPE : Type */ - { - if(NODE_SYMB(ll) && (SYMB_ATTR(NODE_SYMB(ll)) & OVOPERATOR)){ - /* this is an overloaded operator. don't do type */ - } - else{ Tool_Unparse_Type (NODE_TYPE (ll)); } - i += strlen("TYPE"); - } else - if (strncmp(&(str[i]),"L1SYMBCST", strlen("L1SYMBCST"))== 0) /* %L1SYMBCST : Constant Value of Low Level Node Symbol */ - { - if (NODE_TEMPLATE_LL1 (ll) && NODE_SYMB (NODE_TEMPLATE_LL1 (ll))) - { - Tool_Unparse2_LLnode((NODE_SYMB (NODE_TEMPLATE_LL1 (ll)))->entry.const_value); - } - i += strlen("L1SYMBCST"); - } else - if (strncmp(&(str[i]),"INTKIND", strlen("INTKIND"))== 0) /* %INTKIND : Integer Value */ - { PTR_LLND kind; - if (NODE_INT_CST_LOW (ll) < 0) - BufPutString ("(",0); - BufPutInt (NODE_INT_CST_LOW (ll)); - if( ( kind=TYPE_KIND_LEN(NODE_TYPE(ll)) ) ) { - BufPutString ("_",0); - Tool_Unparse2_LLnode(kind); - } - if (NODE_INT_CST_LOW (ll) < 0) - BufPutString (")",0); - - i += strlen("INTKIND"); - } else - if (strncmp(&(str[i]),"STATENO", strlen("STATENO"))== 0) /* %STATENO : Statement number */ - { - if (NODE_LABEL (ll)) - { - BufPutInt ( LABEL_STMTNO (NODE_LABEL (ll))); - } - i += strlen("STATENO"); - } else - if (strncmp(&(str[i]),"LABELNAME", strlen("LABELNAME"))== 0) /* %LABELNAME : Statement label *//*podd 06.01.13*/ - { - if (NODE_LABEL (ll)) - { - BufPutString ( SYMB_IDENT(LABEL_SYMB (NODE_LABEL (ll))),0); - } - i += strlen("LABELNAME"); - } else - if (strncmp(&(str[i]),"KIND", strlen("KIND"))== 0) /* %KIND : KIND parameter */ - { PTR_LLND kind; - if( ( kind=TYPE_KIND_LEN(NODE_TYPE(ll)) ) ) { - BufPutString ("_",0); - Tool_Unparse2_LLnode(kind); - } - i += strlen("KIND"); - } else - if (strncmp(&(str[i]),"STRKIND", strlen("STRKIND"))== 0) /* %STRKIND : KIND parameter of String Value */ - { PTR_LLND kind; - if( ( kind=TYPE_KIND_LEN(NODE_TYPE(ll)) ) ) { - Tool_Unparse2_LLnode(kind); - BufPutString ("_",0); - } - i += strlen("STRKIND"); - } else - if (strncmp(&(str[i]),"SYMQUOTE", strlen("SYMQUOTE"))== 0) /* %SYMQUOTE : first Symbol of String Value:" or ' */ - { - if( ( TYPE_QUOTE(NODE_TYPE(ll)) == 2 ) ) { - BufPutChar ('\"'); - } else - BufPutChar ('\''); - i += strlen("SYMQUOTE"); - - } else - if (strncmp(&(str[i]),"STRVAL", strlen("STRVAL"))== 0) /* %STRVAL : String Value */ - { - BufPutString (NODE_STR (ll),0); - i += strlen("STRVAL"); - } else - if (strncmp(&(str[i]),"STMTSTR", strlen("STMTSTR"))== 0) /* %STMTSTR : String Value */ - { - BufPutString (unparse_stmt_str(NODE_STR (ll)),0); - i += strlen("STMTSTR"); - } else - - if (strncmp(&(str[i]),"BOOLVAL", strlen("BOOLVAL"))== 0) /* %BOOLVAL : String Value */ - { - BufPutString (NODE_BV (ll) ? ".TRUE." : ".FALSE.",0); - i += strlen("BOOLVAL"); - } else - if (strncmp(&(str[i]),"CHARVAL", strlen("CHARVAL"))== 0) /* %CHARVAL : Char Value */ - { - switch(NODE_CV(ll)){ - case '\n':BufPutChar('\\'); BufPutChar('n'); break; - case '\t':BufPutChar('\\'); BufPutChar('t'); break; - case '\r':BufPutChar('\\'); BufPutChar('r'); break; - case '\f':BufPutChar('\\'); BufPutChar('f'); break; - case '\b':BufPutChar('\\'); BufPutChar('b'); break; - case '\a':BufPutChar('\\'); BufPutChar('a'); break; - case '\v':BufPutChar('\\'); BufPutChar('v'); break; - default: - BufPutChar (NODE_CV (ll)); - } - i += strlen("CHARVAL"); - } else - if (strncmp(&(str[i]),"ORBCPL1", strlen("ORBCPL1"))== 0) /* %ORBCPL1 : Openning Round Brackets on Precedence of Low Level Node 1 for C++*/ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - if (C_op (llvar) && (precedence_C [variant - EQ_OP] < precedence_C [llvar - EQ_OP])) - BufPutString ("(",0); - i += strlen("ORBCPL1"); - } else - if (strncmp(&(str[i]),"CRBCPL1", strlen("CRBCPL1"))== 0) /* %CRBCPL1 : Closing Round Brackets on Precedence of Low Level Node 1 for C++ */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - if (C_op (llvar) && (precedence_C [variant - EQ_OP] < precedence_C [llvar - EQ_OP])) - BufPutString (")",0); - i += strlen("CRBCPL1"); - } else - if (strncmp(&(str[i]),"ORBCPL2", strlen("ORBCPL2"))== 0) /* %ORBCPL2 : Openning Round Brackets on Precedence of Low Level Node 2 for C++ */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - if (C_op (llvar) && (precedence_C [variant - EQ_OP] <= precedence_C [llvar - EQ_OP])) - BufPutString ("(",0); - i += strlen("ORBCPL2"); - } else - if (strncmp(&(str[i]),"CRBCPL2", strlen("CRBCPL2"))== 0) /* %CRBCPL2 : Closing Round Brackets on Precedence of Low Level Node 2 for C++ */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - if (C_op (llvar) && (precedence_C [variant - EQ_OP] <= precedence_C [llvar - EQ_OP])) - BufPutString (")",0); - i += strlen("CRBCPL2"); - } else - if (strncmp(&(str[i]),"ORBPL1EXP", strlen("ORBPL1EXP"))== 0) /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) - BufPutString ("(",0); - i += strlen("ORBPL1EXP"); - } else - if (strncmp(&(str[i]),"CRBPL1EXP", strlen("CRBPL1EXP"))== 0) /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) - BufPutString (")",0); - i += strlen("CRBPL1EXP"); - } else - if (strncmp(&(str[i]),"ORBPL2EXP", strlen("ORBPL2EXP"))== 0) /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) - BufPutString ("(",0); - i += strlen("ORBPL2EXP"); - } else - if (strncmp(&(str[i]),"CRBPL2EXP", strlen("CRBPL2EXP"))== 0) /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) - BufPutString (")",0); - i += strlen("CRBPL2EXP"); - } else - - if (strncmp(&(str[i]),"ORBPL1", strlen("ORBPL1"))== 0) /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) - BufPutString ("(",0); - i += strlen("ORBPL1"); - } else - if (strncmp(&(str[i]),"CRBPL1", strlen("CRBPL1"))== 0) /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) - BufPutString (")",0); - i += strlen("CRBPL1"); - } else - if (strncmp(&(str[i]),"ORBPL2", strlen("ORBPL2"))== 0) /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) - BufPutString ("(",0); - i += strlen("ORBPL2"); - } else - if (strncmp(&(str[i]),"CRBPL2", strlen("CRBPL2"))== 0) /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ - { - int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); - if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) - BufPutString (")",0); - i += strlen("CRBPL2"); - } else - if (strncmp(&(str[i]),"SETFLAG", strlen("SETFLAG"))== 0) - { - i = i + strlen("SETFLAG"); - Treat_Flag(str, &i,1); - } else - if (strncmp(&(str[i]),"UNSETFLAG", strlen("UNSETFLAG"))== 0) - { - i = i + strlen("UNSETFLAG"); - Treat_Flag(str, &i,-1); - } else - if (strncmp(&(str[i]),"PUSHFLAG", strlen("PUSHFLAG"))== 0) - { - i = i + strlen("PUSHFLAG"); - PushPop_Flag(str, &i,1); - } else - if (strncmp(&(str[i]),"POPFLAG", strlen("POPFLAG"))== 0) - { - i = i + strlen("POPFLAG"); - PushPop_Flag(str, &i,-1); - } else - if (strncmp(&(str[i]),"PURE", strlen("PURE"))== 0) /* for pure function declarations */ - { - PTR_SYMB symb; - symb = NODE_SYMB(ll); - if(symb && (SYMB_TEMPLATE_DUMMY8(symb) & 128)) BufPutString ("= 0",0); - i += strlen("PURE"); - } - else - if (strncmp(&(str[i]),"CNSTF", strlen("CNSTF"))== 0) /* for const functions */ - { - PTR_SYMB symb; - if (NODE_SYMB (ll)){ - symb = BIF_SYMB (ll); - if(SYMB_TEMPLATE_DUMMY8(symb) & 64) BufPutString(" const",0); - } - i += strlen("CNSTF"); - } else - if (strncmp(&(str[i]),"CNSTCHK", strlen("CNSTCHK"))== 0) /* do "const", vol" after * */ - { - int flg; - PTR_TYPE t; - if((t = NODE_TYPE(ll)) &&( (NODE_CODE(t) == T_POINTER) || - (NODE_CODE(t) == T_REFERENCE))){ - flg = t->entry.Template.dummy5; - if(flg & BIT_RESTRICT) BufPutString(" restrict ",0); - if(flg & BIT_CONST) BufPutString(" const ",0); - if(flg & BIT_GLOBL) BufPutString(" global ",0); - if(flg & BIT_SYNC) BufPutString(" Sync ",0); - if(flg & BIT_VOLATILE) BufPutString(" volatile ",0); - } - i += strlen("CNSTCHK"); - } - else - if (strncmp(&(str[i]),"VARLISTTY", strlen("VARLISTTY"))== 0) /* %VARLIST : list of variables / parameters */ - { - PTR_SYMB symb, s; - PTR_LLND args, arg_item = NULL, t; - PTR_TYPE typ; - int new_op_flag; /* 1 if this is a new op */ - new_op_flag = 0; - if(NODE_CODE(ll) == CAST_OP ){ - args = NODE_OPERAND1(ll); - new_op_flag = 1; - } - else if(NODE_CODE(ll) != FUNCTION_OP){ - args = NODE_OPERAND0(ll); - /* symb = SYMB_FUNC_PARAM(NODE_SYMB(ll)); */ - } - else { /* this is a pointer to a function parameter */ - args = NODE_OPERAND1(ll); - t = NODE_OPERAND0(ll); /* node_code(t) == deref_op */ - t = NODE_OPERAND0(t); /* node_code(t) == var_ref */ - s = NODE_SYMB(t); - if(s) symb = SYMB_NEXT(s); - else symb = NULL; - } - while (args ) - { - int typflag; - if(new_op_flag) t = args; - else{ - arg_item = NODE_OPERAND0(args); - t = arg_item; - typflag = 1; - while(t && typflag){ - if((NODE_CODE(t) == VAR_REF) || (NODE_CODE(t) == ARRAY_REF)) - typflag = 0; - else if (NODE_CODE(t) == SCOPE_OP) t = NODE_OPERAND1(t); - else t = NODE_OPERAND0(t); - } - } - if(t){ - symb = NODE_SYMB(t); - typ = NODE_TYPE(t); - if(symb && (typ == NULL)) typ = SYMB_TYPE(symb); - if(new_op_flag || symb ) { - typflag = 1; - while(typ && typflag){ - if(TYPE_CODE(typ) == T_ARRAY || - TYPE_CODE(typ) == T_FUNCTION || - TYPE_CODE(typ) == T_REFERENCE || - TYPE_CODE(typ) == T_POINTER) typ = TYPE_BASE(typ); - else if(TYPE_CODE(typ) == T_MEMBER_POINTER) - typ = TYPE_COLL_BASE(typ); - else typflag = 0; - } - } - if(typ) Tool_Unparse_Type (typ); - BufPutString (" ",0); - } - else printf("unp could not find var ref!\n"); - if(new_op_flag){ - Tool_Unparse2_LLnode(args); - args = LLNULL; - new_op_flag = 0; - } - else{ - Tool_Unparse2_LLnode(arg_item); - args = NODE_OPERAND1(args); - } - if (args) BufPutString (", ",0); - } - i += strlen("VARLISTTY"); - } - else - if (strncmp(&(str[i]),"VARLIST", strlen("VARLIST"))== 0) /* %VARLIST : list of variables / parameters */ - { - PTR_SYMB symb; - if (NODE_SYMB (ll)) - symb = SYMB_FUNC_PARAM (NODE_SYMB (ll)); - else - symb = NULL; - while (symb) - { - BufPutString ( SYMB_IDENT (symb),0); - symb = SYMB_NEXT_DECL (symb); - if (symb) BufPutString (", ",0); - } - i += strlen("VARLIST"); - } else - if (strncmp(&(str[i]),"STRINGLEN", strlen("STRINGLEN"))== 0) - { - PTR_SYMB symb; - PTR_TYPE type; - if (NODE_SYMB (ll)) - symb = NODE_SYMB (ll); - else - symb = NULL; - if (symb) - { - type = SYMB_TYPE(symb); - if (type && (TYPE_CODE(type) == T_ARRAY)) - { - type = Find_BaseType(type); - } - if (type && (TYPE_CODE(type) == T_STRING)) - { - if (TYPE_RANGES(type)) - Tool_Unparse2_LLnode(TYPE_RANGES(type)); - } - } - i += strlen("STRINGLEN"); - - } else - Message (" *** Unknown low level node COMMAND *** ",0); - } - else - { - BufPutChar ( c); - i++; /* Bodin */ - } - c = str[i]; - } - return Buf_address; -} - -char *Tool_Unparse_Bif(PTR_BFND bif) -{ - int variant; - int kind; - char *str; - char c; - int i; - - if (!bif) - return NULL; - - variant = BIF_CODE(bif); -#ifdef __SPF - if (variant < 0) - return NULL; -#endif - kind = (int) node_code_kind[(int) variant]; - if (kind != (int)BIFNODE) - Message("Error in Unparse, not a bif node", 0); - if (BIF_LINE(bif) == -1) - BufPutString("!$", 0); - //if (BIF_DECL_SPECS(bif) == BIT_OPENMP) BufPutString("!$",0); - str = Unparse_Def[variant].str; - /*printf("variant = %d, str = %s\n", variant, str);*/ - /* now we have to interpret the code to unparse it */ - - if (str == NULL) - return NULL; - if (strcmp( str, "n") == 0) - if (strcmp(str, "n") == 0) - { - Message("Node not define for unparse", BIF_LINE(bif)); - return NULL; - } - - - i = 0 ; - c = str[i]; - while ((c != '\0') && (c != '\n')) - { - if (c == '%') - { - i++; - c = str[i]; - /******** WE HAVE TO INTERPRET THE COMMAND *********/ - if (c == '%') /* %% : Percent Sign */ - { - BufPutString ("%",0); - i++; - } else - if (strncmp(&(str[i]),"CMNT", strlen("CMNT"))== 0) - { - i = i + strlen("CMNT"); - if (!CommentOut) - { - /* print the attached comment first */ - if (BIF_CMNT(bif)) - { - /* int j;*/ /* podd 15.03.99*/ - if (CMNT_STRING(BIF_CMNT(bif))) - { - BufPutChar('\n'); - BufPutString(CMNT_STRING(BIF_CMNT(bif)), 0); - if (!Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - BufPutChar('\n'); - } - } - } - } else - if (strncmp(&(str[i]),"DECLSPEC", strlen("DECLSPEC"))== 0) /* %DECLSPEC : for extern, static, inline, friend */ - { - int index = BIF_DECL_SPECS(bif); - i = i + strlen("DECLSPEC"); - if( index & BIT_EXTERN) { - BufPutString(ridpointers[(int)RID_EXTERN],0); - BufPutString(" ", 0); - } - if( index & BIT_STATIC) { - BufPutString(ridpointers[(int)RID_STATIC],0); - BufPutString(" ", 0); - } - if( index & BIT_INLINE) { - BufPutString(ridpointers[(int)RID_INLINE],0); - BufPutString(" ", 0); - } - if( index & BIT_FRIEND) { - BufPutString(ridpointers[(int)RID_FRIEND],0); - BufPutString(" ", 0); - } - if( index & BIT_CUDA_GLOBAL) { - BufPutString(ridpointers[(int)RID_CUDA_GLOBAL],0); - BufPutString(" ", 0); - } - if( index & BIT_CUDA_SHARED) { - BufPutString(ridpointers[(int)RID_CUDA_SHARED],0); - BufPutString(" ", 0); - } - if( index & BIT_CUDA_DEVICE) { - BufPutString(ridpointers[(int)RID_CUDA_DEVICE],0); - BufPutString(" ", 0); - } - if (index & BIT_CONST) { - BufPutString(ridpointers[(int)RID_CONST], 0); - BufPutString(" ", 0); - } - } else - if (strncmp(&(str[i]),"SETFLAG", strlen("SETFLAG"))== 0) - { - i = i + strlen("SETFLAG"); - Treat_Flag(str, &i,1); - } else - if (strncmp(&(str[i]),"UNSETFLAG", strlen("UNSETFLAG"))== 0) - { - i = i + strlen("UNSETFLAG"); - Treat_Flag(str, &i,-1); - } else - if (strncmp(&(str[i]),"PUSHFLAG", strlen("PUSHFLAG"))== 0) - { - i = i + strlen("PUSHFLAG"); - PushPop_Flag(str, &i,1); - } else - if (strncmp(&(str[i]),"POPFLAG", strlen("POPFLAG"))== 0) - { - i = i + strlen("POPFLAG"); - PushPop_Flag(str, &i,-1); - } else - if (strncmp(&(str[i]),"ERROR", strlen("ERROR"))== 0) /* %ERROR : Generate error message */ - { - Message("--- stmt unparsing error[1] : ",0); - i += strlen("ERROR"); - BufPutString (" *** UNPARSING ERROR OCCURRED HERE ***\n",0); - } else - if (strncmp(&(str[i]),"NL", strlen("NL"))== 0) /* %NL : NewLine */ - { /*int j; */ /* podd 15.03.99*/ - BufPutChar ('\n'); -/* for (j = 0; j < TabNumber; j++) - if (j>1) - BufPutString (" ",0); - else - BufPutString (" ",0);*/ - i += strlen("NL"); - } else - if (strncmp(&(str[i]),"NOTABNL", strlen("NOTABNL"))== 0) /* %NL : NewLine */ - { - BufPutChar ('\n'); - i += strlen("NOTABNL"); - } else - if (strncmp(&(str[i]),"TABOFF", strlen("TABOFF"))== 0) /* turn off tabulation */ - { - TabNumberCopy = TabNumber; - TabNumber = 0; - i += strlen("TABOFF"); - } else - if (strncmp(&(str[i]),"TABON", strlen("TABON"))== 0) /* turn on tabulation */ - { - TabNumber = TabNumberCopy; - i += strlen("TABON"); - } else - if (strncmp(&(str[i]),"TAB", strlen("TAB"))== 0) /* %TAB : Tab */ - { - BufPutString (" ",0); /* cychen */ - i += strlen("TAB"); - } else - if (strncmp(&(str[i]),"PUTTABCOMT", strlen("PUTTABCOMT"))== 0) /* %TAB : Tab */ - { - int j, k; - if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - for (j = 0; j < TabNumber; j++) - if (j>0) - BufPutString (" ",0); - else { - for (k=0; k<6; k++) { - if (HasLabel == 0) - BufPutString (" ",0); /* cychen */ - HasLabel = HasLabel/10; - }; - Buf_pointer-=5; - } - else - for (j = 0; j < TabNumber; j++) - if (j>0) - BufPutString (" ",0); - else - BufPutString (" ",0); /* cychen */ - - i += strlen("PUTTABCOMT"); - } else - if (strncmp(&(str[i]),"PUTTAB", strlen("PUTTAB"))== 0) /* %TAB : Tab */ - { - int j, k; - - if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - for (j = 0; j < TabNumber; j++) - if (j>0) - BufPutString (" ",0); - else { - for (k=0; k<6; k++) { - if (HasLabel == 0) - BufPutString (" ",0); /* cychen */ - HasLabel = HasLabel/10; - }; - } - else - for (j = 0; j < TabNumber; j++) - if (j>0) - BufPutString (" ",0); - else - BufPutString (" ",0); /* cychen */ - - i += strlen("PUTTAB"); - - } else - if (strncmp(&(str[i]),"INCTAB", strlen("INCTAB"))== 0) /* increment tab */ - { - TabNumber++; - i += strlen("INCTAB"); - } else - if (strncmp(&(str[i]),"DECTAB", strlen("DECTAB"))== 0) /*deccrement tab */ - { - if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ - { - if (TabNumber>1) - TabNumber--; - } else - TabNumber--; - i += strlen("DECTAB"); - } else - if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ - { - i += strlen("IF"); - i += Eval_Bif_Condition(&(str[i]), bif); - } else - if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* %ELSE : Else */ - { - i += strlen("ELSE"); - i += SkipToEndif(&(str[i])); /* skip to the corresponding endif */ - } else - if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* %ENDIF : End of If */ - { - i += strlen("ENDIF"); - } else - if (strncmp(&(str[i]),"BLOB1", strlen("BLOB1"))== 0) /* %BLOB1 : All Blob 1 */ - { - PTR_BLOB blob; - - for (blob = BIF_BLOB1(bif);blob; blob = BLOB_NEXT (blob)) - { - Tool_Unparse_Bif(BLOB_VALUE(blob)); - } - i += strlen("BLOB1"); - } else - if (strncmp(&(str[i]),"BLOB2", strlen("BLOB2"))== 0) /* %BLOB2 : All Blob 2 */ - { - PTR_BLOB blob; - - for (blob = BIF_BLOB2(bif);blob; blob = BLOB_NEXT (blob)) - { - Tool_Unparse_Bif(BLOB_VALUE(blob)); - } - i += strlen("BLOB2"); - } else - if (strncmp(&(str[i]),"LL1", strlen("LL1"))== 0) /* %LL1 : Low Level Node 1 */ - { - Tool_Unparse2_LLnode(BIF_LL1(bif)); - i += strlen("LL1"); - } else - if (strncmp(&(str[i]),"LL2", strlen("LL2"))== 0) /* %LL2 : Low Level Node 2 */ - { - Tool_Unparse2_LLnode (BIF_LL2 (bif)); - i += strlen("LL2"); - } else - if (strncmp(&(str[i]),"LL3", strlen("LL3"))== 0) /* %LL3 : Low Level Node 3 */ - { - Tool_Unparse2_LLnode(BIF_LL3(bif)); - i += strlen("LL3"); - } else - if (strncmp(&(str[i]),"L2L2", strlen("L2L2"))== 0) /* %L2L2 : Low Level Node 2 of Low Level Node 2 */ - { - if (BIF_LL2 (bif)) - Tool_Unparse2_LLnode (NODE_TEMPLATE_LL2 (BIF_LL2 (bif))); - i += strlen("L2L2"); - } else - if (strncmp(&(str[i]),"FUNHD", strlen("FUNHD"))== 0) /* %FUNHD track down a function header */ - { - PTR_LLND p; - p = BIF_LL1(bif); - while(p && NODE_CODE(p) != FUNCTION_REF) p = NODE_OPERAND0(p); - if(p == NULL) printf("unparse error in FUNHD!!\n"); - else Tool_Unparse2_LLnode(p); - i += strlen("FUNHD"); - } else - if (strncmp(&(str[i]),"SYMBIDFUL", strlen("SYMBIDFUL"))== 0) /* %SYMBID : Symbol identifier */ - { - if (BIF_SYMB(bif) && SYMB_MEMBER_BASENAME(BIF_SYMB(bif))) - { - Tool_Unparse_Symbol(SYMB_MEMBER_BASENAME(BIF_SYMB(bif))); - BufPutString("::",0); - } - Tool_Unparse_Symbol(BIF_SYMB(bif)); - i += strlen("SYMBIDFUL"); - } else - if (strncmp(&(str[i]),"SYMBID", strlen("SYMBID"))== 0) /* %SYMBID : Symbol identifier */ - { - Tool_Unparse_Symbol(BIF_SYMB(bif)); - i += strlen("SYMBID"); - } else - if (strncmp(&(str[i]),"SYMBSCOPE", strlen("SYMBSCOPE"))== 0) /* %SYMBSCOPE : Symbol identifier */ - { - if (BIF_SYMB(bif) && SYMB_MEMBER_BASENAME(BIF_SYMB(bif))) - { printf("SYMBSCOPE\n"); - Tool_Unparse_Symbol(SYMB_MEMBER_BASENAME(BIF_SYMB(bif))); - } - i += strlen("SYMBSCOPE"); - } else - if (strncmp(&(str[i]),"SYMBDC", strlen("SYMBDC"))== 0) /* %SYMBSCOPE : Symbol identifier */ - { - if (BIF_LL3(bif) || - (BIF_SYMB(bif) && SYMB_MEMBER_BASENAME(BIF_SYMB(bif)))) - { - BufPutString("::",0); - } - i += strlen("SYMBDC"); - } else - - if (strncmp(&(str[i]),"STATENO", strlen("STATENO"))== 0) /* %STATENO : Statement number */ - { - if (BIF_LABEL_USE (bif)) - { - BufPutInt (LABEL_STMTNO (BIF_LABEL_USE (bif))); - } - i += strlen("STATENO"); - } else - if (strncmp(&(str[i]),"LABELENDIF", strlen("LABELENDIF"))== 0) /* %STATENO : Statement number */ - { - PTR_BFND temp; - PTR_BLOB blob; - - temp = NULL; - if (!BIF_BLOB2(bif)) - blob = BIF_BLOB1(bif); - else - blob = BIF_BLOB2(bif); - for (;blob; blob = BLOB_NEXT (blob)) - { - temp = BLOB_VALUE(blob); - if (temp && (BIF_CODE(temp) == CONTROL_END)) - { - if (BIF_LABEL(temp)) - break; - } - temp = NULL; - } - if (temp && BIF_LABEL(temp)) - { - BufPutInt (LABEL_STMTNO (BIF_LABEL(temp))); - } - i += strlen("LABELENDIF"); - } else - if (strncmp(&(str[i]),"LABNAME", strlen("LABNAME")) == 0) /* %LABNAME for C labels: added by dbg */ - { - if(BIF_LABEL_USE(bif)){ - if(LABEL_SYMB(BIF_LABEL_USE(bif))) - BufPutString (SYMB_IDENT(LABEL_SYMB(BIF_LABEL_USE(bif))), 0); - else printf("label-symbol error\n"); - } else printf("label error\n"); - i += strlen("LABNAME"); - } else - if (strncmp(&(str[i]),"LABEL", strlen("LABEL"))== 0) /* %STATENO : Statement number */ - { - if (BIF_LABEL(bif)) - { - HasLabel = LABEL_STMTNO (BIF_LABEL(bif)); - BufPutInt (LABEL_STMTNO (BIF_LABEL(bif))); - } - i += strlen("LABEL"); - } else - if (strncmp(&(str[i]),"SYMBTYPE", strlen("SYMBTYPE"))== 0) /* SYMBTYPE : Type of Symbol */ - { - if (BIF_SYMB (bif) && SYMB_TYPE (BIF_SYMB (bif))) - { - if (Check_Lang_Fortran_For_File(cur_proj))/*16.12.11 podd*/ - BufPutString ( ftype_name [type_index (TYPE_CODE (SYMB_TYPE (BIF_SYMB (bif))))],0); - else if((SYMB_ATTR(BIF_SYMB(bif)) & OVOPERATOR ) == 0){ - PTR_LLND el; - el = BIF_LL1(bif); - if((BIF_CODE(BIF_CP(bif)) == TEMPLATE_FUNDECL) && - el && NODE_TYPE(el)) - Tool_Unparse_Type(NODE_TYPE(el)); - else - Tool_Unparse_Type(SYMB_TYPE (BIF_SYMB (bif))); - } - } - i += strlen("SYMBTYPE"); - } else - if (strncmp(&(str[i]),"CNSTF", strlen("CNSTF"))== 0) /* for const functions */ - { - PTR_SYMB symb; - if (BIF_SYMB (bif)){ - symb = BIF_SYMB (bif); - /* if(SYMB_TEMPLATE_DUMMY8(symb) & 64) BufPutString(" const",0); */ - } - i += strlen("CNSTF"); - } else - if (strncmp(&(str[i]),"VARLISTTY", strlen("VARLISTTY"))== 0) /* %VARLIST : list of variables / parameters */ - { - PTR_SYMB symb; - if (BIF_SYMB (bif)) - symb = SYMB_FUNC_PARAM (BIF_SYMB (bif)); - else - symb = NULL; - while (symb) - { - Tool_Unparse_Type (SYMB_TYPE(symb)); - BufPutString (" ",0); - BufPutString ( SYMB_IDENT (symb),0); - symb = SYMB_NEXT_DECL (symb); - if (symb) BufPutString (", ",0); - } - i += strlen("VARLISTTY"); - } else - if (strncmp(&(str[i]),"TMPLARGS", strlen("TMPLARGS"))== 0) - { - PTR_SYMB symb; - /* PTR_SYMB s; */ /* podd 15.03.99*/ - PTR_LLND args, arg_item, t; - PTR_TYPE typ; - if(BIF_CODE(bif) == FUNC_HEDR) args = BIF_LL3(bif); - else args = BIF_LL1(bif); - while (args ) - { - int typflag; - arg_item = NODE_OPERAND0(args); - if(arg_item == NULL) printf("MAJOR TEMPLATE UNPARSE ERROR. contact dbg \n"); - t = arg_item; - typflag = 1; - while(t && typflag){ - if((NODE_CODE(t) == VAR_REF) || (NODE_CODE(t) == ARRAY_REF)) - typflag = 0; - else if (NODE_CODE(t) == SCOPE_OP) t = NODE_OPERAND1(t); - else t = NODE_OPERAND0(t); - } - if(t){ - symb = NODE_SYMB(t); - typ = NODE_TYPE(t); - if(typ == NULL) typ = SYMB_TYPE(symb); - if((int)strlen(symb->ident) > 0){ /* special case for named arguments */ - typflag = 1; - while(typ && typflag){ - if(TYPE_CODE(typ) == T_ARRAY || - TYPE_CODE(typ) == T_FUNCTION || - TYPE_CODE(typ) == T_REFERENCE || - TYPE_CODE(typ) == T_POINTER) typ = TYPE_BASE(typ); - else if(TYPE_CODE(typ) == T_MEMBER_POINTER) - typ = TYPE_COLL_BASE(typ); - else typflag = 0; - } - } - else BufPutString("class ", 0); - Tool_Unparse_Type (typ); - BufPutString (" ",0); - } - /* else printf("could not find var ref!\n"); */ - Tool_Unparse2_LLnode(arg_item); - args = NODE_OPERAND1(args); - if (args) BufPutString (", ",0); - } - i += strlen("TMPLARGS"); - } else - if (strncmp(&(str[i]),"CONSTRU", strlen("CONSTRU"))== 0) - { - /*PTR_SYMB symb;*/ /* podd 15.03.99*/ - PTR_LLND ll; - if (BIF_LL1(bif)) - { - ll = NODE_OPERAND0(BIF_LL1(bif)); - if (ll) - ll = NODE_OPERAND1(ll); - if (ll) - { - BufPutString (":",0); - Tool_Unparse2_LLnode(ll); - } - } - i += strlen("CONSTRU"); - } else - if (strncmp(&(str[i]),"L1SYMBID", strlen("L1SYMBID"))== 0) /* %L1SYMBID : Symbol of Low Level Node 1 */ - { - if (BIF_LL1 (bif)) - Tool_Unparse_Symbol (NODE_SYMB (BIF_LL1 (bif))); - i += strlen("L1SYMBID"); - } else - if (strncmp(&(str[i]),"VARLIST", strlen("VARLIST"))== 0) /* %VARLIST : list of variables / parameters */ - { - PTR_SYMB symb; - if (BIF_SYMB (bif)) - symb = SYMB_FUNC_PARAM (BIF_SYMB (bif)); - else - symb = NULL; - while (symb) - { - BufPutString ( SYMB_IDENT (symb),0); - symb = SYMB_NEXT_DECL (symb); - if (symb) BufPutString (", ",0); - } - i += strlen("VARLIST"); - } else - if (strncmp(&(str[i]),"RIDPT", strlen("RIDPT"))== 0) - { - PTR_TYPE type = NULL; - - type = Find_Type_For_Bif(bif); - if (type ) - { - DealWith_Rid(type, In_Class_Flag); - } - else if(BIF_CODE(bif) == CLASS_DECL) - { - DealWith_Rid(SYMB_TYPE(BIF_SYMB(bif)), In_Class_Flag); - } - i += strlen("RIDPT"); - } else - if (strncmp(&(str[i]),"INCLASSON", strlen("INCLASSON"))== 0) - { - In_Class_Flag = 1; - i += strlen("INCLASSON"); - } else - if (strncmp(&(str[i]),"INCLASSOFF", strlen("INCLASSOFF"))== 0) - { - In_Class_Flag = 0; - i += strlen("INCLASSOFF"); - } else - if (strncmp(&(str[i]),"INWRITEON", strlen("INWRITEON"))== 0) /* %INWRITEON : In_Write_Statement Flag ON */ - { - In_Write_Flag = 1; - i += strlen("INWRITEON"); - } else - if (strncmp(&(str[i]),"INWRITEOFF", strlen("INWRITEOFF"))== 0) /* %INWRITEOFF : In_Write_Statement Flag OFF */ - { - In_Write_Flag = 0; - i += strlen("INWRITEOFF"); - } else - if (strncmp(&(str[i]),"RECPORTON", strlen("RECPORTON"))== 0) /* %RECPORTON : recursive_port_decl Flag ON */ - { - Rec_Port_Decl = 1; - i += strlen("RECPORTON"); - } else - if (strncmp(&(str[i]),"RECPORTOFF", strlen("RECPORTOFF"))== 0) /* %RECPORTOFF : recursive_port_decl Flag OFF */ - { - Rec_Port_Decl = 0; - i += strlen("RECPORTOFF"); - } else - - if (strncmp(&(str[i]),"INPARAMON", strlen("INPARAMON"))== 0) /* %INPARAMON : In_Param_Statement Flag ON */ - { - In_Param_Flag = 1; - i += strlen("INPARAMON"); - } else - if (strncmp(&(str[i]),"INPARAMOFF", strlen("INPARAMOFF"))== 0) /* %INPARAMOFF : In_Param_Statement Flag OFF */ - { - In_Param_Flag = 0; - i += strlen("INPARAMOFF"); - } else - if (strncmp(&(str[i]),"INIMPLION", strlen("INIMPLION"))== 0) /* %INIMPLION : In_Impli_Statement Flag ON */ - { - In_Impli_Flag = 1; - i += strlen("INIMPLION"); - } else - if (strncmp(&(str[i]),"INIMPLIOFF", strlen("INIMPLIOFF"))== 0) /* %INIMPLIOFF : In_Impli_Statement Flag OFF */ - { - In_Impli_Flag = 0; - i += strlen("INIMPLIOFF"); - - } else /*podd 3.02.03*/ - if (strncmp(&(str[i]),"SAVENAME", strlen("SAVENAME"))== 0) /* save construct name for ELSE and ENDIF */ - { - construct_name = BIF_SYMB(bif); - i += strlen("SAVENAME"); - } else /*podd 3.02.03*/ - if (strncmp(&(str[i]),"CNTRNAME", strlen("CNTRNAME"))== 0) /* save construct name for ELSE and ENDIF */ - { - Tool_Unparse_Symbol(construct_name); - i += strlen("CNTRNAME"); - - } else - if (strncmp(&(str[i]),"TYPEDECLON", strlen("TYPEDECLON"))== 0) /* %TYPEDECLON */ - { if( BIF_LL2(bif) && NODE_TYPE(BIF_LL2(bif)) && TYPE_CODE(NODE_TYPE(BIF_LL2(bif))) == T_STRING) - Type_Decl_Ptr = (long) NODE_TYPE(BIF_LL2(bif)); - else - Type_Decl_Ptr = 0; - i += strlen("TYPEDECLON"); - } else - if (strncmp(&(str[i]),"TYPEDECLOF", strlen("TYPEDECLOF"))== 0) /* %TYPEDECLOF */ - { Type_Decl_Ptr = 0; - i += strlen("TYPEDECLOF"); - } else - if (strncmp(&(str[i]),"TYPE", strlen("TYPE"))== 0) - { - PTR_TYPE type = NULL; - type = Find_Type_For_Bif(bif); - if (!type) - { - Message("TYPE not found",0); - BufPutString("------TYPE ERROR----",0); - } - if( !is_overloaded_type(bif) ) - Tool_Unparse_Type (type); - i += strlen("TYPE"); - } else - if (strncmp(&(str[i]),"PROTECTION", strlen("PROTECTION"))== 0) - { - int protect = 0; - protect = Find_Protection_For_Bif(bif); - if (protect) - { - if (protect & 128) - { - /* BufPutString("MethodOfElement:\n",0); a temporary fix until dep2C++ done */ - BufPutString("public:\n", 0); - } else - { - switch (protect) - { /* find the definition of the flag someday */ - case 64: BufPutString("public:\n",0); break; - case 32: BufPutString("protected:\n",0); break; - case 16: BufPutString("private:\n",0); break; - } - } - } - i += strlen("PROTECTION"); - } else - if (strncmp(&(str[i]),"DUMMY", strlen("DUMMY"))== 0) /* %DUMMY Do nothing */ - { - i += strlen("DUMMY"); - - } else - Message (" *** Unknown bif node COMMAND *** ",0); - } - else - { - BufPutChar( c); - i++; - } - c = str[i]; - } - return Buf_address; -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt deleted file mode 100644 index 942ce21..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt +++ /dev/null @@ -1,18 +0,0 @@ -set(DB_SOURCES anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c - garb_coll.c glob_anal.c ker_fun.c list.c make_nodes.c mod_ref.c ndeps.c - readnodes.c sets.c setutils.c symb_alg.c writenodes.c) - -if(MSVC_IDE) - foreach(DIR ${DVM_SAGE_INCLUDE_DIRS}) - file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} - "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag") - set(DB_HEADERS ${DB_HEADERS} ${FILES}) - endforeach() - source_group("Header Files" FILES ${DB_HEADERS}) -endif() - -add_library(db ${DB_SOURCES} ${DB_HEADERS}) - -target_compile_definitions(db PRIVATE SYS5) -target_include_directories(db PUBLIC "${DVM_SAGE_INCLUDE_DIRS}") -set_target_properties(db PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}") diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/Makefile b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/Makefile deleted file mode 100644 index f4136f1..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/Makefile +++ /dev/null @@ -1,123 +0,0 @@ -####################################################################### -## pC++/Sage++ Copyright (C) 1993 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - - -# sage/lib/oldsrc/Makefile (phb) - -LSX = .a - -#HP_CFLAGS#CEXTRA = -Ae +z#ENDIF# -#HP_CFLAGS#LSX = .sl#ENDIF# - -SHELL = /bin/sh -CONFIG_ARCH=iris4d - -RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ] -#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF# - -# Directory with all the include headers -H = ../../h - -#INSTALLDEST = ../$(CONFIG_ARCH) -INSTALLDEST = ../../../libsage -INSTALL = /bin/cp - -CC = gcc -#CC=cc#ENDIF##USE_CC# - -CXX = g++ -CXX = /usr/WorkShop/usr/bin/DCC -LINKER = $(CC) - -CFLAGS = -g -Wall -I$H $(CEXTRA) - -DEST = ${HOME}/bin - -EXTHDRS = $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \ - $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \ - $H/tag $H/vparse.h - -OBJS = anal_ind.o db.o db_unp.o db_unp_vpc.o dbutils.o \ - garb_coll.o glob_anal.o ker_fun.o list.o \ - make_nodes.o mod_ref.o ndeps.o readnodes.o sets.o setutils.o \ - symb_alg.o writenodes.o - -SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c \ - garb_coll.c glob_anal.c ker_fun.c list.c \ - make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \ - symb_alg.c writenodes.c - - -all: $(OBJS) libdb$(LSX) - -libdb.a: $(OBJS) - /bin/rm -f libdb.a - ar qc libdb.a $(OBJS) - @if $(RANLIB_TEST) ; then ranlib libdb.a ; \ - else echo "\tNOTE: ranlib not required" ; fi - -libdb.sl: $(OBJS) - /bin/rm -f libdb.sl - ld -b -s -o libdb.sl $(OBJS) - -clean: - @/bin/rm -f $(OBJS) $(PROGRAM) *.dep libdb$(LSX) - -index: - ctags -wx $(HDRS) $(SRCS) - -print: - $(PRINT) $(HDRS) $(SRCS) - -program: $(PROGRAM) - -tags: $(HDRS) $(SRCS); ctags $(HDRS) $(SRCS) - -install: $(INSTALLDEST)/libdb$(LSX) - -$(INSTALLDEST)/libdb$(LSX): libdb$(LSX) - if [ -d $(INSTALLDEST) ] ; then true; \ - else mkdir $(INSTALLDEST) ;fi - $(INSTALL) libdb$(LSX) $(INSTALLDEST) - @if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libdb$(LSX) ; \ - else echo "\tNOTE: ranlib not required" ; fi - -### -anal_ind.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -db.o: $H/db.h $H/defs.h \ - $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h -db_unp.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -db_unp_vpc.o: $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h $H/db.h $H/vparse.h -dbutils.o: $H/db.h \ - $H/defs.h $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h -garb-coll.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -glob_anal.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -ker_fun.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ - $H/symb.h $H/sets.h -list.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h $H/list.h -make_nodes.o: $H/db.h $H/defs.h $H/tag \ - $H/bif.h $H/ll.h $H/symb.h $H/sets.h -mod_ref.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ - $H/symb.h $H/sets.h $H/vparse.h $H/db.h -ndeps.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -readnodes.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ - $H/dep.h -sets.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -setutils.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -symb_alg.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -writenodes.o: $H/db.h $H/defs.h $H/tag \ - $H/bif.h $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ - $H/dep.h diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c deleted file mode 100644 index fd2b032..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c +++ /dev/null @@ -1,1031 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* file: anal_ind.c */ - -/**********************************************************************/ -/* This file contains the routines called in sets.c that do all index*/ -/* and subscript analysis. */ -/**********************************************************************/ - -#include -#include "db.h" - -#define PLUS 2 -#define ZPLUS 3 -#define MINUS 4 -#define ZMINUS 5 -#define PLUSMINUS 6 -#define NODEP -1 - -/* extern variables */ -extern PTR_SYMB induct_list[MAX_NEST_DEPTH]; -extern int stride[MAX_NEST_DEPTH]; -extern int language; -extern PTR_FILE cur_file; - -extern PCF UnparseBfnd[]; -extern PCF UnparseLlnd[]; - - -/* local variables */ -struct subscript blank, extra; -int table_generated = 0; -int np = 2 * MAX_NEST_DEPTH; -int tbl_depth = 4 * MAX_NEST_DEPTH + AR_DIM_MAX; -int num_eqn, num_ineq; -int adm = MAX_NEST_DEPTH; -int *table[MAX_NEST_DEPTH * 4 + AR_DIM_MAX]; -int upper_bnd[2 * MAX_NEST_DEPTH], lower_bnd[2 * MAX_NEST_DEPTH]; -int dist_ub[2 * MAX_NEST_DEPTH], dist_lb[2 * MAX_NEST_DEPTH]; - -/* forward references */ -PTR_SETS alloc_sets(); -PTR_REFL alloc_ref(); -int disp_refl(); -PTR_REFL copy_refl(); -PTR_REFL union_refl(); -void add_eqn(); -void set_troub(); -void print_tbl(); -void print_etbl(); -void set_vec(); -int simple_algebraic(); -int reduce(); -int solve_system(); -int chk_bnds(); - -/* extern references */ -int make_induct_list(); -void make_subscr(); -int reduce_ll_exp(); -int sequiv(); -int unif_gen(); -int gcd(); -void make_vect_range(); - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -int check_for_indvar(s, d, lis) -PTR_SYMB s, lis[]; - -int d; -{ - int i; - - for (i = 0; i < d; i++) - if (s == lis[i]) - return (1); - return (0); -} - -PTR_LLND append_ll_elist(PTR_LLND list, PTR_LLND item); - -/*************************************************************/ -/* find_bounds(b,q,qnew) takes a bifnode-llnd pair (b,q) and */ -/* creates a low level expression that describes the range */ -/* of values that are touched by the reference in the current*/ -/* context. the index expressions are all scalars and ranges*/ -/* interms of parameters or constants. if the index exp is */ -/* undecidable, then the whole range of the index is assumed */ -/* the parameter qnew is a low level list upon which this */ -/* expression is appended. */ -/*************************************************************/ -PTR_LLND find_bounds(PTR_BFND b, PTR_LLND q, PTR_LLND qnew) -/*PTR_BFND b;*/ -/*PTR_LLND q, qnew;*/ -{ - PTR_SYMB ind_list[MAX_NEST_DEPTH]; - //PTR_LLND ind_terms[MAX_NEST_DEPTH]; - struct subscript il_lo[MAX_NEST_DEPTH]; - struct subscript il_hi[MAX_NEST_DEPTH]; - struct subscript source[AR_DIM_MAX]; /* a source reference or def. */ - int i, j, count, dumb,sign; - struct ref sor; - PTR_LLND qind_list, new_list, q_index, make_llnd(), tmp; - PTR_LLND exp1, exp2, exp3, build_exp_from_bound(); - PTR_BFND fun; - PTR_REFL parms; - PTR_LLND copy_llnd(); - - for (i = 0; i < MAX_NEST_DEPTH; i++) { - ind_list[i] = NULL; - //ind_terms[i] = NULL; - for (j = 0; j < MAX_NEST_DEPTH; j++) { - il_lo[i].coefs_symb[j] = NULL; - il_hi[i].coefs_symb[j] = NULL; - } - } - - make_induct_list(b, ind_list, il_lo, il_hi); - sor.stmt = b; - sor.refer = q; - make_subscr(&sor, source); /* source is an array of */ - /* subscript records that */ - /* shared by all routines */ - /* find the parameter list */ - fun = b; - while ((fun->variant != PROG_HEDR) && - (fun->variant != FUNC_HEDR) && - (fun->variant != PROC_HEDR)) - fun = fun->control_parent; - parms = fun->entry.Template.sets->in_def; - - qind_list = q->entry.Template.ll_ptr1; - new_list = NULL; - i = 0; - while (qind_list != NULL) { - q_index = qind_list->entry.Template.ll_ptr1; - if (source[i].decidable == 2) { /* ddot case */ - PTR_LLND low, hi, ar1, ar2, rl1, rl2, ltmp, htmp; - /* skip stride for now */ - if (q_index->variant == DDOT && q_index->entry.Template.ll_ptr1 != NULL - && q_index->entry.Template.ll_ptr1->variant == DDOT) - q_index = q_index->entry.Template.ll_ptr1; - if (q_index->variant == STAR_RANGE) { - rl1 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - } - else { - low = copy_llnd(q_index->entry.Template.ll_ptr1); - hi = copy_llnd(q_index->entry.Template.ll_ptr2); - - rl1 = make_llnd(cur_file, EXPR_LIST, low, NULL, NULL); - rl2 = make_llnd(cur_file, EXPR_LIST, hi, NULL, NULL); - ar1 = make_llnd(cur_file,ARRAY_REF,rl1,NULL, q->entry.Template.symbol); - ar2 = make_llnd(cur_file,ARRAY_REF,rl2,NULL, q->entry.Template.symbol); - ltmp = find_bounds(b, ar1, NULL); - htmp = find_bounds(b, ar2, NULL); - ltmp = ltmp->entry.Template.ll_ptr1; - htmp = htmp->entry.Template.ll_ptr1; - - if (ltmp!= NULL && (ltmp->variant == EXPR_LIST || ltmp->variant == EXPR_LIST)) - ltmp = ltmp->entry.Template.ll_ptr1; - if (htmp!= NULL && (htmp->variant == EXPR_LIST || htmp->variant == EXPR_LIST)) - htmp = htmp->entry.Template.ll_ptr1; - if(ltmp == NULL) low = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - else if (ltmp->variant == DDOT) - low = ltmp->entry.Template.ll_ptr1; - else - low = ltmp; - if(htmp == NULL) hi = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - else if (htmp->variant == DDOT) { - hi = htmp->entry.Template.ll_ptr2; - if (hi->variant == DDOT) - hi = hi->entry.Template.ll_ptr1; - } - else - hi = htmp; - if (low->variant == STAR_RANGE) - rl1 = low; - else if (hi->variant == STAR_RANGE) - rl1 = hi; - else { - rl1->variant = DDOT; - rl1->entry.Template.ll_ptr1 = low; - rl1->entry.Template.ll_ptr2 = hi; - } - } - new_list = append_ll_elist(new_list, rl1); - } - else if (source[i].decidable == 0) { /* parm */ - if (q_index == NULL || q_index->variant == STAR_RANGE) { - exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - new_list = append_ll_elist(new_list, exp3); - } - else if (reduce_ll_exp(b, parms, ind_list, q_index, &exp2, &dumb) == 0) { - /* was not able to resolve */ - if (simple_algebraic(q_index)) { - sign = 1; - exp1 = build_exp_from_bound(il_lo, &(source[i]),&sign); - if (exp1 == NULL) { - /* this should only happen if the subscript */ - /* is very strange. */ - } - if (reduce_ll_exp(b, parms, ind_list, exp1, &exp2, &dumb) == 0) { - /* was not able to resolve ! */ - exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - } - else { - exp1 = exp2; - count = 0; - for (j = 0; j < MAX_NEST_DEPTH; j++) - if (source[i].coefs[j] != 0) - count++; - if (count == 0) - exp3 = exp1; - else { - sign = 1; - exp2 = build_exp_from_bound(il_hi, &(source[i]),&sign); - if (reduce_ll_exp(b, parms, ind_list, exp2, &exp3, &dumb) == 0) { - exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - } - else { - exp2 = exp3; - if(sign > 0) - exp3 = make_llnd(cur_file, DDOT, exp1, exp2, NULL); - else - exp3 = make_llnd(cur_file, DDOT, exp2, exp1, NULL); - } - } - } - new_list = append_ll_elist(new_list, exp3); - } - else { - tmp = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - new_list = append_ll_elist(new_list, tmp); - } - } - else - new_list = append_ll_elist(new_list, exp2); - } - else if (source[i].decidable == 1) { /* standard linear */ - sign = 1; - exp1 = build_exp_from_bound(il_lo, &(source[i]),&sign); - if (exp1 == NULL) { - /* fprintf(stderr, "OOPS null!\n"); */ - /* this should only happen if the subscript */ - /* is very strange. or the low bound is strange */ - } - if (reduce_ll_exp(b, parms, ind_list, exp1, &exp2, &dumb) == 0) { - /* was not able to resolve ! */ - exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - } - else { - exp1 = exp2; - count = 0; - for (j = 0; j < MAX_NEST_DEPTH; j++) - if (source[i].coefs[j] != 0 - || source[i].coefs_symb[j] != NULL) - count++; - if (count == 0) - exp3 = exp1; - else { - sign = 1; - exp2 = build_exp_from_bound(il_hi, &(source[i]),&sign); - if (reduce_ll_exp(b, parms, ind_list, exp2, &exp3, &dumb) == 0) { - exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); - } - else { - exp2 = exp3; - if(sign> 0) - exp3 = make_llnd(cur_file, DDOT, exp1, exp2, NULL); - else - exp3 = make_llnd(cur_file, DDOT, exp2, exp1, NULL); - } - } - } - new_list = append_ll_elist(new_list, exp3); - } - else { - fprintf(stderr, "source[i].decidable = %d\n", source[i].decidable); - fprintf(stderr, "strange brew in find_bounds %s\n", - (UnparseLlnd[cur_file->lang])(q_index)); - new_list = append_ll_elist(new_list, q_index); - } - qind_list = qind_list->entry.Template.ll_ptr2; - i++; - } - if (qnew != NULL) - qnew->entry.Template.ll_ptr1 = new_list; - else - qnew = new_list; - return (qnew); -} - - -int simple_algebraic(p) -PTR_LLND p; -{ - if (p == NULL) - return (1); - switch (p->variant) { - case EXPR_LIST: - case ADD_OP: - case DIV_OP: - case MULT_OP: - case SUBT_OP: - case MINUS_OP: - return (simple_algebraic(p->entry.Template.ll_ptr1) * - simple_algebraic(p->entry.Template.ll_ptr2)); - case VAR_REF: - case CONST_REF: - case INT_VAL: - return (1); - default: - return (0); - } -} - -PTR_LLND append_ll_elist(list, item) -PTR_LLND list, item; -{ - PTR_LLND tmp, make_llnd(); - - if (list == NULL) { - tmp = make_llnd(cur_file, EXPR_LIST, item, NULL, NULL); - return (tmp); - } - if (list->variant != EXPR_LIST) { - fprintf(stderr, "append_ll_elist screw up\n"); - return (list); - } - else if (list->entry.list.next == NULL) { - tmp = append_ll_elist(NULL, item); - list->entry.list.next = tmp; - return (list); - } - else { - append_ll_elist(list->entry.list.next, item); - return (list); - } -} - -PTR_LLND build_exp_from_bound(il, sub, sign) -struct subscript il[MAX_NEST_DEPTH]; -struct subscript *sub; -int *sign; -{ - PTR_LLND exp, exp2, exp3, exp4, make_llnd(); - int j; - - if (sub->decidable == 2) { /* ddot case */ - return (sub->vector); - } - if (sub->decidable == 0 /* && simple_algebraic(sub->parm_exp) == 0 */ ) { - /* parameter expression (we hope) */ - /* first we need to check for other vars */ - return (sub->parm_exp); - } - if (sub->decidable == 1) { /* standard linear */ - exp = NULL; - if (sub->parm_exp == NULL) { - exp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - exp->entry.ival = sub->offset; - } - else - exp = sub->parm_exp; - for (j = 0; j < MAX_NEST_DEPTH; j++) { - if (sub->coefs_symb[j] != NULL) { /* symbolic case! */ - exp3 = build_exp_from_bound(il, &(il[j]), sign); - if (exp3 == NULL) { - exp4 = NULL; - exp = NULL; - } - else if (exp3->variant == DDOT) { - fprintf(stderr, "DDOT case\n"); - exp4 = exp3; - } - else { /* exp3 is loop bound which must mult by symbolic coef */ - exp4 = make_llnd(cur_file, MULT_OP, sub->coefs_symb[j], - exp3, NULL); - } - if (exp != NULL) { - exp3 = make_llnd(cur_file, ADD_OP, exp4, exp, NULL); - exp = exp3; - } - else - exp = exp4; - } - else if (sub->coefs[j] != 0) { /* a nice integer coef. */ - exp3 = build_exp_from_bound(il, &(il[j]),sign); - if (exp3 == NULL) { - exp4 = NULL; - exp = NULL; - } - else if (exp3->variant == DDOT) { - fprintf(stderr, "DDOT case\n"); - exp4 = exp3; - } - else if (sub->coefs[j] == 1) - exp4 = exp3; - else { - exp2 = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - exp2->entry.ival = sub->coefs[j]; - if(sub->coefs[j] < 0) *sign = -1; - exp2->type = cur_file->head_type; /* always INT type */ - exp4 = make_llnd(cur_file, MULT_OP, exp2, exp3, NULL); - } - if (exp != NULL) { - exp3 = make_llnd(cur_file, ADD_OP, exp4, exp, NULL); - exp = exp3; - } - else - exp = exp4; - } - } - return (exp); - } - else - return (make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL)); -} - -/**************************************************************/ -/* compute dist vect. calculates the distance vector between */ -/* two references source and destination. The vector is an */ -/* array of integers of the form ( len, dist1, dist2, ....) */ -/* trouble is an array which indicates one of several problems*/ -/* if trouble[0] = 1 then there is no intersection! */ -/* if trouble[i] = PLUSMINUS then the i-th component is "<=>"*/ -/* if trouble[i] = PLUS then vector is "+" ,i.e. positive */ -/* but variable in nature. similar for ZPLUS which */ -/* means the vector is "0+" = non-negative */ -/* other cases are ZMINUS="0-" and MINUS = "-" */ -/* if trouble[i] = NODEP then no depend. on this index at all*/ -/* NOTE: trouble[i] = NODEP is the case for scalars. */ -/* the first component of vec is the length of the vector. */ -/* function returns nothing */ -/**************************************************************/ -int comp_dist(vec, trouble, sor, des, lexord) -int vec[], trouble[]; -struct ref *sor; -struct ref *des; -int lexord; /* true if sor precedes des in lex order */ -{ - PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH]; - struct subscript il_lo[MAX_NEST_DEPTH]; - struct subscript il_hi[MAX_NEST_DEPTH]; - struct subscript source[AR_DIM_MAX]; /* a source reference or def. */ - struct subscript destin[AR_DIM_MAX]; /* a destination ref. or def. */ - int inorder, i, j, sd, dd, depth, step, depfound; - //int eqntbl[AR_DIM_MAX][2 * MAX_NEST_DEPTH + 1]; - PTR_SYMB s; - - if (table_generated == 0) - { - for (i = 0; i < tbl_depth; i++) - { - table[i] = (int *)calloc(2 * MAX_NEST_DEPTH + 1, sizeof(int)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,table[i], 0); -#endif - } - table_generated = 1; - } - for (i = 0; i < tbl_depth; i++) - for (j = 0; j < np + 1; j++) { - table[i][j] = 0; - // if (i < AR_DIM_MAX) - //eqntbl[i][j] = 0; - } - - blank.decidable = 1; - extra.decidable = 1; - extra.offset = 0; - blank.offset = 0; - for (i = 0; i < MAX_NEST_DEPTH; i++) { - sor_ind_l[i] = NULL; - des_ind_l[i] = NULL; - blank.coefs[i] = 0; - il_lo[i].decidable = 1; - il_hi[i].decidable = 1; - il_lo[i].offset = 0; - il_hi[i].offset = 0; - for (j = 0; j < MAX_NEST_DEPTH; j++) { - il_lo[i].coefs[j] = 0; - il_hi[i].coefs[j] = 0; - } - } - - sd = make_induct_list(sor->stmt, sor_ind_l, il_lo, il_hi); - - dd = make_induct_list(des->stmt, des_ind_l, il_lo, il_hi); - - depth = (sd < dd) ? sd : dd; - inorder = (sor->stmt->g_line < des->stmt->g_line) ? 1 : 0; - - i = 0; - while ((i < depth) && (des_ind_l[i] == sor_ind_l[i])) - i++; - if (i < depth) - depth = i; - - make_subscr(sor, source); - make_subscr(des, destin); - /* for each subscript expression we need to check for */ - /* symbolic references. if they are the same we are */ - /* ok. if they are different we set the flag to be */ - /* undecidable. */ - for (j = 0; j < AR_DIM_MAX; j++) { - if ((source[j].parm_exp != NULL) || - (destin[j].parm_exp != NULL)) { - if (sequiv(source[j].parm_exp, destin[j].parm_exp) == 0) { - /* the following is temporary. we */ - /* should do a symbolic subtraction */ - source[j].offset = 1; - destin[j].offset = 0; - source[j].decidable = 1; - destin[j].decidable = 1; - source[j].parm_exp = NULL; - destin[j].parm_exp = NULL; - } - } - } - s = sor->refer->entry.Template.symbol; - for (i = 1; i < MAX_NEST_DEPTH; i++) { - vec[i] = 0; - trouble[i] = NODEP; - } - vec[0] = depth; - trouble[0] = 0; - /* first check for uniformly generated cases */ - if ((s->type->variant == T_ARRAY || s->type->variant == T_POINTER) - && unif_gen(sor, des, vec, trouble, source, destin)); - else { - /* if a scalar ... */ - if (s->type->variant != T_ARRAY && s->type->variant != T_POINTER) { - for (i = 1; i <= depth; i++) { - trouble[i] = 0; - vec[i] = 0; - } - - if (inorder == 0) { - vec[depth] = 1; - trouble[depth] = 0; - } - return (1); - } - else - /* if not uniform do generalized shoestak */ - for (step = 0; step <= depth; step++) { - if (solve_system(step, depth, sd, sor_ind_l, - dd, des_ind_l, il_lo, il_hi, source, destin) != 0) { - set_troub(step + 1, vec, trouble, PLUS); - } - else if (step == 0) - trouble[0] = 1; - } - } - depfound = 0; - - for (i = 1; i < MAX_NEST_DEPTH; i++) { - if (vec[i] != 0 || trouble[i] != NODEP) - depfound = 1; - if (trouble[i] == -99) - trouble[i] = 0; - } - - if (depfound == 0 && !lexord) - trouble[0] = 1; - return (1); /* return value means nothing here */ - -} - -int solve_system(step,depth,sd,sor_ind_l,dd,des_ind_l,il_lo,il_hi,source,destin) -int step, depth, sd, dd; -PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH]; -struct subscript il_lo[]; -struct subscript il_hi[]; -struct subscript source[]; /* a source reference or def. */ -struct subscript destin[]; /* a destination ref. or def. */ -{ - struct subscript lo, hi; - int i, j, k, max_depth; - int num_eqn, num_ineq; - - max_depth = (sd > dd) ? sd : dd; - - /* now build equation rows of the table */ - num_eqn = -1; - for (j = 0; j < AR_DIM_MAX; j++) { - if (source[j].decidable != -1 || destin[j].decidable != -1) - add_eqn(table[j], &source[j], &destin[j]); - else if (num_eqn == -1) - num_eqn = j; - } - /* add step equations */ - for (k = 0; k < step; k++) { - for (j = 0; j < MAX_NEST_DEPTH; j++) { - extra.coefs[j] = 0; - blank.coefs[j] = 0; - } - extra.coefs[k] = 1; - blank.coefs[k] = 1; - add_eqn(table[num_eqn], &extra, &blank); - num_eqn++; - blank.coefs[k] = 0; - } - - /* fix normalization for stride */ - for (i = 0; i < depth; i++) { - if (stride[i] != 1) { - for (j = 0; j < num_eqn; j++) { - table[j][i] = table[j][i] * stride[i]; - table[j][MAX_NEST_DEPTH + i] = - table[j][MAX_NEST_DEPTH + i] * stride[i]; - } - - if (stride[i] < 0) { - for (j = 0; j < num_eqn; j++) - if (table[j][i] < 0) - for (k = 0; k <= np; k++) - table[j][k] = -table[j][k]; - } - } - } - - num_ineq = 0; - - /* now add direction inequality at position step */ - for (j = 0; j < MAX_NEST_DEPTH; j++) { - extra.coefs[j] = 0; - blank.coefs[j] = 0; - } - extra.coefs[step] = -1; - blank.coefs[step] = -1; - extra.offset = -1; - add_eqn(table[num_eqn], &extra, &blank); - extra.coefs[step] = 0; - blank.coefs[step] = 0; - extra.offset = 0; - - num_ineq = 1; - /* now add vector range subscript ineq. */ - for (j = 0; j < AR_DIM_MAX; j++) { - if (source[j].decidable == 2) { - /* source is vector in component j */ - make_vect_range(sd, source[j].vector, sor_ind_l, &lo, &hi); - add_eqn(table[num_eqn + num_ineq], &lo, &blank); - add_eqn(table[num_eqn + num_ineq + 1], &hi, &blank); - num_ineq = num_ineq + 2; - } - if (destin[j].decidable == 2) { - /* destin is vector in component j */ - make_vect_range(dd, destin[j].vector, des_ind_l, &lo, &hi); - add_eqn(table[num_eqn + num_ineq], &lo, &blank); - add_eqn(table[num_eqn + num_ineq + 1], &hi, &blank); - num_ineq = num_ineq + 2; - } - } - - - /* now add induction bound inequalities */ - for (j = 0; j < max_depth; j++) { - /* reverse lo */ - il_lo[j].offset = -il_lo[j].offset; - for (i = 0; i < MAX_NEST_DEPTH; i++) - il_lo[j].coefs[i] = -il_lo[j].coefs[i]; - il_lo[j].coefs[j] = 1; /* perhaps repalce by stride ? */ - il_hi[j].coefs[j] = -1; - - if (il_lo[j].decidable == 1) { - add_eqn(table[num_eqn + num_ineq], &il_lo[j], &blank); - num_ineq = num_ineq + 1; - } - if (il_hi[j].decidable == 1) { - add_eqn(table[num_eqn + num_ineq], &il_hi[j], &blank); - num_ineq = num_ineq + 1; - } - /* reset lo and reverse hi */ - for (i = 0; i < MAX_NEST_DEPTH; i++) { - il_lo[j].coefs[i] = -il_lo[j].coefs[i]; - il_hi[j].coefs[i] = -il_hi[j].coefs[i]; - } - il_lo[j].offset = -il_lo[j].offset; - il_hi[j].offset = -il_hi[j].offset; - if (il_lo[j].decidable == 1) { - add_eqn(table[num_eqn + num_ineq], &blank, &il_lo[j]); - num_ineq = num_ineq + 1; - } - if (il_hi[j].decidable == 1) { - add_eqn(table[num_eqn + num_ineq], &blank, &il_hi[j]); - num_ineq = num_ineq + 1; - } - /* reset hi */ - for (i = 0; i < MAX_NEST_DEPTH; i++) { - il_hi[j].coefs[i] = -il_hi[j].coefs[i]; - } - il_hi[j].offset = -il_hi[j].offset; - il_lo[j].coefs[j] = 0; - il_hi[j].coefs[j] = 0; - - } - - /* table complete.. now put in reduced form */ - if (reduce(table, num_eqn, num_eqn + num_ineq) == 0) - return (0); - else - return (1); -} - -void add_eqn(table, source, destin) -struct subscript *source; /* a source reference or def. */ -struct subscript *destin; /* a destination ref. or def. */ -int table[]; -{ - int i; - - if (source->decidable < 1 || destin->decidable < 1) - for (i = 0; i < np + 1; i++) - table[i] = 0; - else { - for (i = 0; i < MAX_NEST_DEPTH; i++) { - table[i] = source->coefs[i]; - table[i + MAX_NEST_DEPTH] = -(destin->coefs[i]); - } - table[np] = source->offset - destin->offset; - } -} - -void print_tbl(depth, neqn, neq, tbl) -int depth, neqn, neq; -int *tbl[]; -{ - int i, j; - - depth = depth; /* make lint happy, depth unused */ - - fprintf(stderr, "|---------------table----------------------|\n"); - fprintf(stderr, "| i j k i' j' k' const relat|\n"); - fprintf(stderr, "|------------------------------------------|\n"); - j = np / 2; - for (i = 0; i < neqn; i++) - fprintf(stderr, "| %2d %2d %2d %2d %2d %2d %4d == |\n", - tbl[i][0], tbl[i][1], tbl[i][2], - tbl[i][j], tbl[i][j + 1], tbl[i][j + 2], tbl[i][np]); - fprintf(stderr, "|------------------------------------------|\n"); - for (i = neqn; i < neqn + neq; i++) - fprintf(stderr, "| %2d %2d %2d %2d %2d %2d %4d >= |\n", - tbl[i][0], tbl[i][1], tbl[i][2], - tbl[i][j], tbl[i][j + 1], tbl[i][j + 2], tbl[i][np]); - fprintf(stderr, "|------------------------------------------|\n"); -} - -void print_etbl(depth, neqn, tbl) -int depth, neqn; -int tbl[AR_DIM_MAX][2 * MAX_NEST_DEPTH + 1]; -{ - int i, j; - - depth = depth; /* make lint happy, depth unused */ - - fprintf(stderr, "|---------------table----------------------|\n"); - fprintf(stderr, "| i j k i' j' k' const relat|\n"); - fprintf(stderr, "|------------------------------------------|\n"); - j = np / 2; - for (i = 0; i < neqn; i++) - fprintf(stderr, "| %2d %2d %2d %2d %2d %2d %4d == |\n", - tbl[i][0], tbl[i][1], tbl[i][2], - tbl[i][j], tbl[i][j + 1], tbl[i][j + 2], tbl[i][np]); - fprintf(stderr, "|------------------------------------------|\n"); -} - -int reduce(tbl, num_eqn, tbl_depth) -int *tbl[]; -int num_eqn, tbl_depth; -{ - int j, i, k, t, mgcd, piv, pcol, opc, alf, bet; - int *tmp; - - for (i = 0; i < 2 * MAX_NEST_DEPTH; i++) { - upper_bnd[i] = 32000; - lower_bnd[i] = -32000; - if (i < MAX_NEST_DEPTH) { - dist_lb[i] = -32000; - dist_ub[i] = 32000; - } - } - - for (i = 0; i < tbl_depth; i++) - if (chk_bnds(tbl, i, upper_bnd, lower_bnd) == 0) - return (0); - - pcol = -1; - /* first eliminate by using the equations */ - for (j = 0; j < num_eqn; j++) { - /* find leader pivod equation */ - piv = -1; - opc = pcol; - for (k = opc + 1; k < MAX_NEST_DEPTH * 2; k++) - for (t = j; t < num_eqn; t++) - if (opc == pcol && tbl[t][k] != 0) { - pcol = k; - piv = t; - } - - if (piv > -1) { - /* swap to bring to top */ - tmp = tbl[j]; - tbl[j] = tbl[piv]; - tbl[piv] = tmp; - /* first reduce by gcd of row */ - if (tbl[j][pcol] < 0) - for (i = 0; i <= np; i++) - tbl[j][i] = -tbl[j][i]; - mgcd = gcd(np - 1, tbl[j]); - if (mgcd > 1) { - /* first test for bad congruence class */ - if ((tbl[j][np] % mgcd) != 0) - return (0); - for (i = 0; i <= np; i++) - tbl[j][i] = tbl[j][i] / mgcd; - } - /* now do elimination on pcol */ - alf = tbl[j][pcol]; - if (alf == 0) - fprintf(stderr, "reduce error\n"); - else if (alf < 0) { - alf = -alf; - for (i = 0; i <= np; i++) - tbl[j][i] = -tbl[j][i]; - } - for (k = j + 1; k < tbl_depth; k++) { - if ((bet = tbl[k][pcol]) != 0) { - /* first reduce row k */ - for (i = pcol; i <= np; i++) - tbl[k][i] = alf * tbl[k][i] - bet * tbl[j][i]; - /* test for dim 1 or 0 constraint */ - if (chk_bnds(tbl, k, upper_bnd, lower_bnd) == 0) - return (0); - } - } - } /* end of piv found case */ - } /* end of factorization loop */ - /* second eliminate by adding inequalities */ - for (j = num_eqn; j < tbl_depth; j++) { - /* find leader pivod equation */ - piv = -1; - opc = pcol; - for (k = opc + 1; k < MAX_NEST_DEPTH * 2; k++) - for (t = j; t < tbl_depth; t++) - if (opc == pcol && tbl[t][k] > 0) { - pcol = k; - piv = t; - } - - if (piv > -1) { - /* swap to bring to top */ - tmp = tbl[j]; - tbl[j] = tbl[piv]; - tbl[piv] = tmp; - /* now do elimination on pcol */ - alf = tbl[j][pcol]; - if (alf <= 0) - fprintf(stderr, "reduce error\n"); - for (k = j + 1; k < tbl_depth; k++) { - if ((bet = tbl[k][pcol]) < 0) { - /* first do the ellimination */ - for (i = 0; i <= np; i++) - tbl[k][i] = alf * tbl[k][i] - bet * tbl[j][i]; - /* now check for constraint errors */ - if (chk_bnds(tbl, k, upper_bnd, lower_bnd) == 0) - return (0); - } - } - } /* end of piv found case */ - } /* end of factorization loop */ - - /* now look for contradictions in eqnations */ - for (j = 0; j < tbl_depth; j++) - if (chk_bnds(tbl, j, upper_bnd, lower_bnd) == 0) - return (0); - return (1); -} - -int chk_bnds(tbl, k, upper_bnd, lower_bnd) -int *tbl[]; -int k; -int upper_bnd[], lower_bnd[]; -{ - int i, first, second, third, gama; - - third = -1; - first = -1; - second = -1; - for (i = 0; i < np; i++) - if (tbl[k][i] != 0) { - if (first == -1) - first = i; - else if (second == -1) - second = i; - else if (third == -1) - third = i; - } - if (first == -1) { /* this is a dimension 0 constraint */ - if ((k < num_eqn) & (tbl[k][np] != 0)) - return (0); - if ((k >= num_eqn) & (tbl[k][np] < 0)) - return (0); - } - else if (second == -1) { /* this is a dimension 1 constraint */ - if (k < num_eqn) { - gama = -tbl[k][np] / tbl[k][first]; - /* var first has lower bound gama and upper bound gama */ - if (gama < lower_bnd[first]) - return (0); - lower_bnd[first] = gama; - if (gama > upper_bnd[first]) - return (0); - upper_bnd[first] = gama; - } - else { /* this is an inequality */ - if (tbl[k][first] > 0) { /* the inequality is > */ - gama = -tbl[k][np] / tbl[k][first]; - /* gama is a new lower bound */ - if (gama > upper_bnd[first]) - return (0); - if (gama > lower_bnd[first]) - lower_bnd[first] = gama; - } - else { /* the inequality is < */ - gama = -tbl[k][np] / tbl[k][first]; - /* gama is a new upper bound */ - if (gama < lower_bnd[first]) - return (0); - if (gama < upper_bnd[first]) - upper_bnd[first] = gama; - } - } - } /* end dim 1 case */ - else if (third == -1 && (second - first) == MAX_NEST_DEPTH) { - - /* dimension 2 case involving i and i' look for i' - i > k forms */ - if (tbl[k][first] == -tbl[k][second]) { - if (k < num_eqn) { - dist_ub[first] = -tbl[k][np] / tbl[k][second]; - dist_lb[first] = dist_ub[first]; - } - else if (tbl[k][second] < 0 - && dist_ub[first] > tbl[k][np] / tbl[k][first]) - dist_ub[first] = tbl[k][np] / tbl[k][first]; - else if (tbl[k][second] > 0 - && dist_lb[first] < tbl[k][np] / tbl[k][second]) - dist_lb[first] = -tbl[k][np] / tbl[k][second]; - if (dist_ub[first] < dist_lb[first]) - return (0); - } - } /* end dim 2 case */ - return (1); -} - - -/*****************************************************************/ -/* set_vec check the previous state of the troub and val vectors */ -/* to see if a previous index computation has determined values */ -/* for the i-th induction var that differ from the current one. */ -/* if a val of zero is set troub[i] is set to -99 as a reminder. */ -/*****************************************************************/ -void set_vec(i, vec, troub, val) -int i; -int vec[], troub[]; -int val; -{ - if ((vec[i] != 0) || (troub[i] == -99)) { - if (vec[i] != val) - troub[0] = 1; - if (val == 0) - troub[i] = -99; - } - else if (((val < 0) && (troub[i] == ZPLUS)) || - ((val > 0) && (troub[i] == ZMINUS)) || - ((val == 0) && ((troub[i] == PLUS) || (troub[i] == MINUS))) - ) - troub[0] = 1; - else { - vec[i] = val; - if (val == 0) - troub[i] = -99; - else - troub[i] = 0; - } -} - -void set_troub(i, vec, troub, val) -int i; -int vec[], troub[]; -int val; -{ - switch (val) { - case PLUS: - if ((vec[i] < 0) || (troub[i] == -99) || - (troub[i] == ZMINUS)) - troub[0] = 1; - break; - case MINUS: - if ((vec[i] > 0) || (troub[i] == -99) || - (troub[i] == ZPLUS)) - troub[0] = 1; - break; - case ZPLUS: - if ((vec[i] < 0) || (troub[i] == MINUS)) - troub[0] = 1; - break; - case ZMINUS: - if ((vec[i] > 0) || (troub[i] == PLUS)) - troub[0] = 1; - break; - case PLUSMINUS: /* does not invalidate anything! */ - break; - default: - troub[i] = val; - } - if ((troub[i] == NODEP) && (vec[i] == 0)) - troub[i] = val; -} - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db.c deleted file mode 100644 index 90e4faf..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db.c +++ /dev/null @@ -1,2308 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * db.c: * - * * - * contains miscellaneous routines to handle inquiries to the * - * program date base. Supposed to be a higher level interface * - * * - ****************************************************************/ - -#include -#include - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -#include "db.h" - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -extern void removeFromCollection(void *pointer); -#endif - -/* - * external references - */ -extern int debug; -extern int language; - -int read_nodes(); -int test_mod_ref(); /* in "mod_ref.c" */ -int check_ref(); -void build_ref(), - visit_llnd(); - -char *(* unparse_bfnd)(); /* routine to unparse BIF nodes */ -char *(* unparse_llnd)(); /* routine to unparse Low level nodes */ -char *(* unparse_symb)(); /* routine to unparse Symbol nodes */ -char *(* unparse_type)(); /* routine to unparse Type nodes */ -void readnodes(); -void gen_udchain(); -void dump_udchain(); -PTR_BLOB alloc_blob(); -PTR_BLOB1 make_blob1(); -PTR_INFO make_obj_info(); - -PTR_BFND make_bfnd(); -PTR_TYPE make_type(); -PTR_SYMB make_symb(); - -char *funparse_bfnd(), /* bif nodes unparser for Fortran */ - *funparse_blck(), /* unparse the whole block for Fortran */ - *funparse_llnd(), /* ll nodes unparser for Fortran */ - *funparse_symb(), /* symbol nodes unparser for Fortran */ - *funparse_type(), /* type nodes unparser for Fortran */ - *cunparse_bfnd(), /* bif nodes unparser for C */ - *cunparse_blck(), /* unparse the whole block for C */ - *cunparse_llnd(), /* ll nodes unparser for C */ - *cunparse_symb(), /* symbol nodes unparser for C */ - *cunparse_type(); /* type nodes unparser for C */ - -/* - * Global variables to be shared by other routines - */ - -/* - * Here we put unparsers of various kind of nodes into an array - * indexed by the language type: - * - * (*UnparseBfnd[ForSrc])(); calls the bif node unparser for Fortran - * (*UnparseBfnd[CSrc])(); calls the bif node unparser for C - */ - -/* typedef char *(*PCF)(); */ - -PCF UnparseBfnd[] = { - funparse_bfnd, - cunparse_bfnd -}; - -PCF UnparseBlock[] = { - funparse_blck, - cunparse_blck -}; - -PCF UnparseLlnd[] = { - funparse_llnd, - cunparse_llnd -}; - -PCF UnparseSymb[] = { - funparse_symb, - cunparse_symb -}; - -PCF UnparseType[] = { - funparse_type, - cunparse_type -}; - - -/* - * global variables - */ -PTR_BLOB head_proj; /* pointer to the project header */ -PTR_PROJ cur_proj = NULL; /* point to the current active project */ -PTR_FILE cur_file = NULL; /* point to the current active file */ -char db_err_msg[100]; - - -/* - * local variables - */ -static PTR_HASH hash_table[hashMax]; -static PTR_BLOB1 obj, tail; -static int skip_rest = 0; /* set to 1 if one proc/func ref found in llnd */ - -/* - * last_char returns the last character of the given NON-EMPTY string - */ -static char -last_char(s) - register char *s; -{ - while (*s++); - return *(s-2); -} - - -/**************************************************************** - * * - * init_hash -- initialize the hash table * - * * - * Input: * - * hash_tbl - pointer to the hash table to be initializes * - * * - ****************************************************************/ -/*static void -init_hash(hash_tbl) - PTR_HASH hash_tbl[]; -{ - register int i = hashMax; - register PTR_HASH *p = hash_tbl; - - for (; i; --i) - *p++ = (PTR_HASH) NULL; -}*/ - - -/**************************************************************** - * * - * hash -- computes the hash value of a given string * - * * - * Input: * - * str - a character string * - * * - * Output: * - * an integer representing the hash value of the * - * given string * - * * - ****************************************************************/ -static int -hash(str) - register char *str; -{ - register int i; - - for (i = 0; *str;) - i += *str++; - return (i % hashMax); -} - - -/**************************************************************** - * * - * insert_hash -- insert the given symbol table entry into * - * the hash table * - * input: * - * symb - the symbol entry to be inserted * - * head_hash - start of hash table * - * * - ****************************************************************/ -static void -insert_hash(symb, head_hash) - register PTR_SYMB symb; - PTR_HASH head_hash[]; -{ - int index; - PTR_HASH entry; - - index = hash(symb->ident); - if ((entry = (PTR_HASH)calloc(1, sizeof(struct hash_entry))) != 0) - { -#ifdef __SPF - addToCollection(__LINE__, __FILE__,entry, 0); -#endif - entry->id_attr = symb; - entry->next_entry = head_hash[index]; - head_hash[index] = entry; - } - else - (void)strcpy(db_err_msg, "No more space"); -} - - -/**************************************************************** - * * - * build_hash -- build the hash table for all symbols in the * - * project * - * * - * Inputs: * - * head_symb - starting point of the symbol entries * - * head_hash - starting point of the hash table * - * * - ****************************************************************/ -static void -build_hash(head_symb, head_hash) - PTR_SYMB head_symb; - PTR_HASH head_hash[]; -{ - register PTR_SYMB s; - - for (s = head_symb; s; s = s->thread) - insert_hash(s, head_hash); -} - - -/**************************************************************** - * * - * append_blob1_nd -- append b2 to the end of b1 * - * * - * Inputs: * - * b1 - head of the blob1 list * - * b2 - second list to be appended to b1 * - * * - * Output: * - * a blob1 list with b2 appended to end of b1 * - * * - ****************************************************************/ -static PTR_BLOB1 -append_blob1_nd(b1, b2) - PTR_BLOB1 b1, b2; -{ - if (b1) { - register PTR_BLOB1 p, q; - - for (p=b1; p; p = p->next) /* skip to the end of b1 */ - q = p; - q->next = b2; - } else - b1 = b2; - return b1; -} - - -/**************************************************************** - * * - * insert_info_nd -- insert an info node to the return list * - * * - * Input: * - * new - new info node to be added to the list * - * * - * Side Effects: * - * The new node was added to the end of list pointed * - * to by the global variable "tail". It changes the * - * global variable "obj", too, if the list was empty * - * * - ****************************************************************/ -static void -insert_info_nd(new) - PTR_BLOB1 new; -{ - if (obj == NULL) - obj = tail = new; - else { - tail->next = new; - tail = new; - } -} - - -/**************************************************************** - * * - * check_llnd -- traverse the given low level node "llnd" * - * for the USE or MOD information about the * - * symbol "var_name" * - * * - * Inputs: * - * bf - bif node * - * llnd - the low level node to be searched * - * type - type of information wanted * - * var_name - the given variable name * - * * - * Side effect: * - * add a new obj_info node to the reference list * - * * - ****************************************************************/ -static void -check_llnd(bf, llnd, type, var_name) - PTR_BFND bf; - PTR_LLND llnd; - int type; - char *var_name; -{ - if (llnd == NULL) return; - - switch (llnd->variant) { - case LABEL_REF: - break; - case CONST_REF: - case VAR_REF : - case ARRAY_REF: - if(check_ref(llnd->entry.Template.symbol->id) == 0) - ; - build_ref(llnd->entry.Template.symbol, bf); - break; - case CONSTRUCTOR_REF: - break; - case ACCESS_REF: - break; - case CONS: - break; - case ACCESS: - break; - case IOACCESS : - break; - case PROC_CALL: - case FUNC_CALL: - visit_llnd(bf,llnd->entry.proc.param_list); - break; - case EXPR_LIST: - visit_llnd(bf,llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bf,llnd->entry.list.next); - break; - case EQUI_LIST: - visit_llnd(bf,llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bf,llnd->entry.list.next); - break; - case COMM_LIST: - if (llnd->entry.Template.symbol) { - /* addstr(llnd->entry.Template.symbol->ident); - */ - } - visit_llnd(bf,llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bf,llnd->entry.list.next); - break; - case VAR_LIST : - case RANGE_LIST: - case CONTROL_LIST: - visit_llnd(bf,llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bf,llnd->entry.list.next); - break; - case DDOT: - visit_llnd(bf,llnd->entry.binary_op.l_operand); - if (llnd->entry.binary_op.r_operand) - visit_llnd(bf,llnd->entry.binary_op.r_operand); - break; - case DEF_CHOICE: - case SEQ: - visit_llnd(bf,llnd->entry.seq.ddot); - if (llnd->entry.seq.stride) - visit_llnd(bf,llnd->entry.seq.stride); - break; - case SPEC_PAIR: - visit_llnd(bf,llnd->entry.spec_pair.sp_label); - visit_llnd(bf,llnd->entry.spec_pair.sp_value); - break; - case EQ_OP: - case LT_OP: - case GT_OP: - case NOTEQL_OP: - case LTEQL_OP: - case GTEQL_OP: - case ADD_OP: - case SUBT_OP: - case OR_OP: - case MULT_OP: - case DIV_OP: - case MOD_OP: - case AND_OP: - case EXP_OP: - case CONCAT_OP: - visit_llnd(bf,llnd->entry.binary_op.l_operand); - visit_llnd(bf,llnd->entry.binary_op.r_operand); - break; - case MINUS_OP: - case NOT_OP: - visit_llnd(bf,llnd->entry.unary_op.operand); - break; - case STAR_RANGE: - break; - default: - break; - } -} - - -/**************************************************************** - * * - * proc_ref_in_llnd -- recursively traverses the given low level* - * node to find all procedures or functions * - * references in it * - * * - * Input: * - * fi - the file obj where this bif node belongs to * - * bif - the bif node where the llnd belongs * - * ll - the low level node to be checked * - * * - * Side Effect: * - * a blob1 list that contains all the call sites under * - * the node "ll" is put on the GLOBAL variable "obj". * - * * - ****************************************************************/ -static void -proc_ref_in_llnd(fi, bif, ll) - PTR_FILE fi; - PTR_BFND bif; - PTR_LLND ll; -{ - if (ll == NULL) - return; - - if (ll->variant == FUNC_CALL || ll->variant == PROC_CALL || ll->variant == FUNCTION_REF) { - PTR_INFO inf; - char *bp, *t; - - t = (UnparseBfnd[language])(bif); - skip_rest = 1; - bp = malloc(strlen(t) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,bp, 0); -#endif - (void) strcpy(bp, t); - inf = make_obj_info(fi->filename, bif->g_line, bif->l_line, bp); - insert_info_nd(make_blob1(IsObj, inf, NULL)); - return; - } - - /* NOTE: the following code is "tag" dependent */ - if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) { - if (! skip_rest) - proc_ref_in_llnd(fi, bif, ll->entry.Template.ll_ptr1); - if (! skip_rest) - proc_ref_in_llnd(fi, bif, ll->entry.Template.ll_ptr2); - } -} - - -/**************************************************************** - * * - * find_proc_call -- recursively traverses the given bif node * - * to find all procedures or functions calls * - * in it. * - * * - * Inputs: * - * fi - the file obj where this bif node belongs to * - * bif - the bif node to be checked * - * * - * Side effect: * - * a blob1 list that contains all the call sites under * - * the node " bif", i.e. itself and all its subtree is * - * put on the "global" variable "obj" * - * * - ****************************************************************/ -static void -find_proc_call(fi, bif) - PTR_FILE fi; - PTR_BFND bif; -{ - char buf[200], *bp, *tmp, *t; - PTR_INFO inf; - PTR_BLOB bl; - - if (bif == NULL) - return; - - bp = buf; - switch (bif->variant) { - case GLOBAL: - case PROG_HEDR: - case PROC_HEDR: - case FUNC_HEDR: - case BASIC_BLOCK: - case ARITHIF_NODE: - case LOGIF_NODE: - case LOOP_NODE: - case FOR_NODE: - case WHILE_NODE: - case CDOALL_NODE: - case SDOALL_NODE: - if (!skip_rest) - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr1); - if (!skip_rest) - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr2); - if (!skip_rest) - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr3); - for (bl = bif->entry.Template.bl_ptr1; bl; bl = bl->next) { - skip_rest = 0; - find_proc_call(fi, bl->ref); - } - break; - case IF_NODE: - case ELSEIF_NODE: - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr1); - for (bl = bif->entry.Template.bl_ptr1; bl; bl = bl->next) { - skip_rest = 0; - find_proc_call(fi, bl->ref); - } - for (bl = bif->entry.Template.bl_ptr2; bl; bl = bl->next) { - skip_rest = 0; - find_proc_call(fi, bl->ref); - } - break; - case PROC_STAT: /* this is a procedure call */ - case FUNC_CALL: /* this is a function call */ - t = tmp = (UnparseBfnd[language])(bif); - bp = malloc(strlen(t) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,bp, 0); -#endif - (void) strcpy(bp, t); -#ifdef __SPF - removeFromCollection(tmp); -#endif - free(tmp); - inf = make_obj_info(fi->filename, bif->g_line, bif->l_line, bp); - insert_info_nd(make_blob1(IsObj, inf, NULL)); - break; - default: - if (!skip_rest) - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr1); - if (!skip_rest) - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr2); - if (!skip_rest) - proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr3); - skip_rest = 0; - break; - } -} - - -/**************************************************************** - * * - * proc_ref_llnd -- recursively traverses the given low level * - * node to find all procedures or functions * - * references in it * - * * - * Input: * - * fi - the file obj where this bif node belongs to * - * bif - the bif node where the llnd belongs * - * ll - the low level node to be checked * - * * - * Output: * - * a blob1 list that contains all the call sites under * - * the node "ll" * - * * - ****************************************************************/ -static PTR_BLOB1 -proc_ref_llnd(fi, bif, ll) - PTR_FILE fi; - PTR_BFND bif; - PTR_LLND ll; -{ - PTR_BLOB1 bl = NULL; - - if (ll) { - if (ll->variant == FUNC_CALL || ll->variant == PROC_CALL || ll->variant == FUNCTION_REF) { - char *bp, *t; - PTR_INFO inf; - - t = ll->entry.Template.symbol->ident; - bp = malloc(strlen(t) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,bp, 0); -#endif - (void) strcpy(bp, t); - inf = make_obj_info(fi->filename, bif->g_line, bif->l_line, bp); - bl = make_blob1(IsObj, inf, NULL); - } - - /* NOTE: the following code is "tag" dependent */ - if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) { - PTR_BLOB1 n; - - n = proc_ref_llnd(fi, bif, ll->entry.Template.ll_ptr1); - if (n) /* there are proc references in llnd1 */ - { - if (bl) - bl->next = n; - else - bl = n; - } - n = proc_ref_llnd(fi, bif, ll->entry.Template.ll_ptr2); - if (n) /* there are proc references in llnd2 */ - { - if (bl) - { - register PTR_BLOB1 p, q; - - for (p = bl; p; p = p->next) /* skip to the end of list */ - q = p; - q->next = n; - } - else - bl = n; - } - } - } - return bl; -} - - -/**************************************************************** - * * - * ext_proc_call -- recursively traverse the given bif node to * - * find all procedure or functions calls * - * inside a block (basic, loop, if-then-else) * - * * - * Inputs: * - * fi - the file obj where this bif node belongs to * - * bl - the blob chain to be checked * - * * - * Output: * - * a blob1 list that contains all the call sites inside * - * loops in the node "bif", i.e. itself and all its * - * subtree * - * * - ****************************************************************/ -static PTR_BLOB1 -ext_proc_call(fi, bl) - PTR_FILE fi; - PTR_BLOB bl; -{ - char *t; - PTR_INFO inf; - PTR_BLOB b; - PTR_BFND bf; - PTR_BLOB1 obj, tail, new, n1, n2; - - obj = tail = NULL; - for (b = bl; b; b = b->next) { - bf = b->ref; - switch(bf->variant) { - case PROC_STAT: - case FUNC_CALL: - t = malloc(strlen(bf->entry.Template.symbol->ident) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,t, 0); -#endif - (void) strcpy(t, bf->entry.Template.symbol->ident); - inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, t); - new = make_blob1(IsObj, inf, NULL); - if (obj == NULL) - obj = tail = new; - else { - tail->next = new; - tail = new; - } - break; - case LOOP_NODE: - case FOR_NODE: - case WHILE_NODE: - case PARFOR_NODE: - case PAR_NODE: - n1 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); - if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr2))) - n1 = append_blob1_nd(n1, n2); - if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr3))) - n1 = append_blob1_nd(n1,n2); - if ((n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr1))) - n1 = append_blob1_nd(n1, n2); - - if (n1) { - PTR_INFO inf1; - - inf1 = make_obj_info(fi->filename, bf->g_line, bf->l_line, "loop"); - n2 = make_blob1(IsObj, inf1, n1); - new = make_blob1(IsLnk, (PTR_INFO)n2, NULL); - if (obj == NULL) - obj = tail = new; - else { - tail->next = new; - tail = new; - } - } - break; - case CDOALL_NODE: - case SDOALL_NODE: - n1 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); - if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr2))) - n1 = append_blob1_nd(n1, n2); - if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr3))) - n1 = append_blob1_nd(n1,n2); - if ((n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr2))) - n1 = append_blob1_nd(n1, n2); - if (n1) { - PTR_INFO inf1; - - inf1 = make_obj_info(fi->filename, bf->g_line, bf->l_line, "loop"); - n2 = make_blob1(IsObj, inf1, n1); - new = make_blob1(IsLnk, (PTR_INFO)n2, NULL); - if (obj == NULL) - obj = tail = new; - else { - tail->next = new; - tail = new; - } - } - break; - case IF_NODE: - case ELSEIF_NODE: - n1 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); - if ((n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr1))) - n1 = append_blob1_nd(n1, n2); - n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr2); - if (n1) { /* if the true branch has proc call */ - n1 =append_blob1_nd(n1, n2); - } else { /* if no proc call in true branch */ - if (n2) /* but some in false branch */ - n1 = n2; - } - if (n1) { - PTR_INFO inf1; - - inf1 = make_obj_info(fi->filename, bf->g_line, bf->l_line, "if"); - n2 = make_blob1(IsObj, inf1, n1); - new = make_blob1(IsLnk, (PTR_INFO)n2, NULL); - if (obj == NULL) - obj = tail = new; - else { - tail->next = new; - tail = new; - } - } - break; - default: - new = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); - if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr2))) - new = append_blob1_nd(new, n2); - if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr3))) - new = append_blob1_nd(new, n2); - if (new) - { - if (obj == NULL) - obj = tail = new; - else - { - tail->next = new; - tail = new; - } - } - break; - } - } - return (obj); -} - -/**************************************************************** - * * - * open_file -- open the dep file "filename" * - * * - * Input: * - * filename -- the name of the dep file to be read in * - * * - * Output: * - * NON-NULL : a pointer to file_obj so as to be able * - * to access the information. * - * NULL : open failure * - * * - ****************************************************************/ -static PTR_FILE -open_file(filename) - char *filename; -{ - PTR_FILE f; - FILE *fid; - char *temp; - int l; - - l = strlen(filename); - temp = malloc(l + 5); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - (void)strcpy(temp, filename); - if ((fid = fopen(temp, "rb")) == NULL) { - register char *t = temp + l; - - *t++ = '.'; - *t++ = 'd'; - *t++ = 'e'; - *t++ = 'p'; - *t = '\0'; - if ((fid = fopen(temp, "rb")) == NULL) { - sprintf(db_err_msg, "OpenProj -- Cannot open file \"%s\"", filename); - return(NULL); - } - } - f = (PTR_FILE)calloc(1, sizeof(struct file_obj)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,f, 0); -#endif - if (f == NULL) { - (void)strcpy(db_err_msg, "open_file -- No more space"); - return(NULL); - } - - f->fid = fid; - if (read_nodes(f) < 0) - return NULL; - fclose(fid); - f->hash_tbl = (PTR_HASH *)calloc(hashMax, sizeof(PTR_HASH)); - if (f->hash_tbl == NULL) - { - (void)strcpy(db_err_msg, "open_file -- No more space"); - return(NULL); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,f->hash_tbl, 0); -#endif - build_hash(f->head_symb, f->hash_tbl); - /* the following line is for special testing routine - if (language == CSrc) - test_mod_ref(f->global_bfnd); - */ - gen_udchain(f); - if (debug) - dump_udchain(f); - return(f); -} - - -static void -dealloc(f) - PTR_FILE f; -{ - PTR_BLOB b, b1, b2; - - /* Delete all function entries from project's hash table */ - for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) - if (language == ForSrc || (language == CSrc && b->ref->variant == FUNC_HEDR)) - for (b1 = b2 = *(cur_proj->hash_tbl + hash(b->ref->entry.Template.symbol->ident)); b1; b1 = b1->next) - if (b1->ref == b->ref) { - b2 = b1->next; - break; - } - else - b2 = b1; - - /* clean up a little bit. This is by no means a thorough one */ - if (f->num_blobs) - { -#ifdef __SPF - removeFromCollection(f->head_blob); -#endif - free(f->head_blob); - } - - if (f->num_bfnds) - { -#ifdef __SPF - removeFromCollection(f->head_bfnd); -#endif - free(f->head_bfnd); - } - - if (f->num_llnds) - { -#ifdef __SPF - removeFromCollection(f->head_llnd); -#endif - free(f->head_llnd); - } - - if (f->num_symbs) - { -#ifdef __SPF - removeFromCollection(f->head_symb); -#endif - free(f->head_symb); - } - - if (f->num_types) - { -#ifdef __SPF - removeFromCollection(f->head_type); -#endif - free(f->head_type); - } - - if (f->num_dep) - { -#ifdef __SPF - removeFromCollection(f->head_dep); -#endif - free(f->head_dep); - } - - if (f->num_label) - { -#ifdef __SPF - removeFromCollection(f->head_lab); -#endif - free(f->head_lab); - } - - if (f->num_cmnt) - { -#ifdef __SPF - removeFromCollection(f->head_cmnt); -#endif - free(f->head_cmnt); - } - - if (f->num_files) - { -#ifdef __SPF - removeFromCollection(f->head_file); -#endif - free(f->head_file); - } - -#ifdef __SPF - removeFromCollection(f->hash_tbl); - removeFromCollection(f); -#endif - free(f->hash_tbl); - free(f); -} - - -/* this creates a new empty file with the given dep file name - and the given Language type. It tries to open the file and - returns 0 if it fails. If it finds a similar file in the - project it deletes it. It enters the file in the project. - returns 1 if it worked. - note this file has a global node, the standard types are defined, - and the default symbol is defined. -*/ - -int -new_empty_file(Language, filename) - int Language; /* 1 = CSrc or C++ and 0 = ForSrc */ - char *filename; -{ - PTR_FILE f; - /* FILE *fid; */ - char *temp; - int l; - /* PTR_SYMB star_symb; */ - PTR_BLOB b, b1; - /* PTR_BFND global_bfnd; */ - PTR_FNAME fname; - - l = strlen(filename); - temp = malloc(l+5); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,temp, 0); -#endif - (void) strcpy(temp, filename); - /* - if ((fid=fopen(temp, "w")) == NULL) { - register char *t = temp+l; - - *t++ = '.'; - *t++ = 'd'; - *t++ = 'e'; - *t++ = 'p'; - *t = '\0'; - if ((fid=fopen(temp, "w")) == NULL) { - sprintf(db_err_msg, "OpenProj -- Cannot create file \"%s\"", filename); - return(NULL); - } - } - */ - f = (PTR_FILE) calloc(1, sizeof(struct file_obj)); - if (f == NULL) { - (void)strcpy(db_err_msg, "open_file -- No more space"); - return(0); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,f, 0); -#endif - fname = (PTR_FNAME) calloc(1, sizeof(struct file_name)); - if (f == NULL) { - (void)strcpy(db_err_msg, "open_empty_file -- no more space"); - return 0; - }; -#ifdef __SPF - addToCollection(__LINE__, __FILE__,fname, 0); -#endif - f->num_files = 1; - f->head_file = fname; - fname->name = temp; - fname->id = 1; - - f->fid = NULL; - f->lang = Language; -/* fclose(fid); */ - f->hash_tbl = (PTR_HASH *) calloc(hashMax, sizeof(PTR_HASH)); - if (f->hash_tbl == NULL) { - (void)strcpy(db_err_msg, "open_file -- No more space"); - return(0); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,f->hash_tbl, 0); -#endif - build_hash(f->head_symb, f->hash_tbl); - /* global_int = (PTR_TYPE)*/ make_type(f, T_INT); - /* global_float = (PTR_TYPE)*/ make_type(f, T_FLOAT); - /* global_double = (PTR_TYPE)*/ make_type(f, T_DOUBLE); - /* global_char = (PTR_TYPE)*/ make_type(f, T_CHAR); - /* global_string = (PTR_TYPE)*/ make_type(f, T_STRING); - /* global_bool = (PTR_TYPE)*/ make_type(f, T_BOOL); - /* global_complex= (PTR_TYPE)*/ make_type(f, T_COMPLEX); - /* global_default= (PTR_TYPE)*/ make_type(f, DEFAULT); - /* global_void = (PTR_TYPE)*/ make_type(f, T_VOID); - /* global_void = (PTR_TYPE)*/ make_type(f, T_UNKNOWN); - /* DEFAULT is used for type */ - make_symb(f, DEFAULT, "*"); - f->global_bfnd = make_bfnd(f,GLOBAL, SMNULL, LLNULL, LLNULL, LLNULL); - f->global_bfnd->filename=fname; - f->filename = temp; - /* add it to the project */ - for (b = b1 = cur_proj->file_chain; b; b1 = b, b = b->next) - if (! strcmp(temp, ((PTR_FILE)b->ref)->filename)) - break; - if (b) /* if non-NULL, then already in the project */ - dealloc((PTR_FILE)b->ref); - if (b == NULL) { /* it's not in the project before */ - if ((b = alloc_blob()) == NULL) - return 0; - b1->next = b; /* add it to the end of the list */ - } - b->ref = (PTR_BFND) f; - return 1; -} - - -/**************************************************************** - * * - * AddToProj -- Add another file to the current project * - * * - * Input: * - * file -- file name to be added to the project * - * * - * Output: * - * 1 if everything ok * - * 0 if something wrong * - * * - ****************************************************************/ -int -AddToProj(file) - char *file; -{ - char tmp[50], *p = tmp, *q = file; - PTR_BLOB b, b1, new; - PTR_FILE f; - int index; - - while ((*p++ = *q++) != '.'); /* simple-minded copy*/ - *p++ = 'd'; - *p++ = 'e'; - *p++ = 'p'; - *p++ = '\0'; - for (b = b1 = cur_proj->file_chain; b; b1 = b, b = b->next) - if (!strcmp(file, ((PTR_FILE)b->ref)->filename)) - break; - if (b) /* if non-NULL, then already in the project */ - dealloc((PTR_FILE)b->ref); - if ((f = open_file(tmp)) == NULL) - return 0; - if (b == NULL) { /* it's not in the project before */ - if ((b = alloc_blob()) == NULL) - return 0; - b1->next = b; /* add it to the end of the list */ - } - b->ref = (PTR_BFND)f; - - /* Insert all procedures in this file into current project's hash table */ - for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) { - if (language == ForSrc || - (language == CSrc && b->ref->variant == FUNC_HEDR)) { - index = hash(b->ref->entry.Template.symbol->ident); - if ((new = (PTR_BLOB)calloc(1, sizeof(struct blob))) != 0) - { - new->ref = b->ref; /* point to the procedure's bif node */ - new->next = *(cur_proj->hash_tbl + index); - *(cur_proj->hash_tbl + index) = new; - -#ifdef __SPF - addToCollection(__LINE__, __FILE__,new, 0); -#endif - } - else - { - (void)strcpy(db_err_msg, "open_proj_file -- No more space"); - return 0; - } - } - } - return 1; -} - - -/**************************************************************** - * * - * DelFromProj -- Delte the file from the current project * - * * - * Input: * - * file -- file name to be deleted * - * * - * Output: * - * 1 if everything ok * - * 0 if something wrong * - * * - ****************************************************************/ -int -DelFromProj(file) - char *file; -{ - PTR_BLOB b, b1; - - for (b = b1 = cur_proj->file_chain; b; b1 = b, b = b->next) - if (! strcmp(file, ((PTR_FILE)b->ref)->filename)) - break; - if (b) { /* if non-NULL, then it's in the project */ - dealloc((PTR_FILE)b->ref); - b1->next = b->next; - return 1; - } else - return 0; -} - - -/**************************************************************** - * * - * open_proj_files -- open all the files in a given project * - * * - * Input: * - * proj -- pointer to the project object * - * no -- number of files in the project * - * file_list -- list of file names in the project * - * * - * Output: * - * 1 if everything ok * - * 0 if something wrong * - * * - ****************************************************************/ -static int -open_proj_file(proj, no, file_list) - PTR_PROJ proj; - int no; - char **file_list; -{ - int i, index; - PTR_BLOB b, new; - PTR_FILE f; - char **fp; - - fp = file_list; /* points to start of the list */ - for (i = 1; i <= no; i++) { - if ((f = open_file(*fp++)) != NULL) - { - b = alloc_blob(); - if (b == NULL) - { - (void)strcpy(db_err_msg, "open_proj_file: alloc_blob failed"); - return 0; - } - b->ref = (PTR_BFND)f; /* NOT a bif node, but ... */ - b->next = proj->file_chain; - proj->file_chain = b; - - /* Insert all procedures into the project's hash table */ - for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) - { - if (language == ForSrc || (language == CSrc && b->ref->variant == FUNC_HEDR)) - { - index = hash(b->ref->entry.Template.symbol->ident); - if ((new = (PTR_BLOB)calloc(1, sizeof(struct blob))) != 0) - { - new->ref = b->ref; /* point to the procedure's bif node */ - new->next = *(proj->hash_tbl + index); - *(proj->hash_tbl + index) = new; -#ifdef __SPF - addToCollection(__LINE__, __FILE__,new, 0); -#endif - } - else - { - (void)strcpy(db_err_msg, "open_proj_file -- No more space"); - return 0; - } - } - } - } - else - { - (void)sprintf(db_err_msg, "OpenProj -- No such file \"%s\"\n", *(--fp)); - return 0; - } - } - return 1; -} - - - -/**************************************************************** - * * - * OpenProj -- open the project with list of files as * - * specified in the "file_list" * - * * - * Inputs: * - * pname -- the project name * - * no -- number of files in the project * - * file_list -- list of .dep files to be read in * - * * - * Output: * - * NON-NULL : a pointer to the project object so as to * - * be able to access the information. * - * NULL : open failure * - * * - ****************************************************************/ -PTR_PROJ -OpenProj(pname, no, file_list) - char *pname; - int no; - char **file_list; -{ - PTR_BLOB b; - PTR_PROJ p; - - /* First allocate a project structure to it */ - if ((p = (PTR_PROJ)calloc(1, sizeof(struct proj_obj))) == NULL) - return NULL; - - p->proj_name = malloc(strlen(pname) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__, p->proj_name, 0); - addToCollection(__LINE__, __FILE__, p, 0); -#endif - (void)strcpy(p->proj_name, pname); - - /* Then insert it to the project chain */ - b = alloc_blob(); - b->ref = (PTR_BFND)p; /* NOT a bif node, but ... */ - b->next = head_proj; /* insert this project to */ - head_proj = b; /* ... the list */ - - cur_proj = p; /* Make it the current active project */ - p->hash_tbl = (PTR_BLOB *)calloc(hashMax, sizeof(PTR_BLOB)); - if (p->hash_tbl == NULL) - return NULL; -#ifdef __SPF - addToCollection(__LINE__, __FILE__, p->hash_tbl, 0); -#endif - - if (open_proj_file(p, no, file_list)) - return (p); - else - return NULL; -} - - -/**************************************************************** - * * - * SelectProj -- Select the project "proj_name" as active * - * project * - * * - * Inputs: * - * proj_name - the project's filename * - * * - * Output: * - * A PTR_PROJ that points to the selected project * - * object. Returns a NULL if the project didn't exit * - * * - ****************************************************************/ -PTR_PROJ -SelectProj(proj_name) - char *proj_name; -{ - PTR_BLOB b; - PTR_PROJ p; - - /* First search the project chain to find the one specified */ - for (b = head_proj; b; b = b->next) { - p = (PTR_PROJ) b->ref; - if(!strcmp(proj_name, p->proj_name)) - break; - } - - if (b == NULL) { - (void) sprintf(db_err_msg, "SelectProj -- no such project \"%s\"", proj_name); - return NULL; - } - - return (cur_proj = p); -} - - -/**************************************************************** - * * - * GetProjInfo -- get info about a given project from the data * - * base * - * * - * Inputs: * - * proj_name - the project's filename * - * info - type of info wanted. Could be one of * - * the followings: * - * ProjFiles, ProjNames, ProjGlobals, * - * ProjSrc or UnsolvRef * - * Output: * - * A blob1 list that contains the info inquired * - * * - * Side Effects: * - * It changes the global variables "obj" and "tail" * - * (by calling insert_info_nd) * - * * - ****************************************************************/ -PTR_BLOB1 -GetProjInfo(proj_name, info) - char *proj_name; - int info; -{ - PTR_BLOB b, bl; - PTR_INFO inf; - PTR_FILE f; - PTR_PROJ p; - - /* First search the project chain to find the one specified */ - for (b = head_proj; b; b = b->next) { - p = (PTR_PROJ) b->ref; - if(!strcmp(proj_name, p->proj_name)) - break; - } - - if (b == NULL) { - (void) sprintf(db_err_msg, "GetProjInfo -- no such project \"%s\"", proj_name); - return NULL; - } - - obj = tail = NULL; - - /* Then search the file chain inside the project */ - switch(info) { - case ProjFiles: - for (b = p->file_chain; b; b = b->next) { - f = (PTR_FILE) b->ref; - inf = make_obj_info(f->filename, 0, 0, NULL); - insert_info_nd(make_blob1(IsObj, inf, NULL)); - } - break; - case ProjSrc: - { - char *c_tab[100], /* for .c files */ - *h_tab[100], /* for .h files */ - *u_tab[100]; /* for .f and other unknow type files */ - char **c1, **c2, **h1, **h2, **u1, **u2, ch; - PTR_FNAME fp; - - c1 = c2 = c_tab; - u1 = u2 = u_tab; - h1 = h_tab; - - /* Scan through the file chain to gather all filenames */ - for (b = p->file_chain; b; b = b->next) - for (fp = ((PTR_FILE)b->ref)->head_file; fp; fp = fp->next) { - if ((ch =last_char(fp->name)) == 'c') - *c1++ = fp->name; - else if (ch == 'h') { - for (h2 = h_tab; h2 < h1; h2++) - if (!strcmp(fp->name, *h2)) - break; - if (h2 == h1) - *h1++ = fp->name; - } - else - *u1++ = fp->name; - } - - /* Now link them all together */ - while (c2 < c1) - insert_info_nd(make_blob1(IsObj, make_obj_info(*c2++, 0, 0, NULL), NULL)); - - h2 = h_tab; - while (h2 < h1) - insert_info_nd(make_blob1(IsObj, make_obj_info(*h2++, 0, 0, NULL), NULL)); - - while (u2 < u1) - insert_info_nd(make_blob1(IsObj, make_obj_info(*u2++, 0, 0, NULL), NULL)); - } - break; - case ProjNames: - for (b = p->file_chain; b; b = b->next) { - f = (PTR_FILE) b->ref; - for(bl = f->global_bfnd->entry.Template.bl_ptr1; bl; bl = bl->next) { - PTR_BFND bf; - char * ch; - if (language == ForSrc || - (language == CSrc && bl->ref->variant==FUNC_HEDR)) { - bf = bl->ref; - ch = (UnparseBfnd[language])(bf); - inf = make_obj_info(bf->filename->name, bf->g_line, bf->l_line, ch); - insert_info_nd(make_blob1(IsObj, inf, NULL)); - } - } - } - break; - case ProjGlobals: /* WARNING -- C languag specific */ - if (language == CSrc) - for (b = p->file_chain; b; b = b->next) { - f = (PTR_FILE) b->ref; - for(bl = f->global_bfnd->entry.Template.bl_ptr1; bl; bl = bl->next) { - PTR_BFND bf; - - if (bl->ref->variant != FUNC_HEDR) { - bf = bl->ref; - inf = make_obj_info(bf->filename->name, bf->g_line, bf->l_line, - (UnparseBfnd[language])(bf)); - insert_info_nd(make_blob1(IsObj, inf, NULL)); - } - } - } - break; - case UnsolvRef: - obj = NULL; - for (b = p->file_chain; b; b = b->next) { - f = (PTR_FILE) b->ref; - } - break; - } - return obj; -} - - -/**************************************************************** - * * - * GetProcInfo -- get info about a given procedure from the * - * data base * - * * - * Input: * - * proc_name - the procedure's filename * - * info - type of info wanted. Could be one of * - * the followings: * - * ProcDef, Mod, Use, Alias, CallSite, * - * ExternProc, or CallSiteE * - * Output: * - * A blob1 list that contains the info inquired * - * * - ****************************************************************/ -PTR_BLOB1 -GetProcInfo(proc_name, info) - char *proc_name; - int info; -{ - int i; - char buf[1000], *bp, *tmp, *t; - PTR_PROJ proj; - PTR_FILE fi; - PTR_INFO inf; - PTR_BLOB bl; - PTR_BFND bf, bf1; - PTR_SYMB s; - PTR_LLND tp; - - /* First search for the hash table to find the procedure bif node */ - proj = cur_proj; - i = hash(proc_name); - for (bl = *(proj->hash_tbl + i); bl; bl = bl->next) - if (!strcmp(bl->ref->entry.Template.symbol->ident, proc_name)) - break; /* find it */ - - if (bl == NULL) /* no such procedures or functions */ - return NULL; - - bf = bl->ref; /* get the procedure header */ - bf1 = bf->control_parent; /* should get the global_bfnd */ - fi = (PTR_FILE)bf1->control_parent; /* the file_info node */ - obj = tail = NULL; - switch (info) { - case ProcDef: - bp = buf; /* reset the pointer */ - bf1 = bf->control_parent; /* should get the global_bfnd */ - fi = (PTR_FILE)bf1->control_parent; /* the file_info node */ - t = tmp = (UnparseBfnd[language])(bf); /* unparse the proc node */ - while ((*bp = *t++) != 0) /* save to the output area */ - bp++; -#ifdef __SPF - removeFromCollection(tmp); -#endif - free(tmp); - s = bf->entry.Template.symbol; /* symbol node of the proc */ - - /* Now trace down its parameter declaration */ - for (s = s->entry.proc_decl.in_list; s; s = s->entry.var_decl.next_in) { - tmp = t = (UnparseSymb[language])(s); - while ((*bp = *t++) != 0) - bp++; -#ifdef __SPF - removeFromCollection(tmp); -#endif - free(tmp); - } - *bp = '\0'; /* Mark end of string */ - bp = malloc(strlen(buf) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,bp, 0); -#endif - (void)strcpy(bp, buf); - inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, bp); - return(make_blob1(IsObj, inf, NULL)); - case Mod: - tp = bf->entry.Template.ll_ptr2; - if (tp->entry.Template.ll_ptr2 != NULL) - tp = tp->entry.Template.ll_ptr2; - inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, - (UnparseLlnd[language])(tp)); - return(make_blob1(IsObj, inf, NULL)); - case Use: - tp = bf->entry.Template.ll_ptr3; - if (tp->entry.Template.ll_ptr2 != NULL) - tp = tp->entry.Template.ll_ptr2; - inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, - (UnparseLlnd[language])(tp)); - return(make_blob1(IsObj, inf, NULL)); - case Alias: - break; - case CallSite: - bf = bl->ref; - for (bl = bf->entry.Template.bl_ptr1; bl; bl = bl->next) - find_proc_call(fi, bl->ref); - skip_rest = 0; - return obj; - case ExternProc: - break; - case CallSiteE: - bp = malloc(strlen(bf->entry.Template.symbol->ident) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,bp, 0); -#endif - (void)strcpy(bp, bf->entry.Template.symbol->ident); - inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, bp); - return (make_blob1(IsObj, inf, ext_proc_call(fi, bf->entry.Template.bl_ptr1))); - default: - (void)strcpy(db_err_msg, "GetProcInfo -- No such info available"); - break; - } - return NULL; -} - - -/**************************************************************** - * * - * GetVarInfo -- get info about a given variable from the data * - * base * - * * - * Inputs: * - * var_name - the variable's name * - * info - type of info wanted. Could be one of the * - * following: Use, Mod, UseMod and Alias * - * proc_name - specifies the procedure you want to * - * check. If it's NULL, then all instances * - * of the "var_name" will be returned * - * Output: * - * A blob1 list that contains the info inquired * - * * - ****************************************************************/ -PTR_BLOB1 -GetVarInfo(var_name, info, proc_name) - char *var_name; - int info; - char *proc_name; -{ - int i; - PTR_HASH p; - PTR_BFND bif; - PTR_BLOB bl; - - /* First, get the symbol table entry */ - i = hash(var_name); - for (p = hash_table[i]; p ; p = p->next_entry) - if(!strcmp(var_name, p->id_attr->ident)) - break; - if (p == NULL) /* no such variable */ - return(NULL); - - /* Then for its ud_chain */ - for (bl = p->id_attr->ud_chain; bl; bl = bl->next) { - bif = bl->ref; - switch(bif->variant) { - case PROG_HEDR: - case PROC_HEDR: - case FUNC_HEDR: - break; - case CDOALL_NODE: - case FOR_NODE: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check range */ - check_llnd(bif, bif->entry.Template.ll_ptr2, Use, var_name); /* check incr */ - check_llnd(bif, bif->entry.Template.ll_ptr3, Use, var_name); /* where cond */ - break; - case WHILE_NODE: - case WHERE_NODE: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ - break; - case IF_NODE: - case ELSEIF_NODE: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ - break; - case LOGIF_NODE: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ - break; - case ARITHIF_NODE: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ - break; - case ASSIGN_STAT: - case IDENTIFY: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check l_val */ - check_llnd(bif, bif->entry.Template.ll_ptr2, Use, var_name); /* check r_val */ - break; - case PROC_STAT: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check l_val */ - break; - case ASSGOTO_NODE: - case COMGOTO_NODE: - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check l_val */ - break; - case VAR_DECL: - case PARAM_DECL: - case DIM_STAT: - case EQUI_STAT: - case DATA_DECL: - case IMPL_DECL: - /* for type decl chain - check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); - break; - */ - case READ_STAT: - case WRITE_STAT: - break; - case STOP_STAT: - case OTHERIO_STAT: - case COMM_STAT: - case CONT_STAT: - case FORMAT_STAT: - case GOTO_NODE: - case CONTROL_END: - break; - default: - break; - } - } - return(NULL); -} - - -/**************************************************************** - * * - * GetTypeInfo -- get a list of variables of a given type from * - * the data base * - * * - * Input: * - * type_name - the type's name * - * proc_name - specifies the procedure you want to * - * check. If it's NULL, then all instances * - * of the "var_name" will be returned * - * Output: * - * A blob1 list that contains the info inquired * - * * - ****************************************************************/ -PTR_BLOB1 -GetTypeInfo(type_name, proc_name) - char *type_name; - char *proc_name; -{ - return NULL; -} - - -/**************************************************************** - * * - * GetTypeDef -- Get definition about a given type from * - * the data base * - * * - * Input: * - * type_name - the type's name * - * proc_name - specifies the procedure you want to * - * check. If it's NULL, then all instances * - * of the "var_name" will be returned * - * Output: * - * A blob1 list that contains the info inquired * - * * - ****************************************************************/ -PTR_BLOB1 -GetTypeDef(type_name, proc_name) - char *type_name; - char *proc_name; -{ - int i; - char *c; - PTR_BLOB bl; - PTR_BLOB1 bl1 = NULL, bl2; - PTR_BFND bf; - PTR_FILE f; - PTR_HASH p; - - if (proc_name) { /* if procedure name was specified */ - i = hash(proc_name); - for (bl = *(cur_proj->hash_tbl + i); bl; bl = bl->next) - if (!strcmp(proc_name, bl->ref->entry.Template.symbol->ident)) - break; /* find it */ - if (bl == NULL) { - (void) sprintf(db_err_msg,"GetTypeDef -- no such procedure \"%s\"",proc_name); - return NULL; - } - bf = bl->ref->control_parent; /* should get the global bif node */ - f = (PTR_FILE)bf->control_parent; /* get the file info node */ - i = hash(type_name); - for (p = *(f->hash_tbl + i); p; p = p->next_entry) - if( /* p->id_attr->variant == TYPE_NAME && */ - !strcmp(type_name, p->id_attr->ident)) { - c = (*unparse_type)(p->id_attr->type); - return (make_blob1(IsObj, make_obj_info(proc_name, 0, 0, c), NULL)); - } - (void) sprintf(db_err_msg, "GetTypeDef -- No such type \"%s\"",type_name); - return NULL; - } else { /* procedure name not specified */ - for (bl = cur_proj->file_chain; bl; bl = bl->next) { - f = (PTR_FILE)bl->ref; - i = hash(type_name); - for (p = *(f->hash_tbl + i); p; p = p->next_entry) - if( /* p->id_attr->variant == TYPE_NAME && */ - !strcmp(type_name, p->id_attr->ident)) { - c = (*unparse_type)(p->id_attr->type); - bl2 = make_blob1(IsObj, - make_obj_info(p->id_attr->scope->entry.Template.symbol->ident, 0, 0, c), - NULL); - if (bl1) { - bl2->next = bl1; - bl1 = bl2; - } else - bl1 = bl2; - } - } - return bl1; - } -} - -/**************************************************************** - * * - * rec_num_search -- recursively search for the bif node that * - * corresponds to the num'th line in the * - * file fname * - * * - * Inputs: * - * bf - the bif node that will be searched * - * num - line number * - * fname - filename to be checked against * - * * - * Output: * - * The bif node pointer if one exists for the given line * - * in the given file * - * * - ****************************************************************/ -PTR_BFND -rec_num_search(bf,num,fname) - PTR_BFND bf; - int num; - char *fname; -{ - if (!strcmp(bf->filename->name, fname) && bf->g_line == num) - return(bf); - else{ - PTR_BLOB b; - PTR_BFND rv; - - for (b = bf->entry.Template.bl_ptr1; b; b = b->next) - if( (rv = rec_num_search(b->ref,num,fname)) != NULL) - return(rv); - - for (b = bf->entry.Template.bl_ptr2; b; b = b->next) - if( (rv = rec_num_search(b->ref,num,fname)) != NULL) - return(rv); - } - return(NULL); -} - - -/**************************************************************** - * * - * FindBifNode -- find the corresponding BIF node given a * - * filename and line number * - * * - * Input: * - * filename - name of the file to be looked upon * - * line - line number to be checked * - * * - * Output: * - * A bif pointer (PTR_BFND) points to the bif node * - * corresponds to the given line number * - * NULL if error occured * - * * - ****************************************************************/ -PTR_BFND -FindBifNode(filename, line) - char *filename; - int line; - -{ - PTR_PROJ p = cur_proj; - PTR_BFND bf = NULL; - PTR_BFND rec_num_search(); - PTR_BLOB b; - - for (b=p->file_chain; b; b = b->next) { - if(!strcmp(((PTR_FILE)b->ref)->filename, filename)) { - bf = ((PTR_FILE)b->ref)->head_bfnd; - break; - } - } - - if (!b) { - (void) sprintf(db_err_msg, "No such file \"%s\" in this project",filename); - return NULL; - } - return(rec_num_search(bf,line,filename)); -} - - -/**************************************************************** - * * - * bget_prop -- Get property named "pname" from the property * - * of a given bif node * - * * - * Inputs: * - * bf - bif pointer from which the property is to be * - * extracted * - * pname - property name in string * - * * - * Output: * - * value of the specified property * - * NULL if not found * - * * - ****************************************************************/ -char * -bget_prop(bf, pname) - PTR_BFND bf; - char *pname; -{ - register PTR_PLNK prop; - - for (prop = bf->prop_list; prop; prop = prop->next) - if (! strcmp(prop->prop_name, pname)) - return (prop->prop_val); - return (NULL); -} - - -/**************************************************************** - * * - * get_prop -- Get property named "pname" from a given * - * statement's property list * - * * - * Inputs: * - - * fname - name of the source file * - * line_no - line number of the statement * - * pname - property name in string * - * * - * Output: * - * value of the specified property * - * * - ****************************************************************/ -char * -get_prop(fname, line_no, pname) - char *fname; - int line_no; - char *pname; -{ - PTR_BFND bf; - - bf = FindBifNode(fname, line_no); - return (bf? bget_prop(bf, pname): NULL); -} - - -/**************************************************************** - * * - * put_prop -- Put property "prop" about a given statement to * - * the data base * - * * - * Inputs: * - * fname - name of the source file * - * line_no - line number of the statement * - * pname - property name in string * - * value - property value * - * * - * Output: * - * 0 - if no error occured * - * 1 - if error occured * - * * - ****************************************************************/ -int -put_prop(fname, line_no, pname, value) - char *fname; - int line_no; - char *pname; - char *value; -{ - PTR_BFND bf; - PTR_PLNK pr; - - bf = FindBifNode(fname, line_no); - if (bf) - { - if ((pr = (PTR_PLNK)malloc(sizeof(struct prop_link))) != 0) - { - pr->prop_name = pname; - pr->prop_val = value; - pr->next = bf->prop_list; - bf->prop_list = pr; -#ifdef __SPF - addToCollection(__LINE__, __FILE__,pr, 0); -#endif - return 0; - } - else - (void)strcpy(db_err_msg, "put_prop -- No more space"); - } - return 1; -} - - -static char *depstrs[] = { "flow","anti","output","huh??","got me?"}; -static char *dirstrs[] = { " ", "= ", "- ", "0-", "+ ", "0+", ". ", "+-"}; - -static PTR_BFND current_par_loop = NULL; - -static int -same_loop(from, to) - PTR_BFND from, to; -{ - PTR_BFND c; - c = from; - while(c != NULL && c->variant != GLOBAL && c != current_par_loop) - c = c->control_parent; - if(c != current_par_loop) return(0); - c = to; - while(c != NULL && c->variant != GLOBAL && c != current_par_loop) - c = c->control_parent; - if(c != current_par_loop) return(0); - return(1); -} - -static PTR_BLOB1 -search_deps(nb,q,depth) - PTR_BLOB1 nb; - PTR_BLOB q; - int depth; -{ - PTR_BFND bchild; - PTR_DEP d; - char *s; - PTR_BLOB1 lb = NULL, btmp; - - if (nb != NULL) lb = nb; - while (q != NULL) { - bchild = q->ref; - q = q->next; - d = bchild->entry.Template.dep_ptr1; - while (d != NULL) { - if ((d->symbol->type->variant == T_ARRAY && d->direct[depth] > 1) || - (d->type == 0 && d->direct[depth] > 1)) - if (same_loop(d->from.stmt, d->to.stmt)) { - btmp = (PTR_BLOB1)malloc(sizeof(struct blob1)); - if (nb == NULL) { nb = btmp; lb = btmp; } - else { lb->next = btmp; lb = btmp; } - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s, "id:%s type:%s to line %d dir_vect =(%s,%s,%s)\n", - d->symbol->ident, depstrs[(int)(d->type)], - d->to.stmt->g_line, - dirstrs[(int)(d->direct[1])], dirstrs[(int)(d->direct[2])], - dirstrs[(int)(d->direct[3])]); - btmp->ref = s; - btmp->next = NULL; - } - d = d->from_fwd; - } - if (bchild->entry.Template.bl_ptr1 != NULL) { - nb = search_deps(nb, bchild->entry.Template.bl_ptr1, depth); - lb = nb; while (lb != NULL && lb->next != NULL) lb = lb->next; - } - if (bchild->entry.Template.bl_ptr2 != NULL) { - nb = search_deps(nb, bchild->entry.Template.bl_ptr2, depth); - lb = nb; while (lb != NULL && lb->next != NULL) lb = lb->next; - } - } - return(nb); -} - - -PTR_BLOB1 -GetDepInfo(filename, line) - char *filename; - int line; -{ - PTR_BFND b, bpar; - PTR_DEP d; - int depth; - char * s; - PTR_BLOB1 nb, lb, btmp; - PTR_BLOB q; - - b = FindBifNode(filename, line); - if (b == NULL) return(NULL); - /* if b is a loop, we look for all loop carried deps for */ - /* this loop. otherwise just list dependence going out */ - if (b->variant == FOR_NODE) { - depth = 0; - bpar = b; - current_par_loop = b; - while (bpar != NULL && bpar->variant != GLOBAL) { - if (bpar->variant == FOR_NODE || - bpar->variant == CDOALL_NODE || - bpar->variant == WHILE_NODE || - bpar->variant == FORALL_NODE) depth++; - bpar = bpar->control_parent; - } - q = b->entry.Template.bl_ptr1; - nb = (PTR_BLOB1)malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,nb, 0); -#endif - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s, "Essential dependences inhibiting parallelization of loop are:\n"); - nb->ref = s; - nb->next = NULL; - nb = search_deps(nb, q, depth); - return(nb); - } /* if loop case */ - d = b->entry.Template.dep_ptr1; - nb = NULL; - while (d != NULL) { - btmp = (PTR_BLOB1)malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); -#endif - if (nb == NULL) { nb = btmp; lb = btmp; } - else { lb->next = btmp; lb = btmp; } - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s, "id:%s type:%s to line %d dir_vect =(%s,%s,%s)\n", - d->symbol->ident, depstrs[(int)(d->type)], - d->to.stmt->g_line, - dirstrs[(int)(d->direct[1])], dirstrs[(int)(d->direct[2])], - dirstrs[(int)(d->direct[3])]); - btmp->ref = s; - btmp->next = NULL; - d = d->from_fwd; - } - return(nb); -} - - -/**************************************************************** - * * - * FindRef -- find the reference of the given symbol in the * - * low level node * - * * - * Inputs: * - * ll - the low level node to be searched * - * name - the symbol name to be looked up * - * * - * Output: * - * an integer indicating the type of the "name": * - * * - * 0 -- program * - * 1 -- procedure * - * 2 -- function * - * 3 -- constant (or parmameter in Fortran)* - * 4 -- scalar variable * - * 5 -- array variable * - * 6 -- record variable * - * 7 -- enumerated type * - * 8 -- label variable * - * 9 -- name of common block * - * * - ****************************************************************/ -static int -FindRef(ll, name) - PTR_LLND ll; - char *name; -{ - int val; - - if (!ll) - return -1; - - switch (ll->variant) { - case CONST_REF: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 3; - break; - case VAR_REF: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 4; - break; - case ARRAY_REF: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 5; - break; - case RECORD_REF: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 6; - break; - case ENUM_REF: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 7; - break; - case LABEL_REF: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 8; - break; - case COMM_LIST: - if (ll->entry.Template.symbol && /* could be blank common */ - !strcmp(name, ll->entry.Template.symbol->ident)) - return 9; - break; - case FUNC_CALL: - if (!strcmp(name, ll->entry.Template.symbol->ident)) - return 2; - break; - default: - break; - } - - if ((val=FindRef(ll->entry.Template.ll_ptr1,name)) != -1) - return val; - - if ((val=FindRef(ll->entry.Template.ll_ptr2,name)) != -1) - return val; - return -1; -} - - -/**************************************************************** - * * - * SymbType -- find the type of the given symbol * - * * - * Input: * - * filename - name of the file to be looked upon * - * line - line number of the symbol reference * - * name - varaible name * - * * - * Output: * - * an integer representing the variable type (take a * - * look at "../h/tag" for possible returned values * - * return a -1 if error occured * - * * - ****************************************************************/ -int -SymbType(filename, line, name) - char *filename; - int line; - char *name; -{ - int val; - PTR_BFND bf; - - if ((bf = FindBifNode(filename, line)) == NULL) - return -1; - - switch (bf->variant) { - case PROG_HEDR: - if (!strcmp(name, bf->entry.Template.symbol->ident)) - return 0; - break; - case PROC_HEDR: - if (!strcmp(name, bf->entry.Template.symbol->ident)) - return 1; - break; - case FUNC_HEDR: - case PROC_STAT: - if (!strcmp(name, bf->entry.Template.symbol->ident)) - return 2; - break; - } - if ((val=FindRef(bf->entry.Template.ll_ptr1,name)) != -1) - return val; - - if ((val=FindRef(bf->entry.Template.ll_ptr2,name)) != -1) - return val; - - if ((val=FindRef(bf->entry.Template.ll_ptr3,name)) != -1) - return val; - (void) sprintf(db_err_msg, "No such symbol \"%s\" in line %d",name, line); - return -1; -} - - -/**************************************************************** - * * - * EndOfLoop -- find line number of end of loop statement * - * * - * Input: * - * filename - name of the file to be looked upon * - * line - line number of the lopp statement * - * * - * Output: * - * return the line number of the end-of-loop statement * - * return -1 if error occured * - * * - ****************************************************************/ -int -EndOfLoop(filename, line) - char *filename; - int line; -{ - PTR_BFND bf; - PTR_BLOB bl, bl1; - - if ( (bf = FindBifNode(filename, line)) != NULL) { - bl1 = NULL; - for (bl=bf->entry.for_node.control; bl; bl = bl->next) - bl1 = bl; - if (bl1) - return bl1->ref->g_line; - } - return -1; -} - - -/**************************************************************** - * * - * ProgName -- get the main program's name from data base * - * * - * Input: * - * proj -- poniter of project object * - * * - * Output: * - * A string that contains the program's name * - * A NULL point if no main program exists * - * * - ****************************************************************/ -char * -ProjName(proj) - PTR_PROJ proj; -{ - PTR_BLOB b, bl; - PTR_FILE f; - - for (b = proj->file_chain; b; b = b->next) { - f = (PTR_FILE) b->ref; - for (bl = f->global_bfnd->entry.Template.bl_ptr1; bl; bl = bl->next) - if (bl->ref->variant == PROG_HEDR) - return (bl->ref->entry.Template.symbol->ident); - } - return NULL; -} - - -/**************************************************************** - * * - * GetLangType -- get the type of language of a file * - * * - * Input: * - * bf - a bif node pointer (to represent a file) * - * * - * Output: * - * An integer of value CSrc, ForSrc etc. with the CSrc * - * means this is a C program and ForSrc, a Fortran one. * - * A -1 indicates something wrong. * - * * - ****************************************************************/ -int -GetLangType(bf) - PTR_BFND bf; -{ - PTR_BFND b; - - /* First, find the global bif node of this dep file */ - for(b = bf; b && b->variant == GLOBAL ; b = b->control_parent) - ; - - /* Its control_parent is set to the file object that contains it */ - return(b? ((PTR_FILE)b->control_parent)->lang: -1); -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp.c deleted file mode 100644 index 24b5f11..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp.c +++ /dev/null @@ -1,1956 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * db_unp.c -- contains the procedures required to unparse the * - * bif graph back to source form for Fortran * - * * - ****************************************************************/ - -#include -#include "db.h" -#include "f90.h" - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -#define NULLTEST(VAR) (VAR == NULL? -1 : VAR->id) -#define type_index(X) (X-T_INT) -#define binop(n) (n >= EQ_OP && n <= NEQV_OP) - -PTR_SYMB cur_symb_head; /* point to the head of the list of symbols */ - /* used to search type that LIKE the current*/ - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -int figure_tabs(); -//TODO: allocate buffer dynamically -//used in vpc.c -#define BUFLEN 500000 -char buffer[BUFLEN], *bp; - -static int in_param = 0; /* set if unparsing the parameter statement */ -static int in_impli = 0; /* set if unparsing the implicit statement */ -static PTR_CMNT cmnt = NULL; /* point to chain of comment list */ -static int print_comments = 1; /* 0 if no comments */ -static char first = 1; /* used when unparsing LOGGOTO which has two */ - /* ... bif nodes */ - -/* - * Forward references - */ -static void unp_llnd(); - - -/* - * Ascii names for operators in the language - */ -static -char *fop_name[] = { - " .eq. ", - " .lt. ", - " .gt. ", - " .ne. ", - " .le. ", - " .ge. ", - "+", - "-", - " .or. ", - "*", - "/", - "", - " .and. ", - "**", - "", - "//", - " .xor. ", - " .eqv. ", - " .neqv. " -}; - - -/* - * Precedence table of operators for Fortran - */ -static -char precedence[] = { /* precedence table of the operators */ - 5, /* .eq. */ - 5, /* .lt. */ - 5, /* .gt. */ - 5, /* .ne. */ - 5, /* .le. */ - 5, /* .ge. */ - 3, /* + */ - 3, /* - */ - 8, /* .or. */ - 2, /* * */ - 2, /* / */ - 0, /* none */ - 7, /* .and. */ - 1, /* ** */ - 0, /* none */ - 4, /* // */ - 8, /* .xor. */ - 9, /* .eqv. */ - 9 /* .neqv. */ -}; - - -/* - * Type names in ascii form - */ -static -char *ftype_name[] = { - "integer", - "real", - "double precision", - "character", - "logical", - "character", - "gate", - "event", - "sequence", - "", - "", - "", - "", - "complex", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "double complex" -}; - - -/**************************************************************** - * * - * put_tabs -- indent the statement by putting some blanks * - * * - * Input: * - * n - number of tabs wanted * - * * - ****************************************************************/ -static void -put_tabs(n) - int n; -{ - int i; - - for(i = 0; i < n; i++) { - *bp++ = ' '; - *bp++ = ' '; - } -} - - -/**************************************************************** - * * - * figure_tabs -- figure out the indentation level of the * - * given bif node * - * * - * Input: * - * bf - the bif node pointer * - * * - * Output: * - * an integer indicating the indentation level * - * * - ****************************************************************/ -int -figure_tabs(bf) - PTR_BFND bf; -{ - int count = 0; - - while(bf->variant != PROG_HEDR && bf->variant != PROC_HEDR && - bf->variant != FUNC_HEDR && bf->variant != GLOBAL){ - if(bf->variant != ELSEIF_NODE) count++; - bf = bf->control_parent; - } - return(count); -} - - -/**************************************************************** - * * - * addstr -- add the string "s" to output buffer * - * * - * Input: * - * s - the string to be appended to the buffer * - * * - * Side effect: * - * bp - points to where next character will go * - * * - ****************************************************************/ -static void -addstr(s) - char *s; -{ - while( (*bp = *s++) != 0) - bp++; -} - - -/* - * pr_ftype_name(ptype) -- print out the variable type. - */ -static int -pr_ftype_name(ptype, def) - PTR_TYPE ptype; - int def; /* def = 1 means it is a type define, - print the whole type - def = 0 : the type has a name. */ - -{ int gen_rec_decl (); - - - if (ptype == NULL) return(0); - - if (def == 0 && ptype->name) { /* print the type name */ - addstr (ptype->name->ident); - return(1); - } - - switch (ptype->variant) { - case T_INT : - case T_FLOAT : - case T_DOUBLE: - case T_CHAR : - case T_BOOL : - case T_STRING: - case T_COMPLEX: - addstr (ftype_name[ptype->variant - T_INT]); - break; - case T_DCOMPLEX: - addstr (ftype_name[ptype->variant - T_INT]); - break; - case T_GATE: - addstr ("gate"); - break; - case T_EVENT: - addstr ("event"); - break; - case T_SEQUENCE: - addstr ("sequence"); - break; - case T_ARRAY : - pr_ftype_name (ptype->entry.ar_decl.base_type, 0); - break; - case T_DERIVED_TYPE: - addstr("type ("); - addstr(ptype->name->ident); - addstr(")"); - break; - case T_POINTER: - pr_ftype_name(ptype->entry.Template.base_type,0); - break; - - default : - return 0; - } - return (1); -} - - -static void -gen_loop_header(looptype, pbf) - char *looptype; - PTR_BFND pbf; -{ - char label[7]; - - addstr(looptype); - if ((pbf->variant == PARDO_NODE) || (pbf->variant == PDO_NODE)) - if (pbf->entry.for_node.where_cond) - { - addstr(" ( "); - unp_llnd(pbf->entry.for_node.where_cond); - addstr(" ) "); - } - if (pbf->entry.for_node.doend) { - sprintf(label,"%d ",(int)(pbf->entry.for_node.doend->stateno)); - addstr(label); - } - addstr(pbf->entry.for_node.control_var->ident); - addstr(" = "); - unp_llnd(pbf->entry.for_node.range->entry.binary_op.l_operand); - addstr(", "); - unp_llnd(pbf->entry.for_node.range->entry.binary_op.r_operand); - if (pbf->entry.for_node.increment) { - addstr(" , "); - unp_llnd(pbf->entry.for_node.increment); - } -} - - -/* - * gen_if_node(pbf) --- generate the if statement pointed to by pbf. - */ -static void -gen_branch(branch_tag, branch_type, pbf) - int branch_tag; - char *branch_type; - PTR_BFND pbf; -{ - addstr(branch_type); - *bp++ = '('; - unp_llnd(pbf->entry.if_node.condition); - *bp++ = ')'; - if (branch_tag != WHERE_BLOCK_STMT) - addstr(" then"); -} - - -/**************************************************************** - * * - * unp_llnd -- unparse the given low level node to source * - * string * - * * - * Input: * - * pllnd - low level node to be unparsed * - * bp (implicitely) - where the output string to be * - * placed * - * * - * Output: * - * the unparse string where "bp" was pointed to * - * * - * Side Effect: * - * "bp" will be updated to the next character behind * - * the end of the unparsed string (by "addstr") * - * * - ****************************************************************/ -static void -unp_llnd(pllnd) - PTR_LLND pllnd; -{ - if (pllnd == NULL) return; - - switch (pllnd->variant) { - case INT_VAL : - { char sb[64]; - - sprintf(sb, "%d", pllnd->entry.ival); - addstr(sb); - break; - } - case LABEL_REF: - { char sb[64]; - - sprintf(sb, "%d",(int)( pllnd->entry.label_list.lab_ptr->stateno)); - addstr(sb); - break; - } - case FLOAT_VAL : - case DOUBLE_VAL : - case STMT_STR : - addstr(pllnd->entry.string_val); - break; - case STRING_VAL : - *bp++ = '\''; - addstr(pllnd->entry.string_val); - *bp++ = '\''; - break; - case COMPLEX_VAL : - *bp++ = '('; - unp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ','; - unp_llnd(pllnd->entry.Template.ll_ptr2); - *bp++ = ')'; - break; - case KEYWORD_VAL : - addstr(pllnd->entry.string_val); - break; - case KEYWORD_ARG : - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("="); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case BOOL_VAL : - addstr(pllnd->entry.bval ? ".TRUE." : ".FALSE."); - break; - case CHAR_VAL : - if (! in_impli) - *bp++ = '\''; - *bp++ = pllnd->entry.cval; - if (! in_impli) - *bp++ = '\''; - break; - case CONST_REF : - case VAR_REF : - case ENUM_REF : - case TYPE_REF : - case INTERFACE_REF: - addstr(pllnd->entry.Template.symbol->ident); - /* Look out !!!! */ -/* Purpose unknown. Commented out. */ -/* - if (pllnd->entry.Template.symbol->type->entry.Template.ranges != LLNULL) - unp_llnd(pllnd->entry.Template.symbol->type->entry.Template.ranges); -*/ - break; - case ARRAY_REF : - addstr(pllnd->entry.array_ref.symbol->ident); - if (pllnd->entry.array_ref.index) { - *bp++ = '('; - unp_llnd(pllnd->entry.array_ref.index); - *bp++ = ')'; - } - break; - case ARRAY_OP : - unp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = '('; - unp_llnd(pllnd->entry.Template.ll_ptr2); - *bp++ = ')'; - break; - case RECORD_REF : - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("%"); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case STRUCTURE_CONSTRUCTOR : - addstr(pllnd->entry.Template.symbol->ident); - *bp++ = '('; - unp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ')'; - break; - case CONSTRUCTOR_REF : - addstr("(/"); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("/)"); - break; - case ACCESS_REF : - unp_llnd(pllnd->entry.access_ref.access); - if (pllnd->entry.access_ref.index != NULL) { - *bp++ = '('; - unp_llnd(pllnd->entry.access_ref.index); - *bp++ = ')'; - } - break; - case OVERLOADED_CALL: - break; - case CONS : - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(","); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case ACCESS : - unp_llnd(pllnd->entry.access.array); - addstr(", FORALL=("); - addstr(pllnd->entry.access.control_var->ident); - *bp++ = '='; - unp_llnd(pllnd->entry.access.range); - *bp++ = ')'; - break; - case IOACCESS : - *bp++ = '('; - unp_llnd(pllnd->entry.ioaccess.array); - addstr(", "); - addstr(pllnd->entry.ioaccess.control_var->ident); - *bp++ = '='; - unp_llnd(pllnd->entry.ioaccess.range); - *bp++ = ')'; - break; - case PROC_CALL : - case FUNC_CALL : - addstr(pllnd->entry.proc.symbol->ident); - *bp++ = '('; - unp_llnd(pllnd->entry.proc.param_list); - *bp++ = ')'; - break; - case EXPR_LIST : - unp_llnd(pllnd->entry.list.item); - if (in_param) { - addstr("="); - unp_llnd(pllnd->entry.list.item->entry.const_ref.symbol->entry.const_value); - } - if (pllnd->entry.list.next) { - addstr(", "); - unp_llnd(pllnd->entry.list.next); - } - break; - case EQUI_LIST : - *bp++ = '('; - unp_llnd(pllnd->entry.list.item); - *bp++ = ')'; - if (pllnd->entry.list.next) { - addstr(", "); - unp_llnd(pllnd->entry.list.next); - } - break; - case COMM_LIST : - case NAMELIST_LIST: - if (pllnd->entry.Template.symbol) { - *bp++ = '/'; - addstr(pllnd->entry.Template.symbol->ident); - *bp++ = '/'; - } - unp_llnd(pllnd->entry.list.item); - if (pllnd->entry.list.next) { - addstr(", "); - unp_llnd(pllnd->entry.list.next); - } - break; - case VAR_LIST : - case RANGE_LIST : - case CONTROL_LIST: - unp_llnd(pllnd->entry.list.item); - if (pllnd->entry.list.next) { - addstr(","); - unp_llnd(pllnd->entry.list.next); - } - break; - case DDOT : - if (pllnd->entry.binary_op.l_operand) - unp_llnd(pllnd->entry.binary_op.l_operand); - *bp++ = in_impli? '-' : ':'; - if (pllnd->entry.binary_op.r_operand) - unp_llnd(pllnd->entry.binary_op.r_operand); - break; - case DEFAULT: - addstr("default"); - break; - case DEF_CHOICE : - case SEQ : - unp_llnd(pllnd->entry.seq.ddot); - if (pllnd->entry.seq.stride) { - *bp++ = ':'; - unp_llnd(pllnd->entry.seq.stride); - } - break; - case SPEC_PAIR : - unp_llnd(pllnd->entry.spec_pair.sp_label); - *bp++ = '='; - unp_llnd(pllnd->entry.spec_pair.sp_value); - break; - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP : - case LTEQL_OP : - case GTEQL_OP : - case ADD_OP : - case SUBT_OP : - case OR_OP : - case MULT_OP : - case DIV_OP : - case MOD_OP : - case AND_OP : - case EXP_OP : - case CONCAT_OP : - { - int i = pllnd->variant - EQ_OP, j; - PTR_LLND p; - int num_paren = 0; - - p = pllnd->entry.binary_op.l_operand; - j = p->variant; - if (binop(j) && precedence[i] < precedence[j-EQ_OP]) { - num_paren++; - *bp++ = '('; - } - unp_llnd(p); - if (num_paren) { - *bp++ = ')'; - num_paren--; - } - addstr(fop_name[i]); /* print the op name */ - p = pllnd->entry.binary_op.r_operand; - j = p->variant; - if (binop(j) && precedence[i] <= precedence[j-EQ_OP]) { - num_paren++; - *bp++ = '('; - } - unp_llnd(p); - if (num_paren) { - *bp++ = ')'; - num_paren--; - } - break; - } - case MINUS_OP : - addstr(" -("); - unp_llnd(pllnd->entry.unary_op.operand); - *bp++ = ')'; - break; - case UNARY_ADD_OP : - addstr(" +("); - unp_llnd(pllnd->entry.unary_op.operand); - *bp++ = ')'; - break; - case NOT_OP : - addstr(" .not. ("); - unp_llnd(pllnd->entry.unary_op.operand); - *bp++ = ')'; - break; - case PAREN_OP: - addstr("("); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(")"); - case ASSGN_OP: - addstr("="); - unp_llnd(pllnd->entry.Template.ll_ptr1); - case STAR_RANGE : - addstr(" : "); - break; - case IMPL_TYPE: - pr_ftype_name(pllnd->type, 1); - if (pllnd->entry.Template.ll_ptr1 != LLNULL) - { - addstr("("); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(")"); - } - break; - case ORDERED_OP : - addstr("ordered "); - break; - case EXTEND_OP : - addstr("extended "); - break; - case MAXPARALLEL_OP: - addstr("max parallel = "); - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case PARAMETER_OP : - addstr("parameter "); - break; - case PUBLIC_OP : - addstr("public "); - break; - case PRIVATE_OP : - addstr("private "); - break; - case ALLOCATABLE_OP : - addstr("allocatable "); - break; - case DIMENSION_OP : - addstr("dimension ("); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(")"); - break; - case EXTERNAL_OP : - addstr("external "); - break; - case OPTIONAL_OP : - addstr("optional "); - break; - case IN_OP : - addstr("intent (in) "); - break; - case OUT_OP : - addstr("intent (out) "); - break; - case INOUT_OP : - addstr("intent (inout) "); - break; - case INTRINSIC_OP : - addstr("intrinsic "); - break; - case POINTER_OP : - addstr("pointer "); - break; - case SAVE_OP : - addstr("save "); - break; - case TARGET_OP : - addstr("target "); - break; - case LEN_OP : - addstr("*"); - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case TYPE_OP : - pr_ftype_name(pllnd->type, 1); - unp_llnd(pllnd->type->entry.Template.ranges); - break; - case ONLY_NODE : - addstr("only: "); - if (pllnd->entry.Template.ll_ptr1) - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case DEREF_OP : - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case RENAME_NODE : - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("=>"); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case VARIABLE_NAME : - addstr(pllnd->entry.Template.symbol->ident); - break; - default : - fprintf(stderr,"unp_llnd -- bad llnd ptr %d!\n",pllnd->variant); - break; - } -} - - -/**************************************************************** - * * - * funp_bfnd -- unparse the given bif node to source string * - * * - * Input: * - * tabs- number of tabs (2 spaces) for indenting * - * pbf - bif node to be unparsed * - * bp (implicitely) - where the output string to be * - * placed * - * * - * Output: * - * the unparse string where "bp" was pointed to * - * * - * Side Effect: * - * "bp" will be updated to the next character behind * - * the end of the unparsed string (by "addstr") * - * * - ****************************************************************/ -static void -funp_bfnd(tabs,pbf) - int tabs; - PTR_BFND pbf; -{ - PTR_SYMB s; - - if (pbf == NULL) return; - if (pbf->label) { - char b[10]; - - sprintf(b ,"%-5d ", (int)(pbf->label->stateno)); - addstr(b); - } else - addstr(" "); - - put_tabs(tabs); - switch (pbf->variant) { - case GLOBAL : - break; - case PROG_HEDR : /* program header */ - addstr("program "); - if (pbf->entry.program.prog_symb && - strcmp(pbf->entry.program.prog_symb->ident, (char *)"_MAIN")) { - addstr(pbf->entry.program.prog_symb->ident); - } - break; - case BLOCK_DATA : - addstr("block data "); - if (pbf->entry.program.prog_symb && - strcmp(pbf->entry.program.prog_symb->ident, (char *)"_BLOCK")) { - addstr(pbf->entry.program.prog_symb->ident); - } - break; - case PROC_HEDR : - if (pbf->entry.procedure.proc_symb->attr & RECURSIVE_BIT) - addstr("recursive"); - addstr("subroutine "); - addstr(pbf->entry.procedure.proc_symb->ident); - *bp++ = '('; - s = pbf->entry.procedure.proc_symb->entry.proc_decl.in_list; - while (s) { - addstr(s->ident); - s = s->entry.var_decl.next_in; - if (s) *bp++ = ','; - } - *bp++ = ')'; - break; - case FUNC_HEDR : - if (pbf->entry.function.func_symb->attr & RECURSIVE_BIT) - addstr("recursive"); - addstr(ftype_name[type_index(pbf->entry.function.func_symb->type->variant)]); - addstr(" function "); - addstr(pbf->entry.function.func_symb->ident); - *bp++ = '('; - s = pbf->entry.function.func_symb->entry.proc_decl.in_list; - while (s) { - addstr(s->ident); - s = s->entry.var_decl.next_in; - if (s) *bp++ = ','; - } - addstr(") "); - if (pbf->entry.Template.ll_ptr1) - { - addstr("result ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - } - break; - case ENTRY_STAT : - addstr("entry "); - addstr(pbf->entry.function.func_symb->ident); - *bp++ = '('; - unp_llnd(pbf->entry.Template.ll_ptr1); - /* - s = pbf->entry.function.func_symb->entry.proc_decl.in_list; - while (s) { - addstr(s->ident); - s = s->entry.var_decl.next_in; - if (s) *bp++ = ','; - } - */ - addstr(") "); - break; - case INTERFACE_STMT: - { - PTR_SYMB s; - char *c; - - addstr("interface "); - if ( (s = (pbf->entry.Template.symbol)) != 0) - { - c = s->ident; - if (*c == '.') - { - addstr("operator ("); - addstr(c); - addstr(")"); - } - else if (*c == '=') - { - addstr("assignment ("); - addstr("="); - addstr(")"); - } - else addstr(c); - } - } - break; - case MODULE_STMT: - addstr("module "); - addstr(pbf->entry.Template.symbol->ident); - break; - case CASE_NODE: - if (pbf->entry.Template.ll_ptr3) - { - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(":"); - } - addstr("select case ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - break; - case SWITCH_NODE : - addstr("case ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - if (pbf->entry.Template.symbol) - addstr(pbf->entry.Template.symbol->ident); - break; - case IF_NODE : - /* if (pbf->entry.Template.ll_ptr3) - { - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(":"); - } */ - gen_branch(IF_NODE, "if ", pbf); - break; - case LOGIF_NODE : - addstr("if ("); - unp_llnd(pbf->entry.if_node.condition); - addstr(") "); - break; - case ELSEIF_NODE: - gen_branch(IF_NODE, "else if", pbf); - break; - case ARITHIF_NODE: - addstr("if ("); - unp_llnd(pbf->entry.if_node.condition); - addstr(") "); - unp_llnd(pbf->entry.Template.ll_ptr2); - break; - case WHERE_BLOCK_STMT: - gen_branch(WHERE_BLOCK_STMT, "where ", pbf); - break; - case WHERE_NODE: - addstr("where ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(" = "); - unp_llnd(pbf->entry.Template.ll_ptr3); - break; - case PARDO_NODE : - gen_loop_header("parallel do ", pbf); - break; - case PDO_NODE : - gen_loop_header("pdo ", pbf); - break; - case FOR_NODE : - if (pbf->entry.Template.ll_ptr3) - { - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(":"); - } - gen_loop_header("do ",pbf); - break; - case CDOALL_NODE : - gen_loop_header("cdoall ",pbf); - break; - case WHILE_NODE : - if (pbf->entry.Template.ll_ptr3) - { - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(":"); - } - addstr("do "); - if (pbf->entry.for_node.doend) { - char label[7]; - - sprintf(label,"%d ",(int)(pbf->entry.for_node.doend->stateno)); - addstr(label); - } - addstr(" while ("); - unp_llnd(pbf->entry.while_node.condition); - *bp++ = ')'; - break; - case ASSIGN_STAT: - unp_llnd(pbf->entry.assign.l_value); - addstr(" = "); - unp_llnd(pbf->entry.assign.r_value); - break; - case IDENTIFY: - addstr("identify "); - unp_llnd(pbf->entry.identify.l_value); - *bp++ = ' '; - unp_llnd(pbf->entry.identify.r_value); - break; - case PRIVATE_STMT: - addstr("private "); - if (pbf->entry.Template.ll_ptr1) - { - addstr(":: "); - unp_llnd(pbf->entry.Template.ll_ptr1); - } - break; - case PUBLIC_STMT: - addstr("public "); - if (pbf->entry.Template.ll_ptr1) - { - addstr(":: "); - unp_llnd(pbf->entry.Template.ll_ptr1); - } - break; - case STRUCT_DECL: - { - PTR_LLND l; - addstr("type "); - - if ( (l = pbf->entry.Template.ll_ptr1) != 0) - { - addstr(","); - unp_llnd(l); - addstr("::"); - } - - addstr(pbf->entry.Template.symbol->ident); - } - break; - case SEQUENCE_STMT: - addstr("sequence "); - break; - case CONTAINS_STMT: - addstr("contains "); - break; - case OVERLOADED_ASSIGN_STAT: - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr("="); - unp_llnd(pbf->entry.Template.ll_ptr3); - break; - case OVERLOADED_PROC_STAT: - case PROC_STAT : - addstr("call "); - addstr(pbf->entry.Template.symbol->ident); - *bp++ = '('; - unp_llnd(pbf->entry.Template.ll_ptr1); - *bp++ = ')'; - break; - case STMTFN_STAT: - {PTR_SYMB p; - PTR_LLND body; - - body = pbf->entry.Template.ll_ptr1; - p = body->entry.Template.symbol; - addstr(p->ident); - *bp++ = '('; - p=p->entry.func_decl.in_list; - while (p) { - addstr(p->ident); - if( (p=p->entry.var_decl.next_in) != 0) *bp++ = ','; - } - addstr(") = "); - unp_llnd(body->entry.Template.ll_ptr1); - break; - } - case SAVE_DECL: - addstr("save "); - if (pbf->entry.Template.ll_ptr1) - unp_llnd(pbf->entry.Template.ll_ptr1); - else - addstr("all"); - break; - case CONT_STAT: - addstr("continue"); - break; - case FORMAT_STAT: -/* addstr("format ("); */ - unp_llnd(pbf->entry.format.spec_string); -/* *bp++ = ')'; */ - break; - case GOTO_NODE: - addstr("goto "); - unp_llnd(pbf->entry.Template.ll_ptr3); - break; - case ASSGOTO_NODE: - addstr("goto "); - addstr(pbf->entry.Template.symbol->ident); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case COMGOTO_NODE: - addstr("goto ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - unp_llnd(pbf->entry.Template.ll_ptr2); - break; - case STOP_STAT: - addstr("stop"); - if (pbf->entry.Template.ll_ptr1) { - addstr("'"); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr("'"); - } - break; - case RETURN_STAT: - addstr("return"); - break; - case OPTIONAL_STMT: - addstr("optional :: "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case VAR_DECL: - { - PTR_LLND p = pbf->entry.Template.ll_ptr1; - /* PTR_TYPE q; - - q = p->entry.list.item->entry.Template.symbol->type; - if (q->variant == T_ARRAY) - q = q->entry.ar_decl.base_type; - addstr(ftype_name[type_index(q->variant)]); - *bp++ = ' '; */ - unp_llnd(pbf->entry.Template.ll_ptr2); - if (pbf->entry.Template.ll_ptr3) - { - addstr(","); - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr("::"); - } - else addstr(" "); - unp_llnd(p); - break; - } - case INTENT_STMT: - { - PTR_SYMB s; - PTR_LLND p = pbf->entry.Template.ll_ptr1; - - addstr("intent "); - s = p->entry.list.item->entry.Template.symbol; - if (s->attr & IN_BIT) - addstr("(in) :: "); - if (s->attr & OUT_BIT) - addstr("(out) :: "); - if (s->attr & INOUT_BIT) - addstr("(inout) :: "); - unp_llnd(p); - break; - } - case PARAM_DECL: - addstr("parameter ("); - in_param = 1; - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - in_param = 0; - break; - case DIM_STAT: - addstr("dimension "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case ALLOCATABLE_STMT: - addstr("allocatable :: "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case POINTER_STMT: - addstr("pointer :: "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case TARGET_STMT: - addstr("target :: "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case ALLOCATE_STMT: - addstr("allocate ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - if (pbf->entry.Template.ll_ptr2) - { - addstr(", stat = "); - unp_llnd(pbf->entry.Template.ll_ptr2); - } - addstr(")"); - break; - case DEALLOCATE_STMT: - addstr("deallocate ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - if (pbf->entry.Template.ll_ptr2) - { - addstr(", stat = "); - unp_llnd(pbf->entry.Template.ll_ptr2); - } - addstr(")"); - break; - case NULLIFY_STMT: - addstr("nullify ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - break; - case MODULE_PROC_STMT: - addstr("module procedure "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case POINTER_ASSIGN_STAT: - addstr(pbf->entry.Template.symbol->ident); - addstr("=> "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case CYCLE_STMT: - addstr("cycle "); - addstr(pbf->entry.Template.symbol->ident); - break; - case EXIT_STMT: - addstr("exit "); - addstr(pbf->entry.Template.symbol->ident); - break; - case USE_STMT: - addstr("use "); - addstr(pbf->entry.Template.symbol->ident); - if (pbf->entry.Template.ll_ptr1) - { - addstr(", "); - unp_llnd(pbf->entry.Template.ll_ptr1); - } - break; - case EQUI_STAT: - addstr("equivalence "); - case DATA_DECL: - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case IMPL_DECL: - addstr("implicit "); - if (pbf->entry.Template.ll_ptr1 == NULL) - addstr("none"); - else { - in_impli = 1; - unp_llnd(pbf->entry.Template.ll_ptr1); - in_impli = 0; - } - break; - case EXTERN_STAT: - addstr("external "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case INTRIN_STAT: - addstr("intrinsic "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case PARREGION_NODE: - addstr("parallel "); - if (pbf->entry.Template.ll_ptr1) - { - addstr("( "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - } - break; - case PARSECTIONS_NODE: - addstr("parallel sections"); - if (pbf->entry.Template.ll_ptr1) - { - addstr("( "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - } - break; - case PSECTIONS_NODE: - addstr("psections "); - if (pbf->entry.Template.ll_ptr1) - { - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - } - break; - case SINGLEPROCESS_NODE: - addstr("single process"); - if (pbf->entry.Template.ll_ptr1) - { - addstr("( "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - } - break; - case CRITSECTION_NODE: - addstr("critical section"); - if (pbf->entry.Template.ll_ptr1) - { - addstr("( "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") "); - } - if (pbf->entry.Template.ll_ptr2) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(") "); - } - break; - case GUARDS_NODE: - addstr("guards "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - break; - case LOCK_NODE: - addstr("lock ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - if (pbf->entry.Template.ll_ptr2) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - } - break; - case UNLOCK_NODE: - addstr("unlock ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - if (pbf->entry.Template.ll_ptr2) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - } - break; - case POST_NODE: - addstr("post ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - if (pbf->entry.Template.ll_ptr2) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - } - break; - case WAIT_NODE: - addstr("wait ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - if (pbf->entry.Template.ll_ptr2) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - } - break; - case CLEAR_NODE: - addstr("clear ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - if (pbf->entry.Template.ll_ptr2) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - } - break; - case POSTSEQ_NODE: - addstr("post ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(", "); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - if (pbf->entry.Template.ll_ptr3) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(")"); - } - break; - case WAITSEQ_NODE: - addstr("wait ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(", "); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - if (pbf->entry.Template.ll_ptr3) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(")"); - } - break; - case SETSEQ_NODE: - addstr("set ("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(", "); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - if (pbf->entry.Template.ll_ptr3) - { - addstr("guards ("); - unp_llnd(pbf->entry.Template.ll_ptr3); - addstr(")"); - } - break; - case SECTION_NODE: - addstr("section"); - if (pbf->entry.Template.ll_ptr1) - { - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - } - if (pbf->entry.Template.ll_ptr2) - { - addstr("wait ("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - } - break; - case ASSIGN_NODE: - addstr("assign ( "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - break; - case RELEASE_NODE: - addstr("release ( "); - unp_llnd(pbf->entry.Template.ll_ptr1); - addstr(")"); - break; - case PRIVATE_NODE: - addstr("private "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case READ_STAT: - { - PTR_LLND p; - PTR_LLND q; - - addstr("read "); - p = pbf->entry.Template.ll_ptr2; - q = p->entry.Template.ll_ptr1; - - if ((p->variant == EXPR_LIST) || - ((p->variant == SPEC_PAIR) && - (strcmp(q->entry.string_val,"fmt") != 0))) - { - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(") "); - } - else - { - unp_llnd(pbf->entry.Template.ll_ptr2->entry.Template.ll_ptr2); - if (pbf->entry.Template.ll_ptr1 != LLNULL) - addstr(","); - } - unp_llnd(pbf->entry.Template.ll_ptr1); - } - break; - case WRITE_STAT: - addstr("write "); - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(") "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case PRINT_STAT: - addstr("print "); - unp_llnd(pbf->entry.Template.ll_ptr2->entry.Template.ll_ptr2); - if (pbf->entry.Template.ll_ptr1 != LLNULL) - addstr(","); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case OPEN_STAT: - addstr("open "); - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(") "); - break; - case CLOSE_STAT: - addstr("close "); - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(") "); - break; - case INQUIRE_STAT: - addstr("inquire "); - addstr("("); - unp_llnd(pbf->entry.Template.ll_ptr2); - addstr(") "); - break; - case SKIPPASTEOF_NODE: - { - PTR_LLND p; - PTR_LLND q; - - addstr("skip past eof "); - p = pbf->entry.Template.ll_ptr2; - q = p->entry.Template.ll_ptr2; - - if (p->variant == EXPR_LIST) - { - addstr("("); - unp_llnd(p); - addstr(") "); - } - else unp_llnd(q); - } - break; - case BACKSPACE_STAT: - { - PTR_LLND p; - PTR_LLND q; - - addstr("backspace "); - p = pbf->entry.Template.ll_ptr2; - q = p->entry.Template.ll_ptr2; - - if (p->variant == EXPR_LIST) - { - addstr("("); - unp_llnd(p); - addstr(") "); - } - else unp_llnd(q); - } - break; - case ENDFILE_STAT: - { - PTR_LLND p; - PTR_LLND q; - - addstr("endfile "); - p = pbf->entry.Template.ll_ptr2; - q = p->entry.Template.ll_ptr2; - - if (p->variant == EXPR_LIST) - { - addstr("("); - unp_llnd(p); - addstr(") "); - } - else unp_llnd(q); - } - break; - case REWIND_STAT: - { - PTR_LLND p; - PTR_LLND q; - - addstr("rewind "); - p = pbf->entry.Template.ll_ptr2; - q = p->entry.Template.ll_ptr2; - - if (p->variant == EXPR_LIST) - { - addstr("("); - unp_llnd(p); - addstr(") "); - } - else unp_llnd(q); - } - break; - case OTHERIO_STAT: - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case COMM_STAT: - addstr("common "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case NAMELIST_STAT: - addstr("namelist "); - unp_llnd(pbf->entry.Template.ll_ptr1); - break; - case CONTROL_END: - break; - default: - break; /* don't know what to do at this point */ - } - - if (pbf->variant != CONTROL_END) { - if (print_comments && cmnt && cmnt->type != FULL) - addstr(cmnt->string); - if (pbf->variant != LOGIF_NODE) - *bp++ = '\n'; - } -} - -/**************************************************************** - * * - * funp_blck -- unparse the given bif node to source string * - * along with its control children (block) * - * * - * Input: * - * bif - bif node to be unparsed * - * tab - number of tabs (2 spaces) for indenting * - * bp (implicitely) - where the output string to be * - * placed * - * * - * Output: * - * the unparse string where "bp" was pointed to * - * * - * Side Effect: * - * "bp" will be updated to the next character behind * - * the end of the unparsed string (by "addstr") * - * * - ****************************************************************/ -static void -funp_blck(bif, tab) - PTR_BFND bif; - int tab; -{ - PTR_BLOB b; - - if (print_comments && (cmnt = bif->entry.Template.cmnt_ptr) != NULL) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string); - *bp++ = '\n'; - cmnt = cmnt->next; - } - - funp_bfnd(tab, bif); - - if (bif->variant != CDOALL_NODE && bif->variant != SDOALL_NODE) { - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - if (b->ref->variant != CONTROL_END) - funp_blck(b->ref, tab+1); - else { - PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; - - if (print_comments && cmnt) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string); - *bp++ = '\n'; - cmnt = cmnt->next; - } - switch(bif->variant) { - case FOR_NODE: - case PARDO_NODE: - case PDO_NODE: - case WHILE_NODE: - if (!bif->entry.Template.lbl_ptr) { - put_tabs(tab-1); - if (bif->variant == PARDO_NODE) - addstr(" end parallel do"); - else if (bif->variant == PDO_NODE) - addstr(" end pdo"); - else addstr(" end do"); - } - break; - case IF_NODE: - case ELSEIF_NODE: - put_tabs(tab-1); - if (bif->entry.Template.bl_ptr2) - addstr(" else"); - else - addstr(" end if"); - break; - case WHERE_BLOCK_STMT: - put_tabs(tab); - if (bif->entry.Template.bl_ptr2) - addstr(" elsewhere"); - else - addstr(" end where"); - break; - case CASE_NODE: - put_tabs(tab-1); - addstr(" end select "); - if (bif->entry.Template.symbol) - addstr(bif->entry.Template.symbol->ident); - break; - case SWITCH_NODE: - put_tabs(tab-1); - break; - case PROG_HEDR: - case PROC_HEDR: - case FUNC_HEDR: - case BLOCK_DATA: - addstr(" end"); - break; - case MODULE_STMT: - addstr(" end module "); - addstr(bif->entry.Template.symbol->ident); - break; - case INTERFACE_STMT: - put_tabs(tab-1); - addstr(" end interface"); - break; - case STRUCT_DECL: - put_tabs(tab-1); - addstr(" end type "); - addstr(bif->entry.Template.symbol->ident); - break; - case PARREGION_NODE: - put_tabs(tab-1); - addstr(" end parallel"); - break; - case PARSECTIONS_NODE: - put_tabs(tab-1); - addstr(" end parallel sections"); - break; - case PSECTIONS_NODE: - put_tabs(tab-1); - addstr(" end psections"); - break; - case SINGLEPROCESS_NODE: - put_tabs(tab-1); - addstr(" end single process"); - break; - case CRITSECTION_NODE: - put_tabs(tab-1); - addstr(" end critical section"); - if (bif->entry.Template.ll_ptr1) - { - addstr("("); - unp_llnd(bif->entry.Template.ll_ptr1); - addstr(")"); - } - break; - /* case SECTION_NODE: */ - default: - break; - } - if (print_comments && cmnt && cmnt->type != FULL) - addstr(cmnt->string); - *bp++ = '\n'; - } - - for (b = bif->entry.Template.bl_ptr2; b; b = b->next) - if (b->ref->variant != CONTROL_END) - funp_blck(b->ref, tab+1); - else { - PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; - - if (print_comments && cmnt) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string); - *bp++ = '\n'; - cmnt = cmnt->next; - } - put_tabs(tab); - if (bif->variant == PDO_NODE) - addstr(" end extended"); - if (bif->variant == PSECTIONS_NODE) - addstr(" end extended"); - if (bif->variant == WHERE_BLOCK_STMT) - addstr(" end where"); - if ((bif->variant == IF_NODE) || (bif->variant == ELSEIF_NODE)) - addstr(" end if"); - if (print_comments && cmnt && cmnt->type != FULL) - addstr(cmnt->string); - *bp++ = '\n'; - } - } else { - for (b = bif->entry.Template.bl_ptr2; b; b = b->next) - if (b->ref->variant != CONTROL_END) - funp_blck(b->ref, tab+1); - else { - PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; - - if (print_comments && cmnt) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string); - *bp++ = '\n'; - cmnt = cmnt->next; - } - if (!bif->entry.Template.lbl_ptr) { - put_tabs(tab-1); - addstr(" loop"); - } - if (print_comments && cmnt && cmnt->type != FULL) - addstr(cmnt->string); - *bp++ = '\n'; - } - - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - if (b->ref->variant != CONTROL_END) - funp_blck(b->ref, tab+1); - else { - PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; - - if (print_comments && cmnt) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string); - *bp++ = '\n'; - cmnt = cmnt->next; - } - put_tabs(tab); - if (bif->variant == CDOALL_NODE) - addstr(" end cdoall"); - else - addstr(" end sdoall"); - if (print_comments && cmnt && cmnt->type != FULL) - addstr(cmnt->string); - *bp++ = '\n'; - } - } -} - - -/**************************************************************** - * * - * funparse_type -- unparse the type node for Fortran * - * * - * input: * - * type -- the node to be unparsed * - * * - * output: * - * the unparsed string * - * * - ****************************************************************/ -char * -funparse_type(type) - PTR_TYPE type; -{ - char *b1; - - if (type == NULL) - return NULL; - - bp = buffer; - switch (type->variant) { - case T_INT : - case T_FLOAT : - case T_DOUBLE: - case T_CHAR : - case T_BOOL : - case T_STRING: - addstr(ftype_name[type_index(type->variant)]); - if ((type->entry.Template.ranges) != LLNULL) - unp_llnd(type->entry.Template.ranges); - break; - case T_ARRAY: - addstr(ftype_name[type_index(type->entry.ar_decl.base_type->variant)]); - *bp++ = ' '; - unp_llnd(type->entry.ar_decl.ranges); - break; - default: - return NULL; - } - *bp++ = '\n'; - *bp++ = '\0'; - b1 = malloc(strlen(buffer) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,b1, 0); -#endif - (void) strcpy(b1, buffer); - bp = buffer; - *bp = '\0'; - return b1; -} - - -/**************************************************************** - * * - * funparse_symb -- unparse the symbol node for Fortran * - * * - * input: * - * symb -- the node to be unparsed * - * * - * output: * - * the unparsed string * - * * - ****************************************************************/ -char * -funparse_symb(symb) - PTR_SYMB symb; -{ - int i; - char buf[100], *b1, *b2; - PTR_TYPE t; - - b1 = buf; - for (i = 1; i<10; i++) - *b1++ = ' '; - t = symb->type; - i = t->variant < T_ARRAY? t->variant: t->entry.ar_decl.base_type->variant; - b2 = ftype_name[type_index(i)]; - while ( (*b1 = *b2++) != 0) - b1++; - *b1++ = ' '; - if (t->variant < T_ARRAY) { - b2 = symb->ident; - while ( (*b1 = *b2++) != 0) - b1++; - } else { - bp = buffer; - unp_llnd(t->entry.ar_decl.ranges); - b2 = buffer; - while ( (*b1 = *b2++) != 0) - b1++; - } - *b1++ = '\n'; - *b1++ = '\0'; - b2 = malloc(strlen(buf) + 1); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,b2, 0); -#endif - (void) strcpy(b2, buf); - *buffer = '\0'; - return b2; -} - - -/**************************************************************** - * * - * funparse_llnd -- unparse the low level node for Fortran * - * * - * input: * - * llnd -- the node to be unparsed * - * * - * output: * - * the unparsed string * - * * - ****************************************************************/ -char * -funparse_llnd(llnd) - PTR_LLND llnd; -{ - int len; - char *p; - - bp = buffer; /* reset the buffer pointer */ - unp_llnd(llnd); - *bp++ = '\n'; - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return p; -} - - -/**************************************************************** - * * - * funparse_bfnd -- unparse the bif node for Fortran * - * * - * input: * - * bif -- the node to be unparsed * - * * - * output: * - * the unparsed string * - * * - ****************************************************************/ -char * -funparse_bfnd(bif) - PTR_BFND bif; -{ - int len; - char *p; - - first = 1; /* Mark this is the first bif node */ - bp = buffer; /* reset the buffer pointer */ - funp_bfnd(0, bif); - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return (p); -} - - -/**************************************************************** - * * - * funparse_bfnd_w_tab -- unparse the bif node for Fortran * - * * - * input: * - * bif -- the node to be unparsed * - * * - * output: * - * the unparsed string * - * * - ****************************************************************/ -char * -funparse_bfnd_w_tab(tab, bif) - int tab; - PTR_BFND bif; -{ - int len; - char *p; - - first = 1; /* Mark this is the first bif node */ - bp = buffer; /* reset the buffer pointer */ - funp_bfnd(tab, bif); - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return (p); -} - - -char * -funparse_blck(bif) - PTR_BFND bif; -{ - int len; - char *p; - - bp = buffer; /* reset the buffer pointer */ - funp_blck(bif, figure_tabs(bif)); - - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return (p); -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c deleted file mode 100644 index 3b249f4..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c +++ /dev/null @@ -1,10 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -#define BUFLEN 50000 - -char buffer[BUFLEN], /* buffer to build the unparsed text */ - *bp; /* points to where next char goes in buffer */ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c deleted file mode 100644 index 89d7c2b..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c +++ /dev/null @@ -1,1924 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -/* Modified by Jenq-Kuen Lee Feb 24,1988 */ -/* The simple un-parser for VPC++ */ -#include -#include - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -# include "db.h" -# include "vparse.h" - -# define NULLTEST(VAR) (VAR == NULL? -1 : VAR->id) -# define type_index(X) (X-T_INT) -# define binop(n) (n >= EQ_OP && n <= NEQV_OP) -# define BUFLEN 500000 - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -extern PTR_SYMB cur_symb_head; /* point to the head of the list of symbols */ -extern char buffer[], *bp; - -static int first; -static int global_tab; -static char buffera[BUFLEN]; -static char temp_buf[BUFLEN]; /* for temporary usage */ -static char temp1_buf[BUFLEN]; -static char temp2_buf[BUFLEN]; /* for temporary usage */ - -static int basket_needed(); - -/* - * forward references - */ -static void cunp_blck(); -static void gen_simple_type(); -static void gen_func_hedr(); -static PTR_SYMB find_declarator(); -static void cunp_llnd(); -int cdrtext(); -int is_scope_op_needed(); - -static -char *cop_name[] = { - "->", /* 0 */ - "!", /* 1 */ - "~", /* 2 */ - "++", /* 3 */ - "--", /* 4 */ - "-", /* 5 */ - "*", /* 6 */ - "&", /* 7 */ - "sizeof ", /* 8 */ - "*", /* 9 */ - "/", /* 10 */ - "%", /* 11 */ - "+", /* 12 */ - "-", /* 13 */ - ">>", /* 14 */ - "<<", /* 15 */ - "<", /* 16 */ - ">", /* 17 */ - "<=", /* 18 */ - ">=", /* 19 */ - "==", /* 20 */ - "!=", /* 21 */ - "&", /* 22 */ - "^", /* 23 */ - "|", /* 24 */ - "&&", /* 25 */ - "||", /* 26 */ - "=", /* 27 */ - "+=", /* 28 */ - "-=", /* 29 */ - "&=", /* 30 */ - "|=", /* 31 */ - "*=", /* 32 */ - "/=", /* 33 */ - "%=", /* 34 */ - "^=", /* 35 */ - "<<=", /* 36 */ - ">>=" /* 37 */ -}; - - -/* Added for VPC */ -static -char *ridpointers[] = { - "", /* unused */ - "", /* int */ - "char", /* char */ - "float", /* float */ - "double", /* double */ - "void", /* void */ - "", /* unused1 */ - "unsigned", /* unsigned */ - "short", /* short */ - "long", /* long */ - "auto", /* auto */ - "static", /* static */ - "extern", /* extern */ - "register", /* register */ - "typedef", /* typedef */ - "signed", /* signed */ - "const", /* const */ - "volatile", /* volatile */ - "syn", /* syn */ - "shared", /* shared */ - "private", /* private */ - "future", /* future */ - "virtual", /* virtual */ - "inline", /* inline */ - "friend", /* friend */ - "", /* public */ - "", /* protected */ -}; - -/* Added for VPC */ -static int -re_map_status(rid_value) - int rid_value; -{ - switch (rid_value) { - - /* The following flag store in type->entry.descriptive.long_short_flag */ - case (int) BIT_PRIVATE: return((int)RID_PRIVATE); - case (int) BIT_FUTURE: return((int)RID_FUTURE); - case (int) BIT_VIRTUAL: return((int)RID_VIRTUAL); - case (int) BIT_INLINE: return((int)RID_INLINE); - - case (int) BIT_UNSIGNED:return((int)RID_UNSIGNED); - case (int) BIT_SIGNED : return((int)RID_SIGNED); - - - case (int) BIT_SHORT : return((int)RID_SHORT); - case (int) BIT_LONG : return((int)RID_LONG); - - - case (int) BIT_VOLATILE:return((int)RID_VOLATILE); - case (int) BIT_CONST :return((int)RID_CONST); - - case (int) BIT_TYPEDEF :return((int)RID_TYPEDEF); - case (int) BIT_EXTERN :return((int)RID_EXTERN); - case (int) BIT_AUTO : return((int)RID_AUTO); - case (int) BIT_STATIC : return((int)RID_STATIC); - case (int) BIT_REGISTER:return((int)RID_REGISTER); - case (int) BIT_FRIEND: return((int)RID_FRIEND); - default: - return(0); - } -} - - -static void -put_tabs(n) - int n; -{ - int i; - - for(i = 0; i < n; i++) { - *bp++ = ' '; - *bp++ = ' '; - } -} - - -static void -addstr(s) - char *s; -{ - while( (*bp = *s++) != 0) - bp++; -} - - -static void -addstr1(index) - int index ; -{ - int i; - - i = re_map_status(index); - if (i) { - addstr(ridpointers[i]) ; - *bp++ = ' '; - } -} - - - -static void -put_right(s, temp_buf) - char *s ; - char *temp_buf; -{ - int len,i ; - char *p; - - i=0; - len = strlen(temp_buf) ; - for ( p = s ; *p ; p++,i++) - *(temp_buf + len+ i) = *p ; - *(temp_buf+len+i+1) = '\0'; -} - - -static void -put_left(s, temp_buf) - char *s ; - char *temp_buf; -{ - int i ; - int len1 ,len2; - - len1 = strlen(s); - len2 = strlen(temp_buf) ; - *(temp_buf+len2+len1) = '\0'; - for ( i=len2 ; i ; i--) - *(temp_buf + len1+ i-1) = *(temp_buf + i -1 ); - for ( i=0; *s ; i++,s++) - *(temp_buf + i ) = *s ; - -} - - -static void -clean(temp_buf) - char *temp_buf; -{ - char *p; - - for (p = temp_buf ; p < temp_buf+BUFLEN ;) - *p++ = '\0'; -} - - -/* - * gen_if_node(pbf) --- generate the if statement pointed to by pbf. - */ -static void -gen_branch(branch_type, pbf) - char *branch_type; - PTR_BFND pbf; -{ - PTR_BFND gen_stmt_list(); - addstr(branch_type); - *bp++ = '('; - cunp_llnd(pbf->entry.Template.ll_ptr1); - *bp++ = ')'; -} - - -static void -gen_descriptive_type(symb1) - PTR_SYMB symb1 ; -{ - int i; - PTR_TYPE q ; - - for (q = symb1->type; q ; ) { - switch ( q->variant) { - case T_POINTER : - case T_FUNCTION : - q = q->entry.Template.base_type ; - break; - case T_DESCRIPT : - for (i=1; i< MAX_BIT; i= i*2) - addstr1(q->entry.descriptive.long_short_flag & i); - q = q->entry.descriptive.base_type ; - break ; - default: /* It might need more for complicated case */ - q = (PTR_TYPE) NULL ; - } - } - - -} - - -static void -cunp_bfnd(tabs,pbf) - int tabs; - PTR_BFND pbf; -{ - /* PTR_BFND pbfnd, pnext; */ - /* PTR_SYMB s; */ - /* int i; */ - /* int lines; */ - PTR_CMNT cmnt; - if (!pbf) return; - /* printf("variant = %d\n", pbf->variant); */ - if ( (cmnt = pbf->entry.Template.cmnt_ptr) != 0) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string); - addstr("\n"); - cmnt = cmnt->next; - } - - if (pbf->label) { - char b[10]; - - sprintf(b ,"%-5d ", (int)(pbf->label->stateno)); - addstr(b); - } - - put_tabs(tabs); - - switch (pbf->variant) { - case GLOBAL : - case PROG_HEDR : - case PROC_HEDR : - break ; - case FUNC_HEDR : - gen_simple_type(pbf->entry.Template.symbol->type, pbf, tabs); - gen_func_hedr(pbf->entry.Template.symbol, pbf, tabs); - break; - case IF_NODE : - gen_branch("if ",pbf); - break; - case LOGIF_NODE : - case ARITHIF_NODE: - case WHERE_NODE : - break; - case FOR_NODE : - addstr("for ("); - cunp_llnd(pbf->entry.Template.ll_ptr1); - *bp++ = ';'; - cunp_llnd(pbf->entry.Template.ll_ptr2); - *bp++ = ';'; - cunp_llnd(pbf->entry.Template.ll_ptr3); - addstr(") ") ; - break; - case FORALL_NODE : - case WHILE_NODE : - addstr("while ("); - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(") ") ; - break; - case ASSIGN_STAT: - case IDENTIFY: - case PROC_STAT : - case SAVE_DECL: - case CONT_STAT: - case FORMAT_STAT: - break; - case LABEL_STAT: - addstr(pbf->entry.Template.lbl_ptr->label_name->ident); - addstr(" : "); - break; - case GOTO_NODE: - addstr("goto "); - addstr(pbf->entry.Template.lbl_ptr->label_name->ident); - addstr(" ;"); - break; - case ASSGOTO_NODE: - case COMGOTO_NODE: - case STOP_STAT: - break; - case RETURN_STAT: - addstr("return"); - if (pbf->entry.Template.ll_ptr1) { - addstr("("); - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(");"); - } - break; - case PARAM_DECL : - case DIM_STAT: - case EQUI_STAT: - case DATA_DECL: - case READ_STAT: - case WRITE_STAT: - case OTHERIO_STAT: - case COMM_STAT: - case CONTROL_END: - break; - case ENUM_DECL : /* New added for VPC */ - case CLASS_DECL: /* New added for VPC */ - case UNION_DECL: /* New added for VPC */ - case STRUCT_DECL: /* New added for VPC */ - case COLLECTION_DECL: - { PTR_BLOB blob ; - PTR_SYMB symb,symb1 ; - PTR_LLND llptr,llptr2; - int i; - - llptr = pbf->entry.Template.ll_ptr1; - symb1 = find_declarator(llptr); - if (symb1) gen_descriptive_type(symb1); - switch (pbf->variant) { - case UNION_DECL: addstr("union ") ; - break; - case STRUCT_DECL:addstr("struct ") ; - break; - case ENUM_DECL : addstr("enum ") ; - break; - case CLASS_DECL : addstr("class ") ; - break; - case COLLECTION_DECL : addstr("Collection ") ; - break; - } - if ( (symb=pbf->entry.Template.symbol) != 0) { - addstr(symb->ident); - *bp++ = ' '; - } - if (pbf->entry.Template.ll_ptr2) { - addstr(" : "); - for (llptr2 = pbf->entry.Template.ll_ptr2,i=0;llptr2; - llptr2= llptr2->entry.Template.ll_ptr2,i++) - { if (i) addstr(" , "); - addstr(llptr2->entry.Template.ll_ptr1->entry.Template.symbol->ident); - } - } - if ( (blob=pbf->entry.Template.bl_ptr1) != 0) - { addstr(" {\n") ; - for ( ; blob ; blob = blob->next) - cunp_blck(blob->ref, tabs+2); - put_tabs(tabs); addstr("} "); - } - cunp_llnd(llptr); - *bp++ = ';'; - break; - } - case DERIVED_CLASS_DECL: /* Need More for VPC */ - case VAR_DECL: - { PTR_SYMB symb1 ; - PTR_LLND llptr; - - llptr = pbf->entry.Template.ll_ptr1; - symb1 = find_declarator(llptr); - if (symb1) - gen_simple_type(symb1->type, pbf, tabs) ; - cunp_llnd(llptr); - if (pbf->control_parent->variant != ENUM_DECL) - addstr(" ;"); - break; - } - - case EXPR_STMT_NODE: /* New added for VPC */ - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(" ;"); - break ; - case DO_WHILE_NODE: /* New added for VPC */ - /* Need study */ - case SWITCH_NODE : /* New added for VPC */ - addstr("switch ("); - cunp_llnd(pbf->entry.Template.ll_ptr1); - *bp++ = ')'; - break ; - case CASE_NODE : /* New added for VPC */ - addstr("case "); - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(" : ") ; - break ; - case DEFAULT_NODE: /* New added for VPC */ - addstr("default :") ; - break; - case BASIC_BLOCK : - break ; - case BREAK_NODE : /* New added for VPC */ - addstr("break;"); - break; - case CONTINUE_NODE: /* New added for VPC */ - addstr("continue;"); - case RETURN_NODE : /* New added for VPC */ - addstr("return"); - if (pbf->entry.Template.ll_ptr1) { - addstr("("); - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(");"); - } - break; - case ASM_NODE : /* New added for VPC */ - break; /* Need More */ - case SPAWN_NODE : /* New added for VPC */ - addstr("spawn"); - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(" ; "); - break; - case PARFOR_NODE : /* New added for VPC */ - addstr("parfor ("); - cunp_llnd(pbf->entry.Template.ll_ptr1); - *bp++ = ';'; - cunp_llnd(pbf->entry.Template.ll_ptr2); - *bp++ = ';'; - cunp_llnd(pbf->entry.Template.ll_ptr3); - addstr(") ") ; - break; - case FUTURE_STMT: - addstr("future "); - cunp_llnd(pbf->entry.Template.ll_ptr1); - addstr(" ("); - cunp_llnd(pbf->entry.Template.ll_ptr2); - addstr(")"); - break; - case PAR_NODE : /* New added for VPC */ - addstr("par ") ; - break; - default: - printf(" unknown biffnode = %d\n", pbf->variant); - exit(0); - break; /* don't know what to do at this point */ - } - *bp++ = '\n'; -} - - -/************************************************************************ - * * - * generate simple declaration * - * * - ************************************************************************/ -static void -gen_simple_type(q_type, dum_pbf, tabs) - PTR_TYPE q_type ; - PTR_BFND dum_pbf ; - int tabs; -{ - PTR_TYPE q,q3 ; - PTR_SYMB s ,symb; - /* PTR_BLOB blob ; */ - /* PTR_BFND pbf; */ - int i; - - for (q = q_type ; q ; ) { - switch (q->variant) { - case T_REFERENCE: - case T_POINTER : - case T_FUNCTION : - case T_ARRAY : - q = q->entry.Template.base_type ; - break ; - case T_DESCRIPT : - for (i=1; i< MAX_BIT; i *= 2) - addstr1(q->entry.descriptive.long_short_flag & i); - q = q->entry.descriptive.base_type ; - break ; - case DEFAULT : q = (PTR_TYPE ) NULL ; - break ; - case T_DERIVED_COLLECTION : - symb = q->entry.col_decl.collection_name; - q3 = q->entry.col_decl.base_type; - addstr(symb->ident); - if (q3) { - addstr("<"); - gen_simple_type(q3,dum_pbf,tabs); - addstr(">"); - } - addstr(" "); - q= (PTR_TYPE) NULL ; - break; - case T_DERIVED_TYPE : - s = q->entry.derived_type.symbol ; - switch (s->variant) { - case STRUCT_NAME: addstr("struct "); break; - case ENUM_NAME: addstr("enum "); break; - case UNION_NAME: addstr("union "); break; - case CLASS_NAME: break; - case COLLECTION_NAME: break; - case TYPE_NAME: - default: - break ; - } - addstr(s->ident); - *bp++ = ' '; - if (s->variant==COLLECTION_NAME) { - if ( (q3=s->type->entry.derived_class.base_type) != 0) { - addstr("<"); - gen_simple_type(q3,dum_pbf,tabs); - addstr(">"); - } - } - q = (PTR_TYPE) NULL ; - break ; - - case T_INT : - addstr("int "); - q= (PTR_TYPE) NULL ; - break; - case T_CHAR : - addstr("char "); - q= (PTR_TYPE) NULL ; - break; - case T_VOID : - addstr("void "); - q= (PTR_TYPE) NULL ; - break; - case T_DOUBLE : - addstr("double "); - q= (PTR_TYPE) NULL ; - break; - case T_FLOAT : - addstr("float "); - q= (PTR_TYPE) NULL ; - break; - - case T_UNION : - case T_STRUCT : - case T_ENUM : - case T_CLASS : - switch (q->variant) { - case T_UNION : addstr("union ") ; - break; - case T_STRUCT : addstr("struct ") ; - break; - case T_ENUM : addstr("enum ") ; - break; - case T_CLASS : addstr("class ") ; - break; - case T_COLLECTION: addstr("Collection ") ; - break; - } - - if ( (symb=q->entry.derived_class.original_class->entry.Template.symbol) != 0) { - addstr(symb->ident); - *bp++ = ' '; - } - - q = (PTR_TYPE) NULL ; - break; - case T_COLLECTION: - if ( (symb=q->entry.derived_class.original_class->entry.Template.symbol) != 0) - { addstr(symb->ident); - if ( (q3=q->entry.derived_class.base_type) != 0) { - addstr("<"); - gen_simple_type(q3,dum_pbf,tabs); - addstr(">"); - } - addstr(" "); - } - q= (PTR_TYPE) NULL ; - break; - /* not in leejenq's version - case T_DERIVED_CLASS: - { PTR_BFND pbf ; - - pbf = q->entry.derived_class.original_class ; - addstr("class"); - if (symb=pbf->entry.Template.symbol) - addstr(symb->ident); - addstr(" : "); - cunp_llnd(pbf->entry.Template.ll_ptr2); - if (blob=pbf->entry.Template.bl_ptr1) { - addstr(" {") ; - for ( ; blob ; blob = blob->next) - cunp_bfnd(tabs,blob->ref); - put_tabs(tabs); *bp++ = '}'; - } - break ; - } - */ - default : - break; - } - } -} - - -static int -cprecedence(op) - int op ; -{ - switch (op) { - case NEW_OP: - case DELETE_OP: - return(2); - case EQ_OP : return(7); - case LT_OP : return(6); - case GT_OP : return(6); - case NOTEQL_OP : return(7); - case LTEQL_OP : return(6); - case GTEQL_OP : return(6); - case ADD_OP : return(4); - case OR_OP : return(12); - case MULT_OP : return(3); - case DIV_OP : return(3); - case AND_OP : return(11); - case XOR_OP : return(9); - - case LE_OP : return(6); /* duplicated */ - case GE_OP : return(6); /* duplicated */ - case NE_OP : return(7); /* duplicated */ - case UNARY_ADD_OP: return(2); /* unary operation */ - case SUB_OP : return(2); /* unary operation */ - case SUBT_OP : return(11); /* binary operator */ - case MINUS_OP : return(2); /* unary operator */ - case NOT_OP : return(2); - - case PLUS_ASSGN_OP: - case MINUS_ASSGN_OP: - case AND_ASSGN_OP: - case IOR_ASSGN_OP: - case MULT_ASSGN_OP: - case DIV_ASSGN_OP: - case MOD_ASSGN_OP: - case XOR_ASSGN_OP: - case LSHIFT_ASSGN_OP: - case RSHIFT_ASSGN_OP : - - case ARITH_ASSGN_OP: - case ASSGN_OP : return(14); - case DEREF_OP : return(2); - case POINTST_OP : return(1); - case RECORD_REF : return(1); - case BITAND_OP : return(10); - case BITOR_OP : return(10); - case LSHIFT_OP : return(5); - case RSHIFT_OP : return(5); - case MOD_OP : return(3); /* New added for VPC */ - case ADDRESS_OP: return(2); - case SIZE_OP : return(2); - case PLUSPLUS_OP: - case MINUSMINUS_OP: return(2); - case EXPR_LIST : return(15); - default : return(0); - } -} - - -int -mapping(op) -int op ; -{ - switch (op) { - case EQ_OP : return(20); - case LT_OP : return(16); - case GT_OP : return(17); - case NOTEQL_OP : return(21); - case LTEQL_OP : return(18); - case GTEQL_OP : return(19); - case ADD_OP : return(12); - case OR_OP : return(26); - case MULT_OP : return(9); - case DIV_OP : return(10); - case AND_OP : return(25); - case XOR_OP : return(23); - - case LE_OP : return(18); /* duplicated */ - case GE_OP : return(19); /* duplicated */ - case NE_OP : return(21); /* duplicated */ - case SUB_OP : return(5); /* unary operator */ - case MINUS_OP : return(5); /* unary operator */ - case SUBT_OP : return(5); /* binary operator */ - case NOT_OP : return(1); - - case PLUS_ASSGN_OP: return(28); - case MINUS_ASSGN_OP:return(29); - case AND_ASSGN_OP: return(30); - case IOR_ASSGN_OP: return(31); - case MULT_ASSGN_OP:return(32); - case DIV_ASSGN_OP: return(33); - case MOD_ASSGN_OP: return(34); - case XOR_ASSGN_OP: return(35); - case LSHIFT_ASSGN_OP:return(36); - case RSHIFT_ASSGN_OP :return(37); - case ASSGN_OP : return(27); - - case DEREF_OP : return(6); - case POINTST_OP : return(0); - case BITAND_OP : return(22); - case BITOR_OP : return(24); - case LSHIFT_OP : return(15); - case RSHIFT_OP : return(14); - case MINUSMINUS_OP: return(4); /* New added for VPC */ - case PLUSPLUS_OP : return(3); /* New added for VPC */ - case UNARY_ADD_OP : return(12); /* New added for VPC */ - case BIT_COMPLEMENT_OP :return(2); /* New added for VPC */ - case MOD_OP : return(11); /* New added for VPC */ - case SIZE_OP : return(8); /* New added for VPC */ - case ADDRESS_OP: return(7); - default : sprintf(buffera, "bad case 1"); - return(0); - } -} - - -static void -gen_op(value) - int value; -{ - switch (value) { - case ((int) PLUS_EXPR) : addstr("+= "); - break; - case ((int) MINUS_EXPR): addstr("-= "); - break; - case ((int) BIT_AND_EXPR):addstr("&= "); - break; - case ((int) BIT_IOR_EXPR):addstr("|= "); - break; - case ((int) MULT_EXPR): addstr("*= "); - break; - case ((int) TRUNC_DIV_EXPR): addstr("/= "); - break; - case ((int) TRUNC_MOD_EXPR): addstr("%= "); - break; - case ((int) BIT_XOR_EXPR): addstr("^= "); - break; - case ((int) LSHIFT_EXPR): addstr("<<= "); - break; - case ((int) RSHIFT_EXPR): addstr(">>= "); - break; - default : addstr("= "); - } -} - -static char left_mod[2000]; -static void -gen_simple_type_2(q_type, dum_pbf, tabs) - PTR_TYPE q_type; - PTR_BFND dum_pbf; - int tabs; -{ - PTR_BFND pbf; - PTR_TYPE q ; - PTR_SYMB s ,symb; - PTR_BLOB blob ; - PTR_LLND r1; - /* char *old_bp; */ - int level ; - int i; -char * bp_save; - - left_mod[0] = '\0'; - level= 0 ; - clean(temp_buf); - for (q = q_type ; q ; ) - { - switch (q->variant) { - case T_POINTER : - put_left("*",temp_buf); - level = 1; - q = q->entry.Template.base_type ; - break; - case T_REFERENCE: - put_left("&",temp_buf); - level = 1; - q = q->entry.Template.base_type ; - break; - case T_FUNCTION : - put_left("(",temp_buf); - put_right(")",temp_buf); - put_right("()",temp_buf); - q = q->entry.Template.base_type ; - break; - case T_ARRAY : - if (level >0) { - put_left("(",temp_buf); - put_right(")",temp_buf); - } - clean(temp1_buf); - bp_save = bp; /* Backup before switching buffer */ - put_left(buffer,temp1_buf); /* Backup before switching buffer */ - clean(buffer); - bp = &(buffer[0]); - for (r1=q->entry.ar_decl.ranges;r1; r1= r1->entry.Template.ll_ptr2) - { - addstr("["); - cunp_llnd(r1->entry.Template.ll_ptr1); - addstr("]"); - } - put_right(buffer,temp_buf); - clean(buffer); - bp = bp_save; - put_left(temp1_buf,buffer); - q = q->entry.Template.base_type ; - break ; - case T_DESCRIPT : - clean(temp1_buf); - bp_save = bp; /* Backup before switching buffer */ - put_left(buffer,temp1_buf); /* Backup before switching buffer */ - clean(buffer); - bp = &(buffer[0]); - for (i=1; i< MAX_BIT; i= i*2) - addstr1(q->entry.descriptive.long_short_flag & i); - put_right(buffer, left_mod); - clean(buffer); - bp = bp_save; - put_left(temp1_buf,buffer); - q = q->entry.descriptive.base_type ; - break ; - case DEFAULT : - put_left("int ",temp_buf); - q = (PTR_TYPE ) NULL ; - break ; - case T_DERIVED_TYPE : - clean(temp1_buf); - bp_save = bp; /* Backup before switching buffer */ - put_left(buffer,temp1_buf); /* Backup before switching buffer */ - clean(buffer); - bp = &(buffer[0]); - s = q->entry.derived_type.symbol ; - switch (s->variant) { - case STRUCT_NAME: addstr("struct "); break; - case ENUM_NAME: addstr("enum "); break; - case UNION_NAME: addstr("union "); break; - case CLASS_NAME: addstr("class "); break; - case COLLECTION_NAME: addstr("Collection "); break; - case TYPE_NAME: - default: - break ; - } - addstr(s->ident); - addstr(" "); - put_left(buffer,temp_buf); - clean(buffer); - bp = bp_save; - put_left(temp1_buf,buffer); - q = (PTR_TYPE) NULL ; - break ; - case T_INT : - put_left("int ",temp_buf); - q= (PTR_TYPE) NULL ; - break; - case T_CHAR : - put_left("char ",temp_buf); - q= (PTR_TYPE) NULL ; - break; - case T_VOID : - put_left("void ",temp_buf); - q= (PTR_TYPE) NULL ; - break; - case T_DOUBLE : - put_left("double ",temp_buf); - q= (PTR_TYPE) NULL ; - break; - case T_FLOAT : - put_left("float ",temp_buf); - q= (PTR_TYPE) NULL ; - break; - case T_UNION : - case T_STRUCT : - case T_ENUM : - case T_CLASS : - case T_COLLECTION: - case T_DERIVED_CLASS: - clean(temp1_buf); - bp_save = bp; /* Backup before switching buffer */ - put_left(buffer,temp1_buf); /* Backup before switching buffer */ - clean(buffer); - bp = &(buffer[0]); - switch (q->variant) { - case T_UNION : addstr("union ") ; - break; - case T_STRUCT : addstr("struct ") ; - break; - case T_ENUM : addstr("enum ") ; - break; - case T_DERIVED_CLASS: - case T_CLASS : addstr("class ") ; - break; - case T_COLLECTION : addstr("Collection ") ; - break; - } - if ( (symb=q->entry.derived_class.original_class->entry.Template.symbol) != 0) - { addstr(symb->ident); - addstr(" "); - } - pbf = q->entry.derived_class.original_class ; - if (pbf->entry.Template.ll_ptr2) { - addstr(" : "); - cunp_llnd(pbf->entry.Template.ll_ptr2); - } - if ( (blob=q->entry.derived_class.original_class->entry.Template.bl_ptr1) != 0) - { addstr(" {\n") ; - for ( ; blob ; blob = blob->next) - { - cdrtext(blob->ref,tabs,0,100); - addstr("\n"); - } - put_tabs(tabs); addstr("} "); - } - put_left(buffer,temp_buf); - clean(buffer); - bp = bp_save; - put_left(temp1_buf,buffer); - q = (PTR_TYPE) NULL ; - break; - default : sprintf(buffera,"unexpected type"); - } - } - put_left(left_mod, temp_buf); - addstr(temp_buf); -} - -static -void cunp_llnd(pllnd) -PTR_LLND pllnd; -{ - PTR_LLND pll2; - char ch; - if (pllnd == NULL) return; - - switch (pllnd->variant) { - case INT_VAL : - { char sb[64]; - - sprintf(sb, "%d", pllnd->entry.ival); - addstr(sb); - break; - } - case STMT_STR : break ; - case FLOAT_VAL : - case DOUBLE_VAL : - addstr(pllnd->entry.string_val); - break; - case STRING_VAL : - *bp++ = '"'; - sprintf(buffera, "%s", pllnd->entry.string_val); - addstr(buffera); - *bp++ = '"'; - break; - case BOOL_VAL : - break; - case CHAR_VAL : - ch = pllnd->entry.cval; - switch (ch) { - case '\t': addstr("\'\\"); addstr("t\'"); return; - case '\n': addstr("\'\\"); addstr("n\'"); return; - case '\b': addstr("\'\\"); addstr("b\'"); return; - case '\f': addstr("\'\\"); addstr("f\'"); return; - case '\r': addstr("\'\\"); addstr("r\'"); return; - case '\0': addstr("\'\\"); addstr("0\'"); return; - case '\\': addstr("\'\\"); addstr("\\"); addstr("\'"); return; - case '\'': addstr("\'\\"); addstr("\'\'"); return; - default: break; - } - sprintf(buffera, "\'%c\'",pllnd->entry.cval); - addstr(buffera); - break; - case THIS_NODE: - addstr("this"); - break; - case CONST_REF : - case VAR_REF : - case ENUM_REF : - addstr(pllnd->entry.Template.symbol->ident); - break; - case RECORD_REF: - cunp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = '.'; - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break ; - case ARRAY_OP : - *bp++ = '('; - cunp_llnd(pllnd->entry.Template.ll_ptr1); - for (pll2 = pllnd->entry.Template.ll_ptr2;pll2; pll2= pll2->entry.Template.ll_ptr2) { - *bp++ = '['; - cunp_llnd(pll2->entry.Template.ll_ptr1); - *bp++ = ']'; - } - *bp++ = ')'; - break; - - case ARRAY_REF : - addstr(pllnd->entry.array_ref.symbol->ident); - for (pll2 = pllnd->entry.Template.ll_ptr1;pll2; pll2= pll2->entry.Template.ll_ptr2) { - *bp++ = '['; - cunp_llnd(pll2->entry.Template.ll_ptr1); - *bp++ = ']'; - } - break; - case CONSTRUCTOR_REF : - break; - case ACCESS_REF : - break; - case CONS : - break; - case ACCESS : - break; - case IOACCESS : - break; - case PROC_CALL : - case FUNC_CALL : - addstr(pllnd->entry.Template.symbol->ident); - *bp++ = '('; - cunp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ')'; - break; - case EXPR_LIST : - cunp_llnd(pllnd->entry.Template.ll_ptr1); - if (pllnd->entry.Template.ll_ptr2) { - addstr(","); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - } - break; - case EQUI_LIST : - break; - case COMM_LIST : - break; - case VAR_LIST : - case CONTROL_LIST : - break; - case RANGE_LIST : - *bp++ = '['; - cunp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ']'; - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case DDOT : - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(":"); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case COPY_NODE : - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("#"); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case VECTOR_CONST : /* NEW ADDED FOR VPC++ */ - addstr("[ "); - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(" ]"); - break ; - case INIT_LIST: - addstr("{ "); - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(" }"); - break ; - case BIT_NUMBER: - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(" : "); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break ; - case DEF_CHOICE : - case SEQ : - break; - case SPEC_PAIR : - break; - - - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP : - case LTEQL_OP : - case GTEQL_OP : - case ADD_OP : - case SUBT_OP : - case OR_OP : - case MULT_OP : - case DIV_OP : - case AND_OP : - case XOR_OP : - case POINTST_OP : /* New added for VPC */ - case LE_OP : /* New added for VPC *//*Duplicated*/ - case GE_OP : /* New added for VPC *//*Duplicated*/ - case NE_OP : /* New added for VPC *//*Duplicated*/ - - case PLUS_ASSGN_OP: - case MINUS_ASSGN_OP: - case AND_ASSGN_OP: - case IOR_ASSGN_OP: - case MULT_ASSGN_OP: - case DIV_ASSGN_OP: - case MOD_ASSGN_OP: - case XOR_ASSGN_OP: - case LSHIFT_ASSGN_OP: - case RSHIFT_ASSGN_OP : - - case ARITH_ASSGN_OP: - case ASSGN_OP : /* New added for VPC */ - case BITAND_OP : /* New added for VPC */ - case BITOR_OP : /* New added for VPC */ - case LSHIFT_OP : /* New added for VPC */ - case RSHIFT_OP : /* New added for VPC */ - case MOD_OP : /* New added for VPC */ - { - int i, j ; - PTR_LLND p; - - i = pllnd->variant ; - p = pllnd->entry.Template.ll_ptr1 ; - j = p->variant; - if ( cprecedence(i) < cprecedence(j) ) { - *bp++ = '('; - cunp_llnd(p); - *bp++ = ')'; - if (pllnd->variant != ARITH_ASSGN_OP) - addstr(cop_name[mapping(i)] ); - else - gen_op(pllnd->entry.Template.symbol->variant); - } else { - cunp_llnd(p); - if (pllnd->variant != ARITH_ASSGN_OP) - addstr(cop_name[mapping(i)]); - else - gen_op(pllnd->entry.Template.symbol->variant); - } - p = pllnd->entry.Template.ll_ptr2; - j = p->variant; - if ( cprecedence(i) <= cprecedence(j)) { - *bp++ = '('; - cunp_llnd(p); - *bp++ = ')'; - } else - cunp_llnd(p); - break ; - } - case SUB_OP : /* duplicated unary minus */ - case MINUS_OP : /* unary operations */ - case UNARY_ADD_OP : /* New added for VPC */ - case BIT_COMPLEMENT_OP : /* New added for VPC */ - case NOT_OP : - case DEREF_OP : - case SIZE_OP : /* New added for VPC */ - case ADDRESS_OP : /* New added for VPC */ - { - int i, j; - PTR_LLND p; - - i = pllnd->variant ; - p = pllnd->entry.Template.ll_ptr1 ; - j = p->variant; - addstr(cop_name[mapping(i)] ); - if ( cprecedence(i) < cprecedence(j) ) { - *bp++ = '('; - cunp_llnd(p); - *bp++ = ')'; - } else - cunp_llnd(p); - } - break; - case SAMETYPE_OP : /* New added for VPC */ - addstr("SameType ("); - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(" , "); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - addstr(")"); - break; - case MINUSMINUS_OP: /* New added for VPC */ - case PLUSPLUS_OP : /* New added for VPC */ - { - int i ,j ; - PTR_LLND p; - - i = pllnd->variant; - if ( (p = pllnd->entry.Template.ll_ptr1) != 0) { - j = p->variant; - addstr(cop_name[mapping(i)] ); - if ( cprecedence(i) < cprecedence(j) ) { - *bp++ = '('; - cunp_llnd(p); - *bp++ = ')'; - } else - cunp_llnd(p); - } else { - p = pllnd->entry.Template.ll_ptr2 ; - j = p->variant; - if ( cprecedence(i) < cprecedence(j) ) { - *bp++ = '('; - cunp_llnd(p); - *bp++ = ')'; - } else - cunp_llnd(p); - addstr(cop_name[mapping(i)] ); - } - } - break; - - case STAR_RANGE : - addstr(" : "); - break; - case FUNCTION_OP : /* New added for VPC */ - *bp++ = '('; - cunp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ')'; - *bp++ = '('; - cunp_llnd(pllnd->entry.Template.ll_ptr2); - *bp++ = ')'; - break ; - case CLASSINIT_OP : /* New added for VPC */ - { - cunp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = '('; - cunp_llnd(pllnd->entry.Template.ll_ptr2); - *bp++ = ')'; - } - break ; - case DELETE_OP: - addstr("delete "); - if (pllnd->entry.Template.ll_ptr2) { - *bp++ ='['; - cunp_llnd(pllnd->entry.Template.ll_ptr2); - addstr("] "); - } - cunp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case SCOPE_OP: - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("::"); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case NEW_OP: - { PTR_LLND pllnd1; - addstr("new "); - pllnd1 = pllnd->entry.Template.ll_ptr1; - gen_simple_type_2(pllnd1->type,BFNULL,global_tab); - if (pllnd->entry.Template.ll_ptr2) { - *bp++= '('; - cunp_llnd(pllnd->entry.Template.ll_ptr2); - addstr(") "); - } - break; - } - case CAST_OP : /* New added for VPC */ - *bp++ = '('; - gen_simple_type_2(pllnd->type, BFNULL, global_tab); - *bp++ = ')'; - *bp++ = ' '; - cunp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case EXPR_IF : /* New added for VPC */ - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(" ? "); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case EXPR_IF_BODY : /* New added for VPC */ - cunp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(" : "); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case FUNCTION_REF : /* New added for VPC */ - addstr(pllnd->entry.Template.symbol->ident); - *bp++ = '('; - /* cunp_llnd(pllnd->entry.Template.ll_ptr1); */ - *bp++ = ')'; - break ; - case LABEL_REF: /* Fortran Version, For VPC we need more */ - { char sb[64]; - - sprintf(sb, "%d", (int)(pllnd->entry.label_list.lab_ptr->stateno)); - addstr(sb); - break; - } - default : - break; - } -} - -static int -is_param_decl(var_bf, functor) - PTR_BFND var_bf ; - PTR_SYMB functor ; -{ - PTR_LLND flow_ptr,lpr ; - PTR_SYMB s ; - - switch (var_bf->variant) { - case VAR_DECL : - case ENUM_DECL: - case CLASS_DECL: - case UNION_DECL: - case STRUCT_DECL: - case DERIVED_CLASS_DECL : - lpr = var_bf->entry.Template.ll_ptr1 ; - for (flow_ptr = lpr; flow_ptr ; flow_ptr = flow_ptr->entry.Template.ll_ptr1) { - if ((flow_ptr->variant == VAR_REF) || - (flow_ptr->variant == ARRAY_REF) || - (flow_ptr->variant == FUNCTION_REF) ) break ; - } - if (!flow_ptr) - return(0); - - for (s = functor->entry.member_func.in_list; s ; s = s->entry.var_decl.next_in) - if (flow_ptr->entry.Template.symbol == s) - return(1); - break; - default : - break; - } - return(0) ; -} - - -static int -this_is_decl(variant) -int variant ; -{ - switch(variant) { - case CLASS_DECL : - case UNION_DECL : - case STRUCT_DECL : - case ENUM_DECL : - case VAR_DECL : - case DERIVED_CLASS_DECL: - return(1); - default : - break; - } - return(0); -} - - -static int -not_explicit(s, pbf) - PTR_SYMB s ; - PTR_BFND pbf ; -{ - PTR_BLOB blob ; - PTR_LLND lptr1; - PTR_SYMB symbptr; - - for (blob = pbf->entry.Template.bl_ptr1 ; blob ; blob = blob->next ) { - if (!this_is_decl(blob->ref->variant )) return(1); - for (lptr1=blob->ref->entry.Template.ll_ptr1 ; lptr1; lptr1 = lptr1->entry.Template.ll_ptr2) { - symbptr = find_declarator(lptr1); - if ( s == symbptr) return(0); - } - } - return(1); -} - - -static int -not_class(pbf) -PTR_BFND pbf; -{ - switch(pbf->variant) { - case GLOBAL : - case CLASS_DECL : - case UNION_DECL : - case STRUCT_DECL : - case ENUM_DECL : - case FUNC_HEDR : - case DERIVED_CLASS_DECL: return(0); - default : return(1); - } -} - -int cdrtext(bfptr,tab,curh,maxh) -PTR_BFND bfptr; -int tab,curh,maxh; -{ - int lev; - register PTR_BLOB b; - /* register PTR_BLOB p; */ - int left_param ; - int token = 0; - - left_param = 0; - lev = maxh-curh; - - global_tab = tab ; - cunp_bfnd(tab, bfptr); - global_tab = tab ; -/* - if ((current_proc == global_bfnd) && (bfptr->control_parent == global_bfnd)) - return(token); -*/ - - if ((basket_needed(bfptr,1) > 1)&&(not_class(bfptr))) - { put_tabs(tab); - addstr("{ \n"); - } - - for (b = bfptr->entry.Template.bl_ptr1; b; b = b->next) - { -/* PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; - if (cmnt) - while (cmnt != NULL && cmnt->type == FULL) { - addstr(cmnt->string ); - addstr( "\n" ); - cmnt = cmnt->next; - } -*/ - switch(bfptr->variant){ - case CLASS_DECL : - case COLLECTION_DECL: - case UNION_DECL : - case ENUM_DECL: - case STRUCT_DECL : - case DERIVED_CLASS_DECL : break ; - case FUNC_HEDR : - if (left_param==0) - { - if (!is_param_decl(b->ref,bfptr->entry.Template.symbol)) - { put_tabs(tab); addstr("{ \n"); - left_param= 1 ; - } - - } - token = cdrtext(b->ref,tab+1,curh+1,maxh); - break ; - default : - token = cdrtext(b->ref,tab+1,curh+1,maxh); - } -/* if (cmnt && cmnt->type != FULL) - { addstr( cmnt->string ); - addstr( "\n" ); - } -*/ - } - if (bfptr->variant == FUNC_HEDR) - { - if (left_param == 0) { - put_tabs(tab); addstr("{ \n"); - } - put_tabs(tab); addstr("} \n"); - } - - if ((basket_needed(bfptr, 1) > 1)&&(not_class(bfptr))) - { put_tabs(tab); addstr("} \n"); - } - - if (basket_needed(bfptr,2) > 0) - { put_tabs(tab); addstr("else \n"); - } - if (basket_needed(bfptr,2) > 1) - { put_tabs(tab); addstr("{ \n"); - } - - - for (b = bfptr->entry.Template.bl_ptr2; b; b = b->next) - { - /* PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr;*/ - token = cdrtext(b->ref,tab+1,curh+1,maxh); - - } - - if (basket_needed(bfptr,2) > 1) - { put_tabs(tab); addstr("} \n"); - } -/* if (cmnt && cmnt->type != FULL) - while (cmnt && cmnt->type != FULL) - { tm_put_string(Wid,cmnt->string,token); - cmnt =cmnt->next ; - } - addstr( "\n" ); -*/ - return (token); - - - } - - - - - - -static int -basket_needed(bf, index) - PTR_BFND bf ; - int index ; -{ - PTR_BLOB blob1 ,blob ; - - switch (index) { - case 1 : - if (bf->variant == FUNC_HEDR || bf->variant == BASIC_BLOCK) - return(2); - blob = bf->entry.Template.bl_ptr1 ; - if (blob == NULL) return(0) ; - if (((blob1= blob->next) == NULL) || - (blob1->ref->variant == CONTROL_END)) return(1); - break; - case 2 : - blob = bf->entry.Template.bl_ptr2 ; - if (!blob) return(0) ; - if (((blob1= blob->next) == NULL) || - (blob1->ref->variant == CONTROL_END)) return(1); - break; - } - return(2) ; -} - - -static void -cunp_blck(bfptr, tab) - PTR_BFND bfptr; - int tab; -{ - PTR_BLOB b; - int left_param ; - - left_param = 0; - cunp_bfnd(tab, bfptr); - - if ((basket_needed(bfptr,1) > 1)&&(not_class(bfptr))) { - put_tabs(tab); - addstr("{\n"); - } - - for (b = bfptr->entry.Template.bl_ptr1; b; b = b->next) { - switch(bfptr->variant) { - case CLASS_DECL : - case UNION_DECL : - case ENUM_DECL: - case STRUCT_DECL : - case DERIVED_CLASS_DECL : - break ; - case FUNC_HEDR : - if (left_param==0) - if (!is_param_decl(b->ref,bfptr->entry.Template.symbol)) { - put_tabs(tab); - addstr("{\n"); - left_param= 1 ; - } - cunp_blck(b->ref, tab+1); - break ; - case CONTROL_END: - break; - default : - cunp_blck(b->ref, tab+1); - break; - } - } - if (bfptr->variant == FUNC_HEDR) { - if (left_param == 0) { - put_tabs(tab); - addstr("{\n"); - } - put_tabs(tab); - addstr("}\n"); - } - - if ((basket_needed(bfptr, 1) > 1)&&(not_class(bfptr))) { - put_tabs(tab); - addstr("}\n"); - } - - if (basket_needed(bfptr,2) > 0) { - put_tabs(tab); - addstr("else\n"); - } - if (basket_needed(bfptr,2) > 1) { - put_tabs(tab); - addstr("{\n"); - } - - for (b = bfptr->entry.Template.bl_ptr2; b; b = b->next) - cunp_blck(b->ref, tab+1); - - if (basket_needed(bfptr,2) > 1) { - put_tabs(tab); - addstr("}\n"); - } -} - - -/* find_declarator : - * <1> Given a ll_node to follow ll_ptr1 to find declarator - * <2> return the symb pointer - */ -static PTR_SYMB -find_declarator(expr_list) - PTR_LLND expr_list ; -{ - PTR_SYMB symb; - PTR_LLND p ; - - if (! expr_list) - return(SMNULL); - symb = SMNULL ; - for ( p = expr_list->entry.Template.ll_ptr1 ; p ; ) { - switch (p->variant) { - case BIT_NUMBER: - case ASSGN_OP : - case ARRAY_OP: - case FUNCTION_OP : - case CLASSINIT_OP: - case ADDRESS_OP: - case DEREF_OP : p = p->entry.Template.ll_ptr1 ; - break ; - case FUNCTION_REF: - case ARRAY_REF: - case VAR_REF: - symb = p->entry.Template.symbol ; - p = LLNULL ; - break ; - } - } - return(symb); -} - - -static void -gen_func_hedr(functor, pbf, tabs) - PTR_SYMB functor ; - PTR_BFND pbf ; - int tabs ; -{ - PTR_SYMB s ; - PTR_TYPE q ; - PTR_LLND pllnd; - int i; - - for (q = functor->type; q ; ) { - switch ( q->variant) { - case T_POINTER : - *bp++ = '*'; - q = q->entry.Template.base_type ; - break; - case T_REFERENCE: - *bp++ = '&'; - q = q->entry.Template.base_type ; - break; - default: /* It might need more for complicated case */ - q = (PTR_TYPE) NULL ; - } - } - if (is_scope_op_needed(pbf,functor)) { - addstr(functor->entry.member_func.base_name->ident); - addstr("::"); - } - addstr(functor->ident); - *bp++ = '('; - for ( i=0, s = functor->entry.member_func.in_list ; s ; i++ ) { - if (i) *bp++ = ','; - if (not_explicit(s, pbf)) { - gen_simple_type(s->type, BFNULL, tabs); - for (q = s->type; q ; ) { - switch ( q->variant) { - case T_POINTER : - *bp++ = '*'; - q = q->entry.Template.base_type; - break; - case T_REFERENCE: - *bp++ ='&'; - q = q->entry.Template.base_type ; - break; - default: /* It might need more for complicated case */ - q = (PTR_TYPE) NULL; - } - } - - } - addstr(s->ident); - s = s->entry.var_decl.next_in; - } - *bp++ = ')'; - pllnd = pbf->entry.Template.ll_ptr1; - pllnd = pllnd->entry.Template.ll_ptr1; - if (pllnd &&(pllnd->variant == BIT_NUMBER)){ - addstr(" : "); - cunp_llnd(pllnd->entry.Template.ll_ptr2); - } -} - -int -is_scope_op_needed(pbf,functor) -PTR_BFND pbf; -PTR_SYMB functor; -{ - PTR_BFND parent; - - if (functor->variant!=MEMBER_FUNC) return(0); - parent = pbf->control_parent; - if (parent->variant==GLOBAL) return(1); - else return(0); - -} - -char * -cunparse_llnd(llnd) - PTR_LLND llnd; -{ - int len; - char *p; - - bp = buffer; /* reset the buffer pointer */ - cunp_llnd(llnd); - *bp++ = '\n'; - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return p; -} - - -char * -cunparse_bfnd(bif) - PTR_BFND bif; -{ - char *p; - int len; - - first = 1; /* Mark this is the first bif node */ - bp = buffer; /* reset the buffer pointer */ - cunp_bfnd(0, bif) ; - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return p; - -} - - -static void -gen_declarator(s) - PTR_SYMB s ; -{ - PTR_TYPE q ; - char * old_bp ; - - clean(temp_buf); - put_right(s->ident,temp_buf); - for (q = s->type; q ; ) { - switch ( q->variant) { - case T_POINTER : - put_left("*",temp_buf); - q = q->entry.Template.base_type ; - break; - case T_ARRAY : - clean(temp2_buf); - put_right(buffer,temp2_buf); - clean(buffer); - old_bp = bp ; - bp = buffer ; - cunp_llnd(q->entry.ar_decl.ranges); - bp = old_bp; - put_right(buffer,temp_buf); - clean(buffer); - put_right(temp2_buf,buffer); - q = q->entry.Template.base_type ; - break; - case T_FUNCTION: - put_left("(",temp_buf); - put_right(")",temp_buf); - put_right("()",temp_buf); - q = q->entry.Template.base_type ; - break; - - default: /* It might need more for complicated case */ - q = (PTR_TYPE) NULL ; - } - } - addstr(temp_buf); -} - - -char * -cunparse_symb(symb) - PTR_SYMB symb; -{ - int len; - char *p; - - first = 1; /* Mark this is the first bif node */ - bp = buffer; /* reset the buffer pointer */ - gen_simple_type(symb->type,BFNULL,0); - gen_declarator(symb); - *bp++ = '\n'; - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return p; -} - - -/**************************************************************** - * * - * for cunparse_type * - * * - ****************************************************************/ - -char * -cunparse_type(q_type) -PTR_TYPE q_type; -{ - int len; - char *p; - - first = 1; /* Mark this is the first bif node */ - bp = buffer; /* reset the buffer pointer */ - gen_simple_type_2(q_type,BFNULL,0); - *bp++ = '\n'; - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return p; -} - - -char * -cunparse_blck(bif) - PTR_BFND bif; -{ - int len; - char *p; - - first = 1; /* Mark this is the first bif node */ - bp = buffer; /* reset the buffer pointer */ - - cunp_blck(bif, 0); - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = malloc(len); /* allocate space for returned value */ -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return (p); -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/dbutils.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/dbutils.c deleted file mode 100644 index 3881e23..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/dbutils.c +++ /dev/null @@ -1,961 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/**************************************************************** - * * - * dbutils -- contains those utilities that will be used by * - * the data base management routines * - * * - ****************************************************************/ - -#include -#include - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -# include "db.h" - -/* - * global references - */ -extern int language; -extern PTR_FILE cur_file; - -int read_nodes(); - -/* - * Local variables - */ -static PTR_SYMB head_symb; -static char *proj_filename; -static int temp[200]; -static int *pt; - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -extern void removeFromCollection(void *pointer); -#endif - -/**************************************************************** - * * - * alloc_blob -- allocate new space for structure blob * - * * - * output: * - * Non-NULL - pointer to the newly allocated structure * - * NULL - something was wrong * - * * - ****************************************************************/ -PTR_BLOB -alloc_blob() -{ - void *p = calloc(1, sizeof(struct blob)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - return ((PTR_BLOB)p); -} - - -/**************************************************************** - * * - * alloc_blob1 -- allocate new space for structure blob1 * - * * - * output: * - * Non-NULL - pointer to the newly allocated structure * - * NULL - something was wrong * - * * - ****************************************************************/ -static PTR_BLOB1 -alloc_blob1() -{ - void *p = calloc(1, sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - return ((PTR_BLOB1) p); -} - - -/**************************************************************** - * * - * alloc_info -- allocate new space for structure obj_info * - * * - * output: * - * Non-NULL - pointer to the newly allocated structure * - * NULL - something was wrong * - * * - ****************************************************************/ -static PTR_INFO -alloc_info() -{ - void *p = calloc(1, sizeof(struct obj_info)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - return ((PTR_INFO) p); -} - - -/**************************************************************** - * * - * check_ref -- check if the variable whose id is "id" has * - * referenced in this statement or not * - * input: * - * id -- the id of the variable to be checked * - * * - * output: * - * 1, if it's been refereneced * - * 0, if not and add it to the table * - * * - ****************************************************************/ -int -check_ref(id) - int id; -{ - int *p; - - for(p = temp; p < pt;) - if(*p++ == id) - return(1); - *pt++ = id; - return(0); -} - - -/**************************************************************** - * * - * build_ref -- add "bif" to the reference chain of "symb" * - * * - * input: * - * symb - the symb where the reference to be added * - * bif - the statement that references symb * - * * - ****************************************************************/ -void -build_ref(symb, bif) - PTR_SYMB symb; - PTR_BFND bif; -{ - register PTR_BLOB b, b1, b2; - - b = alloc_blob(); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,b, 0); -#endif - b->ref = bif; - if (symb->ud_chain == NULL) - symb->ud_chain = b; - else { - for (b1 = b2 = symb->ud_chain; b1; b1 = b1->next) - b2 = b1; - b2->next = b; - } - b->next = NULL; -} - - -/**************************************************************** - * * - * make_blob1 -- make a new blob1 node * - * * - * input: * - * tag - type of this blob1 node * - * ref - pointer to the object it references * - * next - link to the next blob1 node * - * * - ****************************************************************/ -PTR_BLOB1 -make_blob1(tag, ref, next) - int tag; - PTR_BFND ref; - PTR_BLOB1 next; -{ - PTR_BLOB1 new; - - new = alloc_blob1(); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,new, 0); -#endif - new->tag = tag; - new->ref = (char *) ref; - new->next = next; - return (new); -} - - -/**************************************************************** - * * - * make_obj_info -- make a new obj_info node * - * * - * input: * - * filename - name of the file where this obj_info * - * resides * - * g_line - ablosute line no. of the obj in the file * - * l_line - line no. of the object relative to its * - * parent objec * - * source - the objec in the source form * - * * - ****************************************************************/ -PTR_INFO -make_obj_info(filename, g_line, l_line, source) - char *filename; - int g_line; - int l_line; - char *source; -{ - register PTR_INFO new; - - new = alloc_info(); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,new, 0); -#endif - new->filename = filename; - new->g_line = g_line; - new->l_line = l_line; - new->source = source; - return (new); -} - -/**************************************************************** - * * - * visit_llnd -- recursively visit the low level nodes and * - * find those use and def info it references * - * * - * input: * - * bif - the bif node to which the llnd belongs * - * llnd - the low level node to be visit * - * * - ****************************************************************/ -void -visit_llnd(bif, llnd) - PTR_BFND bif; - PTR_LLND llnd; -{ - if (llnd == NULL) return; - - switch (llnd->variant) { - case LABEL_REF: - { - } - break; - case CONST_REF : - case VAR_REF : - case ARRAY_REF : - if(check_ref(llnd->entry.Template.symbol->id) == 0) - build_ref(llnd->entry.Template.symbol, bif); - break; - case CONSTRUCTOR_REF : - break; - case ACCESS_REF : - break; - case CONS : - break; - case ACCESS : - break; - case IOACCESS : - break; - case PROC_CALL : - case FUNC_CALL : - visit_llnd(bif, llnd->entry.proc.param_list); - break; - case EXPR_LIST : - visit_llnd(bif, llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bif, llnd->entry.list.next); - break; - case EQUI_LIST : - visit_llnd(bif, llnd->entry.list.item); - if (llnd->entry.list.next) { - visit_llnd(bif, llnd->entry.list.next); - } - break; - case COMM_LIST : - if (llnd->entry.Template.symbol) { -/* addstr(llnd->entry.Template.symbol->ident); - */ } - visit_llnd(bif, llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bif, llnd->entry.list.next); - break; - case VAR_LIST : - case RANGE_LIST : - case CONTROL_LIST : - visit_llnd(bif, llnd->entry.list.item); - if (llnd->entry.list.next) - visit_llnd(bif, llnd->entry.list.next); - break; - case DDOT : - visit_llnd(bif, llnd->entry.binary_op.l_operand); - if (llnd->entry.binary_op.r_operand) - visit_llnd(bif, llnd->entry.binary_op.r_operand); - break; - case DEF_CHOICE : - case SEQ : - visit_llnd(bif, llnd->entry.seq.ddot); - if (llnd->entry.seq.stride) - visit_llnd(bif, llnd->entry.seq.stride); - break; - case SPEC_PAIR : - visit_llnd(bif, llnd->entry.spec_pair.sp_label); - visit_llnd(bif, llnd->entry.spec_pair.sp_value); - break; - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP : - case LTEQL_OP : - case GTEQL_OP : - case ADD_OP : - case SUBT_OP : - case OR_OP : - case MULT_OP : - case DIV_OP : - case MOD_OP : - case AND_OP : - case EXP_OP : - case CONCAT_OP : - visit_llnd(bif, llnd->entry.binary_op.l_operand); - visit_llnd(bif, llnd->entry.binary_op.r_operand); - break; - case MINUS_OP : - case NOT_OP : - visit_llnd(bif, llnd->entry.unary_op.operand); - break; - case STAR_RANGE : - break; - default : - break; - } -} - - -/**************************************************************** - * * - * visit_bfnd -- visits the subtree "bif" and generates the * - * use-definition info of the variables it * - * references * - * input: * - * bif - the root of the tree to be visitd * - * * - * side effect: * - * build the ud_chain at where the static variable * - * "head_symb" points to * - * * - ****************************************************************/ -void -visit_bfnd(bif) - PTR_BFND bif; -{ - register PTR_BLOB b; - - if(bif == NULL) - return; - pt = temp; /* reset the pointer */ - - switch(bif->variant) { - case GLOBAL: - case PROG_HEDR: - case PROC_HEDR: - case FUNC_HEDR: - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - visit_bfnd(b->ref); - break; - case FOR_NODE: - build_ref(bif->entry.Template.symbol, bif); /* control var */ - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check range */ - visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check incr */ - visit_llnd(bif, bif->entry.Template.ll_ptr3); /* where cond */ - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - visit_bfnd(b->ref); - break; - case CDOALL_NODE: - build_ref(bif->entry.Template.symbol, bif); /* control var */ - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check range */ - visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check incr */ - visit_llnd(bif, bif->entry.Template.ll_ptr3); /* where cond */ - for (b = bif->entry.Template.bl_ptr2; b; b = b->next) - visit_bfnd(b->ref); - break; - case WHILE_NODE: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - visit_bfnd(b->ref); - break; - case WHERE_NODE: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - visit_bfnd(b->ref); - for (b = bif->entry.Template.bl_ptr2; b; b = b->next) - visit_bfnd(b->ref); - break; - case IF_NODE: - case ELSEIF_NODE: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - visit_bfnd(b->ref); - for (b = bif->entry.Template.bl_ptr2; b; b = b->next) - visit_bfnd(b->ref); - break; - case LOGIF_NODE: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ - visit_bfnd(bif->entry.Template.bl_ptr1->ref); - break; - case ARITHIF_NODE: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ - break; - case ASSIGN_STAT: - case IDENTIFY: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check l_val */ - visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check r_val */ - break; - case PROC_STAT: - visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check l_val */ - break; - case CONT_STAT: - case FORMAT_STAT: - case GOTO_NODE: - case ASSGOTO_NODE: - case COMGOTO_NODE: - case STOP_STAT: - case VAR_DECL: - case PARAM_DECL: - case DIM_STAT: - case EQUI_STAT: - case DATA_DECL: - case IMPL_DECL: - case READ_STAT: - case WRITE_STAT: - case OTHERIO_STAT: - case COMM_STAT: - case CONTROL_END: - break; - default: - break; - } -} - - -/**************************************************************** - * * - * cvisit_llnd -- recursively visit the low level nodes and * - * find those use and def info it references * - * for VPC++ * - * * - * input: * - * bif - the bif node to which the llnd belongs * - * llnd - the low level node to be visit * - * * - ****************************************************************/ -void -cvisit_llnd(bif,llnd) -PTR_BFND bif; -PTR_LLND llnd; - -{ - if (!llnd) return; - - switch (llnd->variant) { - case INT_VAL : - case STMT_STR : - case FLOAT_VAL : - case DOUBLE_VAL : - case STRING_VAL : - case BOOL_VAL : - case CHAR_VAL : - break; - case CONST_REF : - case ENUM_REF : - break; - case VAR_REF : - if(check_ref(llnd->entry.Template.symbol->id) == 0) - build_ref(llnd->entry.Template.symbol, bif); - break; - case POINTST_OP : /* New added for VPC */ - case RECORD_REF: /* Need More */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - /* Need More work for pointer combined with structure */ - break ; - case ARRAY_OP : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case ARRAY_REF : - if(check_ref(llnd->entry.Template.symbol->id) == 0) - build_ref(llnd->entry.Template.symbol, bif); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - break; - case CONSTRUCTOR_REF : - break; - case ACCESS_REF : - break; - case CONS : - break; - case ACCESS : - break; - case IOACCESS : - break; - case PROC_CALL : - case FUNC_CALL : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - break; - case EXPR_LIST : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case EQUI_LIST : - break; - case COMM_LIST : - break; - case VAR_LIST : - case CONTROL_LIST : - break; - case RANGE_LIST : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case DDOT : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case COPY_NODE : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case VECTOR_CONST : /* NEW ADDED FOR VPC++ */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - break; - case INIT_LIST: - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - break ; - case BIT_NUMBER: - break ; - case DEF_CHOICE : - case SEQ : - break; - case SPEC_PAIR : - break; - case MOD_OP : - break; - case ASSGN_OP : /* New added for VPC */ - case ARITH_ASSGN_OP: /* New added for VPC */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP : - case LTEQL_OP : - case GTEQL_OP : - case ADD_OP : - case SUBT_OP : - case OR_OP : - case MULT_OP : - case DIV_OP : - case AND_OP : - case EXP_OP : - case LE_OP : /* New added for VPC *//*Duplicated*/ - case GE_OP : /* New added for VPC *//*Duplicated*/ - case NE_OP : /* New added for VPC *//*Duplicated*/ - case BITAND_OP : /* New added for VPC */ - case BITOR_OP : /* New added for VPC */ - case LSHIFT_OP : /* New added for VPC */ - case RSHIFT_OP : /* New added for VPC */ - case INTEGER_DIV_OP : /* New added for VPC */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case FUNCTION_OP: - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case ADDRESS_OP : /* New added for VPC */ - case SIZE_OP : /* New added for VPC */ - break; - case DEREF_OP : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - break; - case SUB_OP : /* duplicated unary minus */ - case MINUS_OP : /* unary operations */ - case UNARY_ADD_OP : /* New added for VPC */ - case BIT_COMPLEMENT_OP : /* New added for VPC */ - case NOT_OP : - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - break; - case MINUSMINUS_OP: /* New added for VPC */ - case PLUSPLUS_OP : /* New added for VPC */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case STAR_RANGE : - break; - case CLASSINIT_OP : /* New added for VPC */ - break ; - case CAST_OP : /* New added for VPC */ - break; - case EXPR_IF : /* New added for VPC */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case EXPR_IF_BODY : /* New added for VPC */ - cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); - cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); - break; - case FUNCTION_REF : /* New added for VPC */ - break ; - case LABEL_REF: /* Fortran Version, For VPC we need more */ - break; - - default : - break; - - } -} - - -/**************************************************************** - * * - * cvisit_bfnd -- visits the subtree "bif" and generates the * - * use-definition info of the variables it * - * references for VPC++ * - * input: * - * bif - the root of the tree to be visitd * - * * - * side effect: * - * build the ud_chain at where the static variable * - * "head_symb" points to * - * * - ****************************************************************/ -void -cvisit_bfnd(bif) -PTR_BFND bif; - -{ - register PTR_BLOB b; - void cvisit_llnd(); - - if (!bif) return; - pt = temp; /* reset the pointer */ - - switch (bif->variant) { - case GLOBAL : - case PROG_HEDR : - case PROC_HEDR : - case FUNC_HEDR : - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break; - case IF_NODE : - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - for (b = bif->entry.Template.bl_ptr2; b; b = b->next) - cvisit_bfnd(b->ref); - break; - case LOGIF_NODE : - case ARITHIF_NODE: - case WHERE_NODE : - break; - case FOR_NODE : - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - cvisit_llnd(bif, bif->entry.Template.ll_ptr2); - cvisit_llnd(bif, bif->entry.Template.ll_ptr3); - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break; - case FORALL_NODE : - case WHILE_NODE : - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break; - case ASSIGN_STAT: - case IDENTIFY: - case PROC_STAT : - case SAVE_DECL: - case CONT_STAT: - case FORMAT_STAT: - break; - case LABEL_STAT: - break; - case GOTO_NODE: - break; - case ASSGOTO_NODE: - case COMGOTO_NODE: - case STOP_STAT: - break; - case RETURN_STAT: - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - break; - case PARAM_DECL : - case DIM_STAT: - case EQUI_STAT: - case DATA_DECL: - case READ_STAT: - case WRITE_STAT: - case OTHERIO_STAT: - case COMM_STAT: - case CONTROL_END: - break; - case CLASS_DECL: /* New added for VPC */ - break; - case ENUM_DECL : /* New added for VPC */ - case UNION_DECL: /* New added for VPC */ - case STRUCT_DECL: /* New added for VPC */ - break; - case DERIVED_CLASS_DECL: /* Need More for VPC */ - case VAR_DECL: - break; - case EXPR_STMT_NODE: /* New added for VPC */ - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - break ; - case DO_WHILE_NODE: /* New added for VPC */ - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break; - case SWITCH_NODE : /* New added for VPC */ - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break ; - case CASE_NODE : /* New added for VPC */ - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - break ; - case DEFAULT_NODE: /* New added for VPC */ - break; - case BASIC_BLOCK : - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break ; - case BREAK_NODE : /* New added for VPC */ - break; - case CONTINUE_NODE: /* New added for VPC */ - break; - case RETURN_NODE : /* New added for VPC */ - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - break; - case ASM_NODE : /* New added for VPC */ - break; /* Need More */ - case SPAWN_NODE : /* New added for VPC */ - break; - case PARFOR_NODE : /* New added for VPC */ - cvisit_llnd(bif, bif->entry.Template.ll_ptr1); - cvisit_llnd(bif, bif->entry.Template.ll_ptr2); - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break; - case PAR_NODE : /* New added for VPC */ - for (b = bif->entry.Template.bl_ptr1; b; b = b->next) - cvisit_bfnd(b->ref); - break; - default: - break; - } - -} - - -/**************************************************************** - * * - * gen_udchain -- visits the bif tree of the given "proj" * - * and generates the use-definition info the * - * proj has referenced * - * * - * input: * - * proj -- the project to be visited * - * * - ****************************************************************/ -void -gen_udchain(proj) - PTR_FILE proj; -{ - if(proj->head_bfnd == NULL) - return; - - proj_filename = (char *) calloc(strlen(proj->filename), sizeof(char)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,proj_filename, 0); -#endif - head_symb = proj->head_symb; - switch (language) { - case ForSrc: - visit_bfnd(proj->global_bfnd); - break; - case CSrc: - cvisit_bfnd(proj->global_bfnd); - break; - default: - break; - } -} - - -void -dump_udchain(proj) - PTR_FILE proj; -{ - register PTR_SYMB s; - register PTR_BLOB b; - - if(proj->global_bfnd) - for (s = proj->head_symb; s; s = s->thread) { - if (s->ud_chain) { - fprintf(stderr, "Variable \"%s\" referenced at line(s) -- ", - s->ident); - for(b = s->ud_chain; b; b = b->next) - fprintf(stderr, "%d%s", b->ref->g_line, - (b->next? ", ": "\n")); - } - } -} - - -static void -clean_hash_tbl(fi) - PTR_FILE fi; -{ - register PTR_HASH h, h1, h2; - - for (h = *(fi->hash_tbl); h < *(fi->hash_tbl)+hashMax; h++) - if (h) { - for (h1 = h->next_entry; h1; h1 = h2) { - h2 = h1->next_entry; -#ifdef __SPF - removeFromCollection(h1); -#endif - free(h1); - } - h = NULL; - } -} - - -static void -free_dep(fi) - PTR_FILE fi; -{ - register PTR_BLOB bl1, bl2; - register PTR_BFND bf; - - clean_hash_tbl(fi); - for (bf = fi->global_bfnd; bf; bf = bf->thread) { - for (bl1 = bf->entry.Template.bl_ptr1; bl1; bl1 = bl2) { - bl2 = bl1->next; -#ifdef __SPF - removeFromCollection(bl1); -#endif - free(bl1); - } - for (bl1 = bf->entry.Template.bl_ptr2; bl1; bl1 = bl2) { - bl2 = bl1->next; -#ifdef __SPF - removeFromCollection(bl1); -#endif - free(bl1); - } - } - - if (fi->num_bfnds) - { -#ifdef __SPF - removeFromCollection(fi->head_bfnd); -#endif - free(fi->head_bfnd); - } - - if (fi->num_llnds) - { -#ifdef __SPF - removeFromCollection(fi->head_llnd); -#endif - free(fi->head_llnd); - } - - if (fi->num_symbs) { - register PTR_SYMB s; - - for (s = fi->head_symb; s; s = s) - { -#ifdef __SPF - removeFromCollection(s->ident); -#endif - free(s->ident); - } -#ifdef __SPF - removeFromCollection(fi->head_symb); -#endif - free(fi->head_symb); - } - - if (fi->num_label) - { -#ifdef __SPF - removeFromCollection(fi->head_lab); -#endif - free(fi->head_lab); - } - - if (fi->num_types) - { -#ifdef __SPF - removeFromCollection(fi->head_type); -#endif - free(fi->head_type); - } - - if (fi->num_dep) - { -#ifdef __SPF - removeFromCollection(fi->head_dep); -#endif - free(fi->head_dep); - } - - if (fi->num_cmnt) { - register PTR_CMNT c; - - for (c = fi->head_cmnt; c; c = c->next) - { -#ifdef __SPF - removeFromCollection(c->string); -#endif - free(c->string); - } -#ifdef __SPF - removeFromCollection(fi->head_cmnt); -#endif - free(fi->head_cmnt); - } -} - - -int -replace_dep(filename) - char *filename; -{ - PTR_FILE fi; - PTR_BLOB bl; - extern PTR_PROJ cur_proj; - - for (bl = cur_proj->file_chain; bl; bl = bl->next) { - fi = (PTR_FILE) bl->ref; - if (!strcmp(fi->filename, filename)) { -#ifdef __SPF - removeFromCollection(fi); -#endif - free_dep(fi); - read_nodes(fi); - return (1); - } - } - return (0); -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c deleted file mode 100644 index fd7474e..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c +++ /dev/null @@ -1,229 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -#include -#include -#include "db.h" - - - -PTR_LLND free_ll_list = NULL; -static int num_marked; -int num_ll_allocated = 0; - - -static void -mark_llnd(p) -PTR_LLND p; -{ - if(p == NULL || p->id == -1) - return; - p->id = -1; num_marked++; - mark_llnd(p->entry.Template.ll_ptr1); - mark_llnd(p->entry.Template.ll_ptr2); -} - - -static void -mark_refl(p) - PTR_REFL p; -{ - for (; p; p = p->next) - if(p->node != NULL) - mark_llnd(p->node->refer); -} - - -static void -mark_arefl(p) - PTR_AREF p; -{ - for (; p; p = p->next){ - mark_llnd(p->decl_ranges); - mark_llnd(p->use_bnd0); - mark_llnd(p->mod_bnd0); - mark_llnd(p->use_bnd1); - mark_llnd(p->mod_bnd1); - mark_llnd(p->use_bnd2); - mark_llnd(p->mod_bnd2); - } -} - - -static void -mark_sets(s) - struct sets *s; -{ - if(s == NULL) return; - - mark_refl(s->gen); - mark_refl(s->in_def); - mark_refl(s->use); - mark_refl(s->in_use); - mark_refl(s->out_def); - mark_refl(s->out_use); - mark_arefl(s->arefl); -} - - -static void -mark_depnds(p) - PTR_DEP p; -{ - int depcnt; - depcnt = 0; - - for (; p != NULL; p = p->thread){ - mark_llnd(p->to.refer); - mark_llnd(p->from.refer); - depcnt++; - } -} - - -static void -mark_symb(fi) - PTR_FILE fi; -{ - PTR_SYMB s; - - for (s = fi->head_symb; s; s = s->thread) { - if (s->variant == CONST_NAME) - mark_llnd(s->entry.const_value); - else if(s->variant == FIELD_NAME) - mark_llnd(s->entry.field.restricted_bit); - else if(s->variant == VAR_FIELD) - mark_llnd(s->entry.variant_field.variant_list); - else if (s->variant == PROCEDURE_NAME || - s->variant == FUNCTION_NAME) - mark_llnd(s->entry.proc_decl.call_list); - else if(s->variant == MEMBER_FUNC) - mark_llnd(s->entry.member_func.call_list); - - } -} - - -static void -mark_type(fi) - PTR_FILE fi; -{ - PTR_TYPE s; - for (s = fi->head_type; s; s = s->thread) { - if(s->variant == T_ARRAY) - mark_llnd(s->entry.ar_decl.ranges); - else if(s->variant == T_DESCRIPT || - s->variant == T_POINTER || - s->variant == T_LIST || - s->variant == T_FUNCTION) - mark_llnd(s->entry.Template.ranges); - else if(s->variant == T_SUBRANGE){ - mark_llnd(s->entry.subrange.lower); - mark_llnd(s->entry.subrange.upper); - } - else{ - mark_llnd(s->entry.Template.ranges); - } - } -} - - - -static void -mark_bfnd(b) - PTR_BFND b; -{ - PTR_BLOB bl; - - if(b == NULL) return; - - mark_llnd(b->entry.Template.ll_ptr1); - mark_llnd(b->entry.Template.ll_ptr2); - mark_llnd(b->entry.Template.ll_ptr3); - mark_sets(b->entry.Template.sets); - - for (bl = b->entry.Template.bl_ptr1; bl; bl = bl->next) - mark_bfnd(bl->ref); - - for (bl = b->entry.Template.bl_ptr2; bl; bl = bl->next) - mark_bfnd(bl->ref); -} - - -void -collect_garbage(fi) - PTR_FILE fi; -{ - PTR_LLND p, t; - int count; - - p = free_ll_list; - count = 0; - while(p != NULL){ - count++; - p = p->thread; - } - - count = 0; - for (p = fi->head_llnd; p && p != fi->cur_llnd; p = p->thread){ - p->id = 0; - count++; - } - - fi->cur_llnd->id = 0; count++; - - num_marked = 0; - mark_bfnd(fi->head_bfnd); - /* printf("num marked from bfnd = %d\n", num_marked); */ - - num_marked = 0; - mark_depnds(fi->head_dep); - /* printf("num marked from deps= %d\n", num_marked); */ - - num_marked = 0; - mark_symb(fi); - /* printf("num marked from symb= %d\n", num_marked); */ - - num_marked = 0; - mark_type(fi); - /* printf("num marked from type= %d\n", num_marked); */ - - num_marked = 0; - p = fi->head_llnd; - fi->cur_llnd = fi->head_llnd; - count = 1; - p->id = count++; p = p->thread; - fi->cur_llnd->thread = NULL; - - while(p != NULL){ - if(p->id == -1){ /*touched */ - fi->cur_llnd->thread = p; - fi->cur_llnd = p; - p = p->thread; - fi->cur_llnd->id = count++; - fi->cur_llnd->thread = NULL; - } else if(p->id == 0) { - t = p; p = p->thread; - t->id = -2; num_marked++; - t->thread= free_ll_list; - t->entry.Template.ll_ptr1 = NULL; - t->entry.Template.ll_ptr2 = NULL; - t->entry.Template.symbol = NULL; - t->variant = 800; - free_ll_list = t; - } - else { printf("error in garbage collection\n"); - exit(0); - } - } - fi->num_llnds = count -1 ; - num_ll_allocated = 0; - printf(" total llnodes = %d garbage collected = %d\n",count, num_marked); -} - -int num_of_llnds(fi) -PTR_FILE fi; -{ return fi->num_llnds; } diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c deleted file mode 100644 index 94e4ab7..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c +++ /dev/null @@ -1,494 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* file: glob_anal.c */ - -#include -#include "db.h" -#ifdef SYS5 -#include -#else -#include -#endif -#define MAX_FUNS 500 - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -void *malloc(); -void bind_call_site_info(); - -static PTR_FILE current_file; - -extern PTR_FILE cur_file; -extern int debug; - -typedef struct call_list *PTR_CALLS; -typedef struct function_decl *PTR_FUNCS; - -struct call_list { - char *name; - int funs_number; /* set to the index in the funs table */ - /* -1 if the function is unknown */ - PTR_LLND used, modified; - PTR_BFND call_site; /* statement which holds call to this fun */ - PTR_CALLS next; -}; - - -struct function_decl { - PTR_FILE file; /* file object where this function was - * defined */ - PTR_SYMB name; /* point to the symbol table of this functin */ - PTR_BFND fun; /* point to the BIF node of this functio */ - int is_done; - PTR_LLND used, modified; - PTR_CALLS calls; -} funs[MAX_FUNS]; - -int num_of_funs = 0; - -static int now; -static int val[MAX_FUNS], /* keep the depth-first numbering */ - ival[MAX_FUNS]; /* keep the inverse calling numbering */ - - -/* - * visit does the depth-first numbering for nodes - * for the call graph - * - * the array "val" keep the depth-first visiting numbering - * while the array "ival" is the inverse of "val", i.e. is - * the reverse calling sequence - */ -static void visit(k) -int k; -{ - PTR_CALLS p; - - ival[now] = k; - val[k] = now++; - for (p = funs[k].calls; p; p = p->next) /* for each adjacent node */ - if (val[p->funs_number] < 0)/* haven't visited yet */ - visit(p->funs_number); -} - - -/* - * dfs does the depth-first search of the call graph - */ -static void dfs() -{ - int k; - - now = 0; /* keep track of the numbering */ - for (k = 0; k < num_of_funs; k++) /* initialize to be un-read */ - val[k] = -1; - for (k = 0; k < num_of_funs; k++) /* now do the depth-first search */ - if (val[k] < 0) - visit(k); -} - - -void reset_llnd(p) -PTR_LLND p; -{ - if (p == NULL) - return; - if (p->variant == VAR_REF) { - p->entry.Template.ll_ptr1 = NULL; - } - reset_llnd(p->entry.Template.ll_ptr1); - reset_llnd(p->entry.Template.ll_ptr2); -} - - -void reset_scalar_propogation(b) -PTR_BFND b; -{ - PTR_BLOB bl; - - if (b == NULL) - return; - if ((b->variant != FUNC_HEDR) && (b->variant != PROC_HEDR)) { - reset_llnd(b->entry.Template.ll_ptr1); - reset_llnd(b->entry.Template.ll_ptr2); - reset_llnd(b->entry.Template.ll_ptr3); - } - for (bl = b->entry.Template.bl_ptr1; bl; bl = bl->next) - reset_scalar_propogation(bl->ref); - - for (bl = b->entry.Template.bl_ptr2; bl; bl = bl->next) - reset_scalar_propogation(bl->ref); -} - - -/* make_fun_decl initialized an entry in the funs table for a function at */ -/* statement b */ -static void make_fun_decl(f, b) -PTR_FILE f; -PTR_BFND b; -{ - PTR_FUNCS i; - PTR_LLND make_llnd(); - - i = funs + num_of_funs++; - if (num_of_funs > MAX_FUNS) { - fprintf(stderr, "Too many functions!\n"); - return; - } - - /* b's ll_ptr3 points to an expr list whose ll_ptr1 is the pre global */ - /* analysis use set and whose ll_ptr2 will be the post analysis use set */ - if (b->entry.Template.ll_ptr3 == NULL) { /* summary of use info */ - fprintf(stderr, "bad initial analysis. run vcc or cfp again\n"); - b->entry.Template.ll_ptr3 = make_llnd(cur_file,EXPR_LIST,NULL, NULL, NULL); - } - if (b->entry.Template.ll_ptr2 == NULL) { /* summary of mod info */ - fprintf(stderr, "bad initial analysis. run vcc or cfp again\n"); - b->entry.Template.ll_ptr2 = make_llnd(cur_file,EXPR_LIST, NULL, NULL, NULL); - } - - i->file = f; - i->name = b->entry.Template.symbol; - i->fun = b; - i->is_done = 0; - i->used = b->entry.Template.ll_ptr3->entry.Template.ll_ptr1; - i->modified = b->entry.Template.ll_ptr2->entry.Template.ll_ptr1; - i->calls = NULL; -} - - -/* call this function with the project_object */ -/* to build the list of functions. */ -static void make_fun_list(proj) -PTR_PROJ proj; -{ - PTR_FILE f; - PTR_BLOB b1, b; - PTR_BFND p; - PTR_REFL make_name_list(); - PTR_SETS alloc_sets(); - /* Scan through all files in the project */ - for (b1 = proj->file_chain; b1; b1 = b1->next) { - f = (PTR_FILE) b1->ref; - for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) - if (b->ref->variant == FUNC_HEDR || - b->ref->variant == PROC_HEDR || - b->ref->variant == PROG_HEDR) { - make_fun_decl(f, b->ref); - p = b->ref; - if (p->entry.Template.sets == NULL) - p->entry.Template.sets = alloc_sets(); - p->entry.Template.sets->out_use = NULL; - p->entry.Template.sets->in_use = NULL; - p->entry.Template.sets->out_def = NULL; - p->entry.Template.sets->in_def = NULL; - p->entry.Template.sets->gen = NULL; - p->entry.Template.sets->use = NULL; - /* set in_def to be a ref list of all */ - /* parameters to this proc. this is */ - /* used in the global analysis phase */ - p->entry.Template.sets->in_def = - make_name_list( - p->entry.Template.symbol->entry.proc_decl.in_list - ); - } - } -} - - -/* find_by_name searches the funs list for the function whose name is */ -/* given by the char string s */ -static int find_by_name(PTR_FILE f, char *s) -/*PTR_FILE f;*/ -/*char *s;*/ -{ - int i; - - f = f; /* make lint happy, f unused */ - for (i = 0; i < num_of_funs; i++) - if ( /* funs[i].file == f && */ (!strcmp(s, funs[i].name->ident))) - return i; - for (i = 0; i < num_of_funs; i++) - if (!strcmp(s, funs[i].name->ident)) - return i; - return (-1); -} - -PTR_BFND find_fun_by_name(s) -char *s; -{ - int i; - i = find_by_name(NULL, s); - if (i < 0) - return NULL; - return funs[i].fun; -} - - -/* get_fun_number takes a pointer to a symbol table entry and looks */ -/* it up in the funs table and returns the index. like the others */ -/* it returns -1 if nothing is found that matches s. */ -/*static int get_fun_number(f, s) -PTR_FILE f; -PTR_SYMB s; -{ - int i; - for (i = 0; i < num_of_funs; i++) - if (funs[i].file == f && funs[i].name == s) - return i; - return (-1); -}*/ - - -/* append_to_call_list takes the symbol table pointer of a function */ -/* that calls another function whose name is given by a char string */ -/* and appends the name of the called function to the calls list of */ -/* the funs entry for the calling function. */ -static void append_to_call_list(calling_fun, called_fun_ident, bf) -int calling_fun; -char *called_fun_ident; -PTR_BFND bf; -{ - int called_fun; - PTR_CALLS p; - PTR_BFND b; - - called_fun = find_by_name(funs[calling_fun].file, called_fun_ident); - if (called_fun == -1) { - fprintf(stderr, "Called \"%s\" function not in the project\n", - called_fun_ident); - return; - } - - b = funs[calling_fun].fun; - p = (PTR_CALLS) malloc(sizeof(struct call_list)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - p->name = b->entry.Template.symbol->ident; - p->funs_number = called_fun; - p->call_site = bf; - p->used = NULL; - p->modified = NULL; - p->next = funs[calling_fun].calls; - funs[calling_fun].calls = p; -} - - -static void func_call_in_llnd(ll, i, bf) -PTR_LLND ll; -int i; -PTR_BFND bf; -{ - if (ll == NULL) - return; - if (ll->variant == FUNC_CALL || - ll->variant == PROC_CALL || - ll->variant == FUNCTION_REF) - append_to_call_list(i, ll->entry.Template.symbol->ident, bf); - - /* NOTE: the following code is "tag" dependent */ - if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) { - func_call_in_llnd(ll->entry.Template.ll_ptr1, i, bf); - func_call_in_llnd(ll->entry.Template.ll_ptr2, i, bf); - } -} - - -static void func_call_in_bfnd(bl, i) -PTR_BLOB bl; -int i; -{ - PTR_BFND bf; - PTR_BLOB bl1; - - for (bl1 = bl; bl1; bl1 = bl1->next) { - bf = bl1->ref; - if (bf->variant == PROC_CALL || - bf->variant == FUNC_CALL || - bf->variant == PROC_STAT) - append_to_call_list(i, bf->entry.Template.symbol->ident, bf); - func_call_in_llnd(bf->entry.Template.ll_ptr1, i, bf); - func_call_in_llnd(bf->entry.Template.ll_ptr2, i, bf); - func_call_in_llnd(bf->entry.Template.ll_ptr3, i, bf); - - func_call_in_bfnd(bf->entry.Template.bl_ptr1, i); - func_call_in_bfnd(bf->entry.Template.bl_ptr2, i); - } -} - -static void rec_list_cgraph(i) -int i; -{ - func_call_in_bfnd(funs[i].fun->entry.Template.bl_ptr1, i); -} - - -void BuildCallGraph() -{ - int i; - fprintf(stderr, "\n the call graph is:\n"); - for (i = 0; i < num_of_funs; i++) { - rec_list_cgraph(i); - } -} - - -/* - * ready_for_analysis returns - * - * 0 if not ready - * 1 if it is ready - * 2 if analysis is done. - */ -static int ready_for_analysis(i) -int i; -{ - PTR_CALLS calls; - - if (funs[i].is_done == 0) { - for (calls = funs[i].calls; calls; calls = calls->next) - if (calls->funs_number > -1 && - funs[calls->funs_number].is_done == 0) - return (0); - return (1); - } - return (2); -} - - -static PTR_LLND link_ll_chain(list, elist) -PTR_LLND list, elist; -{ - PTR_LLND p; - - p = list; - while (p != NULL && p->entry.Template.ll_ptr2 != NULL) - p = p->entry.Template.ll_ptr2; - if (p != NULL) - p->entry.Template.ll_ptr2 = elist; - else - list = elist; - return (list); -} - - -static PTR_LLND link_ll_set_list(b, s) -PTR_LLND s; -PTR_BFND b; -{ - PTR_REFL rl, build_refl(), remove_locals_from_list(); - PTR_LLND link_set_list(); - - rl = build_refl(b, s); - rl = remove_locals_from_list(rl); - return (link_set_list(rl)); -} - - -static void use_mod(c) -PTR_CALLS c; -{ - PTR_BFND b; - PTR_LLND used, modified; - - b = c->call_site; - bind_call_site_info(b, &used, &modified); - c->used = link_ll_set_list(b, used); - c->modified = link_ll_set_list(b, modified); -} - - -static void compute_use_mod() -{ - int modified = 1; - PTR_CALLS calls; - PTR_LLND use, mod; - int i, j; - - while (modified) { - modified = 0; - for (j = num_of_funs - 1; j >= 0; j--) { - i = ival[j]; - if (ready_for_analysis(i) == 1) { - if (debug) { - fprintf(stderr, "_______________________________\n"); - fprintf(stderr, "doing global analysis for %s\n", funs[i].name->ident); - } - calls = funs[i].calls; - current_file = funs[i].file; - while (calls != NULL) { - if (calls->funs_number > -1 && - funs[calls->funs_number].is_done == 1) - use_mod(calls); - calls = calls->next; - } - funs[i].is_done = 1; - /* now link results together */ - use = funs[i].used; - mod = funs[i].modified; - calls = funs[i].calls; - while (calls != NULL) { - if (calls->funs_number > -1 && - funs[calls->funs_number].is_done == 1) { - use = link_ll_chain(use, calls->used); - mod = link_ll_chain(mod, calls->modified); - } - calls = calls->next; - } - use = link_ll_set_list(funs[i].fun, use); - mod = link_ll_set_list(funs[i].fun, mod); - funs[i].used = link_ll_set_list(funs[i].fun, use); - funs[i].modified = link_ll_set_list(funs[i].fun, mod); - funs[i].fun->entry.Template.ll_ptr3 - ->entry.Template.ll_ptr2 = funs[i].used; - funs[i].fun->entry.Template.ll_ptr2 - ->entry.Template.ll_ptr2 = funs[i].modified; - modified = 1; - } - } /* end for */ - } /* end while */ - - modified = 0; - for (i = 0; i < num_of_funs; i++) { - if (ready_for_analysis(i) == 2) { - funs[i].fun->entry.Template.ll_ptr3 - ->entry.Template.ll_ptr2 = funs[i].used; - funs[i].fun->entry.Template.ll_ptr2 - ->entry.Template.ll_ptr2 = funs[i].modified; - } - else - modified = 1; - } - if (modified && debug) - fprintf(stderr, "; cycle in call graph. no global analysis\n"); - current_file = NULL; -} - - -/**************************************************************** - * * - * GlobalAnal -- does the inter-procedural analysis for the * - * given project * - * * - * Input: * - * proj - the pointer to the project to be analized * - * * - * Output: * - * none * - * * - ****************************************************************/ -void GlobalAnal(proj) -PTR_PROJ proj; -{ - make_fun_list(proj); /* gather all the functions declared */ - BuildCallGraph(); /* build the call graph */ - dfs(); /* do the depth-first search */ - compute_use_mod(); /* do the inter-procedural analysis now */ -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c deleted file mode 100644 index baa65cd..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c +++ /dev/null @@ -1,433 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* file: ker_fun.c */ - -/**********************************************************************/ -/* This file contains the routines called in sets.c that do all cache*/ -/* analysis and estimation routines. */ -/**********************************************************************/ - -#include -#include "defs.h" -#include "bif.h" -#include "ll.h" -#include "symb.h" -#include "sets.h" - -#define PLUS 2 -#define ZPLUS 3 -#define MINUS 4 -#define ZMINUS 5 -#define PLUSMINUS 6 -#define NODEP -1 - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -extern int show_deps; - -void *malloc(); -PTR_SETS alloc_sets(); -PTR_REFL alloc_ref(); -int disp_refl(); -PTR_REFL copy_refl(); -PTR_REFL union_refl(); -int **a_array; -int a_allocd = 0; -int x[20]; /* a temporary used to compute the vector c */ -int c[20]; /* such that h(c) = dist */ -int gcd(); -int make_induct_list(); -int comp_ker(); -int find_mults(); - -int unif_gen(sor, des, vec, troub, source, destin) -int vec[], troub[]; -struct ref *sor; -struct ref *des; -struct subscript *source; -struct subscript *destin; -{ - PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH]; - struct subscript il_lo[MAX_NEST_DEPTH]; - struct subscript il_hi[MAX_NEST_DEPTH]; - PTR_LLND ll, tl; - int arr_dim, uniform; - int v[AR_DIM_MAX]; - int r, i, j, sd, dd, depth; - - /* the a array that is used here is allocated once and used */ - /* again in future calls */ - - if (a_allocd == 0) { - a_allocd = 1; - a_array = (int **)malloc(MAX_NEST_DEPTH * (sizeof(int *))); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,a_array, 0); -#endif - for (i = 0; i < MAX_NEST_DEPTH; i++) - { - a_array[i] = (int *)malloc((AR_DIM_MAX + MAX_NEST_DEPTH) * (sizeof(int))); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,a_array[i], 0); -#endif - } - } - for (i = 0; i < MAX_NEST_DEPTH; i++) { - sor_ind_l[i] = NULL; - des_ind_l[i] = NULL; - } - - - dd = make_induct_list(des->stmt, des_ind_l, il_lo, il_hi); - sd = make_induct_list(sor->stmt, sor_ind_l, il_lo, il_hi); - - depth = (sd < dd) ? sd : dd; - - i = 0; - while ((i < depth) && (des_ind_l[i] == sor_ind_l[i])) - i++; - if (i < depth) - depth = i; - - arr_dim = 0; - /* compute the dimension of the array */ - ll = sor->refer; - if (ll->variant == ARRAY_REF) { - tl = ll->entry.array_ref.index; - while (tl != NULL) { - if ((tl->variant == VAR_LIST) || - (tl->variant == EXPR_LIST) || - (tl->variant == RANGE_LIST)) { - tl = tl->entry.list.next; - arr_dim++; - } - } - } - uniform = 1; - for (i = 0; i < arr_dim; i++) { - if (source[i].decidable != destin[i].decidable) - uniform = 0; - v[i] = source[i].offset - destin[i].offset; - for (j = 0; j < depth; j++) - if (source[i].coefs[j] != destin[i].coefs[j]) - uniform = 0; - } - if (uniform == 1) { - r = comp_ker(arr_dim, depth, source, a_array, sor_ind_l, v, vec, troub); - } - /* else if (show_deps) fprintf(stderr, "not uniform\n"); */ - return (uniform); - -} - -/* comp_ker is a function that takes the matrix "h" associated with */ -/* a uniformly generated (potential) dependence and a offest vector "dist" */ -/* and computes the distance vector "vec" and a trouble vector "troub" */ -/* the matrix is associated with the access function of an array reference */ -/* where the array is of dimension "adim" and the depth of nesting is */ -/* depth. The "a" array is a matrix that is allocated by the caller and */ -/* upon return contains a factorization of "h". The array is "depth" rows */ -/* by dept+adim columns but is viewed as its transpose mathematically. */ -/* It should be allocated as MAX_NEST_DEPTH by AR_DIM_MAX+MAX_NEST_DEPTH */ -/* In other words "a" is first initialized as - - |<- depth ->| - -------| | - ^ | | - adim | h | - v | | - -------|-----------| where rows in C are columns. - ^ | | - depth | I | - v | | - -------------------- - - A factoriation takes place which converts this to the form where the -h component is now the matrix L and the Identity block I is now a square -matrix B such that - L = hB - -and L is lower triangular and B and L are integer valued. - -What this means is that -if dist = Lx, for some x then let c be such that c = Bx and we have -dist = Lx = hBx = hc. (note x and c are global and returned by side effect.) -and c is the distance vector. - -Furturemore, comp_ker returns the dimension of ker(h) and the right hand -dim(ker(h)) columns of B form a basis of the kernel. - -*/ - - -int comp_ker(adim, depth, sa, a, sor_ind_l, dist, vec, troub) -int adim, depth; -struct subscript *sa; -int **a; -PTR_SYMB sor_ind_l[]; -int dist[]; -int vec[], troub[]; -{ - int i, j, k, piv_row, piv_col, cols_done, m, mval, cur_x; - int nosolution; - int p, q, r, s, z; - int *tmp; - - sor_ind_l = sor_ind_l; /* make lint happy, sor_ind_l not used */ - - /* h components in first adim rows of matrix */ - for (i = 0; i < adim; i++) { - for (j = 0; j < depth; j++) - a[j][i] = sa[i].coefs[j]; - } - - /* depth by depth square identity in second block of matrix */ - for (i = adim; i < adim + depth; i++) { - for (j = 0; j < depth; j++) - if ((i - adim) == j) - a[j][i] = 1; - else - a[j][i] = 0; - } - /* if(show_deps) print_a_arr(adim+depth,depth); */ - /* The following is a factorization of the array H from the */ - /* function h (stored as the upper part of a ) into a lower */ - /* triangluar matrix L and a matrix B such that L = HB */ - /* now do column operations to reduce top to lower triangular */ - /* remember that a is transposed to use pointers for columns */ - /* for each row ... */ - cols_done = 0; - for (i = 0; i < adim; i++) { - piv_row = i; - piv_col = cols_done; - while ((a[piv_col][piv_row] == 0) && (piv_col < depth)) - piv_col++; - if (piv_col < depth) { - m = piv_col; - mval = a[m][piv_row]; - mval = mval * mval; - k = 0; - /* pick min non-zero term on row to right of cols_done */ - for (j = cols_done; j < depth; j++) - if ((a[j][piv_row] != 0) && - ((a[j][piv_row] * a[j][piv_row]) < mval)) { - m = j; - mval = a[j][piv_row] * a[j][piv_row]; - } - /* now move col m to col cols_done */ - tmp = a[m]; - a[m] = a[cols_done]; - a[cols_done] = tmp; - /* now eliminate rest of row */ - for (j = cols_done + 1; j < depth; j++) - if (a[j][piv_row] != 0) { - find_mults(a[cols_done][piv_row], - a[j][piv_row], &p, &q, &r, &s); - for (k = 0; k < adim + depth; k++) { - z = a[cols_done][k] * p + a[j][k] * q; - a[j][k] = a[cols_done][k] * r - + a[j][k] * s; - a[cols_done][k] = z; - } - if (a[cols_done][piv_row] == 0) { - tmp = a[j]; - a[j] = a[cols_done]; - a[cols_done] = tmp; - } - } - cols_done++; - } - } - /* reduce system by gcd of each column */ - for (j = 0; j < depth; j++) { - z = gcd(depth + adim, a[j]); - if (z != 1 && z != 0) { - for (k = 0; k < adim + depth; k++) - a[j][k] = a[j][k] / z; - } - } - - /* now back solve for x in dist = Lx */ - nosolution = 0; - cur_x = 0; - for (j = 0; (j < adim && cur_x < depth); j++) { - z = 0; - for (k = 0; k < cur_x; k++) - z = z + a[k][j] * x[k]; - if (a[cur_x][j] == 0) { - if (z != dist[j]) { - nosolution = 1; - } - /* this equation is consistent, so skip it */ - } - else { - r = (dist[j] - z) / a[cur_x][j]; - if (r * a[cur_x][j] != dist[j] - z) { - nosolution = 1; - } - x[cur_x] = r; - cur_x++; - } - } - for (j = cur_x; j < depth; j++) x[j] = 0; - - - /* the following is a double check on the solution */ - - for (j = 0; j < adim; j++) { - z = 0; - for (k = 0; k < depth; k++) - z = z + a[k][j] * x[k]; - if (z != dist[j]) - nosolution = 1; - } - /* if there is no solution then there is no dependence! */ - if (nosolution) { - troub[0] = 1; - return (depth - cols_done); - } - /* because L = HB where B is the lower block of a */ - /* and dist = Lx we have dist = HBx, so if c = Bx, dist = Hc */ - for (j = 0; j < depth; j++) { - c[j] = 0; - for (k = 0; k < depth; k++) - c[j] = c[j] + a[k][j + adim] * x[k]; - } - /* to compute vec and troub, we start by setting */ - /* vec to c. (if ker(h) =0) we are done then */ - for (j = 0; j < depth; j++) - vec[j + 1] = c[j]; - /* we now modify by the leading terms of the ker basis */ - for (j = cols_done; j < depth; j++) { - /* find leading non-zero */ - z = -1; - for (k = 0; k < depth; k++) - if (z == -1 && a[j][k + adim] != 0) - z = k; - if (z > -1) { - troub[z + 1] = PLUS; - } - } - z = 100; - for (j = 1; j < depth + 1; j++) { - if (troub[j] == PLUS || vec[j] > 0) - z = j; - if (troub[j] != PLUS && vec[j] < 0 && z == 100) { - troub[0] = 1; - /* fprintf(stderr, " reject - wrong direction \n"); */ - return (depth - cols_done); - } - if (z < j && troub[j] == PLUS && vec[j] < 0) - troub[j] = ZPLUS; - } - - /* print_a_arr(adim+depth,depth); */ - return (depth - cols_done); -} - -static int myabs(x) -int x; -{ - if (x < 0) - return (-x); - else - return (x); -} - -int eval_h(c, depth, i, val) -int c[]; -int depth, i, val; -{ - depth = depth; /* make lint happy, depth unused */ - - return (c[i] * val); -} - -int find_mults(a, b, p1, q1, r1, s1) -int a, b; -int *p1; -int *q1; -int *r1; -int *s1; -{ - /* upon return : a*p+b*q or a*r+b*s is 0 */ - int p, q, r, s, olda, oldb; - - olda = a; - oldb = b; - p = 1; - q = 0; - r = 0; - s = 1; - while (a * b != 0) { - if (a == b) { - r = r - p; - s = s - q; - b = 0; - } - else if (a == -b) { - r = r + p; - s = s + q; - b = 0; - } - else if (myabs(a) < myabs(b)) { - if (a * b > 0) { /* same sign */ - r = r - p; - s = s - q; - b = b - a; - } - else { - r = r + p; - s = s + q; - b = b + a; - } - } - else { - if (a * b > 0) { - p = p - r; - q = q - s; - a = a - b; - } - else { - p = p + r; - q = q + s; - a = a + b; - } - } - } /* end while */ - - if ((a != (olda * p + oldb * q)) || (b != (olda * r + oldb * s))) - fprintf(stderr, " reduce failed!\n"); - *p1 = p; - *q1 = q; - *r1 = r; - *s1 = s; -return 1; -} - -void print_a_arr(rows, cols) -int rows, cols; -{ - int i, j; - for (i = 0; i < rows; i++) { - fprintf(stderr, " | "); - for (j = 0; j < cols; j++) { - fprintf(stderr, " %d ", a_array[j][i]); - if (j == cols - 1) - fprintf(stderr, " |\n"); - } - } -} - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/list.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/list.c deleted file mode 100644 index f47d801..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/list.c +++ /dev/null @@ -1,655 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -#include - -#include "db.h" -#include "list.h" - -/* the following declarations are temporary fixes until we */ -/* decide how to deal with numbering and write nodes. */ - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -struct bfnd cbfnd; -struct dep cdep; - -static LIST lis_array; -static int list_not_ready = 1; - -/* end of declaration hack */ - -extern PTR_FILE cur_file; - -PTR_BFND make_bfnd(); -PTR_BLOB make_blob(); -PTR_LLND make_llnd(); -PTR_LLND copy_llnd(); -PTR_SYMB make_symb(); - -/************************************************************************ - * * - * List manipuliation functions alloc_list(), push_llnd() * - * push_symb(), free_list() to be used by make_expr() * - * * - ************************************************************************/ - -LIST -alloc_list(type) - int type; -{ - int i; - - if(list_not_ready){ - lis_array = (LIST) calloc(NUMLIS, sizeof(struct lis_node)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,lis_array, 0); -#endif - for(i = 0; i < NUMLIS; i++) - lis_array[i].variant = UNUSED; - list_not_ready = 0; - } - for(i = 0; i < NUMLIS; i++) - if(lis_array[i].variant == UNUSED){ - lis_array[i].variant = type; - return(&lis_array[i]); - } - return(NULL); -} - - -/* push the low level node llnd on the front of list lis */ -LIST -push_llnd(llnd, lis) - PTR_LLND llnd; - LIST lis; -{ - LIST nl; - - nl = alloc_list(LLNDE); - nl->entry.llnd = llnd; - nl->next = lis; - return(nl); -} - - -/* push the symb node symb on the front of list lis */ -LIST -push_symb(symb, lis) - PTR_SYMB symb; - LIST lis; -{ - LIST nl; - - nl = alloc_list(SYMNDE); - nl->entry.symb = symb; - nl->next = lis; - return(nl); -} - - -void -free_list(lis) - LIST lis; -{ - LIST nxt; - - while(lis != NULL){ - lis->variant = UNUSED; - nxt = lis->next; - lis->next = NULL; - lis = nxt; - } -} - - - -/************************************************************************ - * * - * blob list manipulation routines car, cdr, append. * - * * - ************************************************************************/ - -#define car(bl_list) bl_list->ref -#define cdr(bl_list) bl_list->next - -PTR_BLOB -cons( bif, bl_list) - PTR_BFND bif; - PTR_BLOB bl_list; -{ - return (make_blob(cur_file, bif, bl_list)); -} - - -/* append without copy -- not standard lisp append */ -PTR_BLOB -append(bl_list, bif) - PTR_BLOB bl_list; - PTR_BFND bif; -{ - PTR_BLOB b; - - if (bl_list == NULL) - return(make_blob(cur_file, bif, NULL)); - - for (b = bl_list; b->next; b = b->next) - ; - b->next = make_blob(cur_file, bif, NULL); - return(bl_list); -} - - - - -/* - * get_r_follow_node recursively checks source and all of its decendents until - * it finds the ith dependence. It returns the node on the same level as - * source. - */ -PTR_BFND -get_r_follow_node(par,source,bfptr,j,i) - PTR_BFND bfptr, par, source; - int *j; - int i; -{ - PTR_DEP p; - PTR_BFND targ; - PTR_BLOB b; - PTR_BFND child, final; - - p = bfptr->entry.Template.dep_ptr1; - while(( p != NULL) && ( *j <= i)) { - if((p->to.stmt != source) && - ((p->type == 0) ||(p->type == 1) ||(p->type == 2)) - ){ - if( *j == i){ - targ = p->to.stmt; - while(targ != NULL && targ->variant != GLOBAL && - targ->control_parent != par) targ = targ->control_parent; - if(targ->variant == GLOBAL) return(NULL); - else if (targ == source) p = p->from_fwd; - else return( targ); - } - else { - p =p->from_fwd; - *j = (*j)+1; - } - } - else p =p->from_fwd; - } - if(p == NULL && (bfptr->variant == FOR_NODE || bfptr->variant == FORALL_NODE || bfptr->variant == IF_NODE)){ - b = bfptr->entry.Template.bl_ptr1; - while(b != NULL && *j <=i){ - child = b->ref; - final = get_r_follow_node(par,source,child,j,i); - if(final != NULL && final != source) return(final); - b = b->next; - } - } - if(p == NULL && bfptr->variant == IF_NODE){ - b = bfptr->entry.Template.bl_ptr2; - while(b != NULL && *j <=i){ - child = b->ref; - final = get_r_follow_node(par,source,child,j,i); - if(final != NULL && final != source) return(final); - b = b->next; - } - } - /* if *j <= i then we are not there yet but out of dependences and childern so return null */ - - return(NULL); -} - - -/* returns pointer to i-th bf-node following *bfptr in dep order */ -PTR_BFND -get_follow_node(bfptr,i) - PTR_BFND bfptr; - int i; -{ - PTR_BFND par = bfptr->control_parent, - source = bfptr; - int j = 0; - - return(get_r_follow_node(par,source,bfptr,&j,i)); -} - -/**************************************************************** - * * - * MAKE functions: make_expr(), * - * mk_llnd(), * - * make_ddnd(), * - * mk_symb(), * - * make_asign() * - * make_for() & mkloop() * - * make_cntlend() * - * * - ****************************************************************/ - -PTR_LLND -mk_llnd(PTR_LLND p) -/* PTR_LLND p;*/ -{ - PTR_LLND nd; - - nd = make_llnd(cur_file, 0, NULL, NULL, NULL); - if (p != NULL){ - nd->variant = p->variant; - nd->type = p->type; - nd->entry.Template.symbol = p->entry.Template.symbol; - nd->entry.Template.ll_ptr1 = p->entry.Template.ll_ptr1; - nd->entry.Template.ll_ptr2 = p->entry.Template.ll_ptr2; - } else - nd->variant = VAR_REF; - return(nd); -} - - -PTR_SYMB -mk_symb(name,p) - char *name; - PTR_SYMB p; -{ - PTR_SYMB nd; - - nd = make_symb(cur_file, 0, name); - if (p != NULL){ - nd->variant = p->variant; - nd->type = p->type; - nd->next_symb = p->next_symb; - p->next_symb = nd; - nd->parent = p->parent; - } else { - nd->variant = VARIABLE_NAME; - nd->type = NULL; - nd->next_symb = NULL; - nd->parent = NULL; - } - nd->entry.var_decl.local = LOCAL; - nd->outer = NULL; - nd->id_list = NULL; - - return(nd); -} - - -static LIST lispt; - -/* op = one of ADD_OP SUBT_OP MULT_OP DIV_OP (or other binary ops) */ -PTR_LLND -make_oper(op) - int op; -{ - PTR_LLND nd; - - nd = mk_llnd(NULL); - nd->variant = op; - return(nd); -} - - -PTR_LLND -make_arref(ar,index) - PTR_SYMB ar; - PTR_LLND index; -{ - PTR_LLND nd; - - nd = mk_llnd(NULL); - nd->variant = ARRAY_REF; - nd->entry.array_ref.symbol = ar; - nd->entry.array_ref.index = index; - nd->entry.array_ref.array_elt = NULL; - return(nd); -} - - -PTR_LLND -make_int(i) - int i; -{ - PTR_LLND nd; - - nd = mk_llnd(NULL); - nd->variant = INT_VAL; - nd->entry.ival = i; - return(nd); -} - - -PTR_LLND -hmake_expr() -{ - LIST lis; - PTR_LLND nd; - - if (lispt == NULL) - return(NULL); - - lis = lispt; - lispt = lis->next; - if (lis->variant == SYMNDE){ - nd = mk_llnd(NULL); - if(lis->entry.symb->variant == VARIABLE_NAME) - nd->variant = VAR_REF; - else - fprintf(stderr, "wrong symbol type in make_expr"); - nd->entry.Template.symbol = lis->entry.symb; - return(nd); - } else if(lis->variant == LLNDE){ - nd = lis->entry.llnd; - switch (nd->variant) { - case DDOT : - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP : - case LTEQL_OP : - case GTEQL_OP : - case ADD_OP : - case SUBT_OP : - case OR_OP : - case MULT_OP : - case DIV_OP : - case MOD_OP : - case AND_OP : - case EXP_OP : - if (nd->entry.binary_op.l_operand == NULL){ - nd->entry.binary_op.l_operand = - hmake_expr(); - nd->entry.binary_op.r_operand = - hmake_expr(); - } - break; - case MINUS_OP : - case NOT_OP : - if (nd->entry.unary_op.operand == NULL){ - nd->entry.unary_op.operand = - hmake_expr(); - } - break; - - default: - break; - } - return(nd); - } - return NULL; -} - - -/* - * this routine creates a low level expression tree from the preorder - * list of llnds and symbol pointers then deletes the list - */ -PTR_LLND -make_expr(lis) - LIST lis; -{ - LIST L; - PTR_LLND n; - - L = lis; - lispt = lis; - n = hmake_expr(); - free_list(L); - return(n); -} - - -PTR_BFND -make_asign(lhs,rhs) - PTR_LLND lhs,rhs; -{ - return(make_bfnd(cur_file, ASSIGN_STAT, NULL, lhs, rhs, NULL)); -} - - -PTR_BFND -make_for(index,range) - PTR_SYMB index; - PTR_LLND range; -{ - return(make_bfnd(cur_file, FOR_NODE, index, range, NULL, NULL)); -} - - -/* - * make a for_node like *p - * this is a special version used by distribute - */ -PTR_BFND -mkloop(p) - PTR_BFND p; -{ - PTR_BFND newp; - - /* we should be making new copies of the following structures! */ - newp = make_bfnd(cur_file, - FOR_NODE, - p->entry.Template.symbol, - p->entry.Template.ll_ptr1, - p->entry.Template.ll_ptr2, - p->entry.Template.ll_ptr3); - - newp->entry.Template.bf_ptr1 = p->entry.Template.bf_ptr1; - newp->entry.Template.cmnt_ptr = p->entry.Template.cmnt_ptr; - - newp->filename = p->filename; - return(newp); -} - - - -PTR_BFND -make_cntlend(par) - PTR_BFND par; -{ - PTR_BFND b; - - b = make_bfnd(cur_file, CONTROL_END, NULL, NULL, NULL, NULL); - b->control_parent = par; - return(b); -} - - -static int modified = 0; - -/* create a NEW low level node tree with cvar replaced by newref */ -PTR_LLND -replace_ref(lnd,cvar,newref) - PTR_LLND lnd; - PTR_SYMB cvar; - PTR_LLND newref; -{ - PTR_LLND pllnd, rtnval; - - if (lnd == NULL) return(NULL); - - pllnd = mk_llnd(lnd); - rtnval = pllnd; - - switch (pllnd->variant) { - case CONST_REF: - case VAR_REF : - case ENUM_REF : - if( pllnd->entry.Template.symbol==cvar){ - /* replace with subtree consisting of newref */ - modified = 1; - rtnval = copy_llnd(newref); - } - break; - case ARRAY_REF: - pllnd->entry.array_ref.index = - replace_ref(pllnd->entry.array_ref.index,cvar,newref); - if (pllnd->entry.array_ref.array_elt != NULL) { - pllnd->entry.array_ref.array_elt = - replace_ref(pllnd->entry.array_ref.array_elt,cvar,newref); - } - break; - case RECORD_REF: - if (pllnd->entry.record_ref.rec_field != NULL) { - pllnd->entry.record_ref.rec_field = - replace_ref(pllnd->entry.record_ref.rec_field,cvar,newref); - } - break; - case PROC_CALL : - case FUNC_CALL : - pllnd->entry.proc.param_list = - replace_ref(pllnd->entry.proc.param_list,cvar,newref); - break; - case VAR_LIST : - case EXPR_LIST : - case RANGE_LIST : - pllnd->entry.list.item = - replace_ref(pllnd->entry.list.item,cvar,newref); - if (pllnd->entry.list.next != NULL) { - pllnd->entry.list.next = - replace_ref(pllnd->entry.list.next,cvar,newref); - } - break; - - case CASE_CHOICE: - case DDOT : - pllnd->entry.binary_op.l_operand = - replace_ref(pllnd->entry.binary_op.l_operand,cvar,newref); - pllnd->entry.binary_op.r_operand = - replace_ref(pllnd->entry.binary_op.r_operand,cvar,newref); - break; - /* binary ops */ - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP : - case LTEQL_OP : - case GTEQL_OP : - case ADD_OP : - case SUBT_OP : - case OR_OP : - case MULT_OP : - case DIV_OP : - case MOD_OP : - case AND_OP : - case EXP_OP : - pllnd->entry.binary_op.l_operand = - replace_ref(pllnd->entry.binary_op.l_operand,cvar,newref); - pllnd->entry.binary_op.r_operand = - replace_ref(pllnd->entry.binary_op.r_operand,cvar,newref); - break; - case MINUS_OP: - case NOT_OP : - pllnd->entry.unary_op.operand = - replace_ref(pllnd->entry.unary_op.operand,cvar,newref); - break; - default: - break; - } - return(rtnval); -} - - -/* routine to make double dot node low..hi from an expression */ -PTR_LLND -make_ddnd(pllnd,cvar,low,hi) - PTR_LLND pllnd,low,hi; - PTR_SYMB cvar; -{ - PTR_LLND tmp, dotnd; - - tmp = replace_ref(pllnd,cvar,low); - if(modified){ - dotnd = mk_llnd(NULL); - dotnd->variant = DDOT; - dotnd->entry.Template.symbol = NULL; - dotnd->entry.Template.ll_ptr1 = tmp; - dotnd->entry.Template.ll_ptr2 = - replace_ref(pllnd,cvar,hi); - return(dotnd); - } - else return(pllnd); -} - - -/* - * create a new ddot node for every array-ref in expression containing - * a reference to cvar - */ -void -expand_ref(pllnd,cvar,low,hi) - PTR_LLND pllnd; - PTR_SYMB cvar; - PTR_LLND low,hi; -{ - if (pllnd == NULL) return; - - switch (pllnd->variant) { - case ARRAY_REF: - /* [ */ - modified = 0; /* set changed flag */ - if((pllnd->entry.array_ref.index->variant != EXPR_LIST) && - (pllnd->entry.array_ref.index->variant != RANGE_LIST)) - pllnd->entry.array_ref.index = - make_ddnd(pllnd->entry.array_ref.index,cvar,low,hi); - else expand_ref(pllnd->entry.array_ref.index,cvar,low,hi); - - /* otherwise this is a scalar reference and should */ - /* not be changed here. In any case reset flag */ - modified = 0; - /* ] */ - break; - case RECORD_REF: - if (pllnd->entry.record_ref.rec_field != NULL) - expand_ref(pllnd->entry.record_ref.rec_field,cvar,low,hi); - break; - case PROC_CALL: - case FUNC_CALL: - expand_ref(pllnd->entry.proc.param_list,cvar,low,hi); - break; - case VAR_LIST : - case EXPR_LIST: - case RANGE_LIST: - /* the other place where something can happen is here * - * if we have a[i,j] and we are vectorizing j then this * - * should be a[i,low..hi], unless it is i we are after */ - modified = 0; - pllnd->entry.list.item = - make_ddnd(pllnd->entry.list.item,cvar,low,hi); - modified = 0; - if (pllnd->entry.list.next != NULL) { - /* pllnd->entry.list.next = */ - expand_ref(pllnd->entry.list.next,cvar,low,hi); - modified = 0; - } - break; - case EQ_OP : - case LT_OP : - case GT_OP : - case NOTEQL_OP: - case LTEQL_OP: - case GTEQL_OP: - case ADD_OP : - case SUBT_OP: - case OR_OP : - case MULT_OP: - case DIV_OP : - case MOD_OP : - case AND_OP : - case EXP_OP : - expand_ref(pllnd->entry.binary_op.l_operand,cvar,low,hi); - expand_ref(pllnd->entry.binary_op.r_operand,cvar,low,hi); - break; - case MINUS_OP: - expand_ref(pllnd->entry.unary_op.operand,cvar,low,hi); - break; - case NOT_OP : - expand_ref(pllnd->entry.unary_op.operand,cvar,low,hi); - break; - default: - break; - } -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c deleted file mode 100644 index a8f0bba..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c +++ /dev/null @@ -1,641 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -#include - -#include "db.h" -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -#define ALLOC(x) (struct x *) chkalloc(sizeof(struct x)) -#define LABUNKNOWN 0 - -/* - * External references - */ -extern PTR_FILE cur_file; - -/* - * copyn -- makes a copy of a string with known length - * - * input: - * n - length of the string "s" - * s - the string to be copied - * - * output: - * pointer to the new string - */ -char * -copyn(int n, char *s) -/* int n; */ -/* char *s; */ -{ - char *p, *q; - - p = q = (char *) calloc(1, (unsigned) n); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - while (--n >= 0) - *q++ = *s++; - return (p); -} - - -/* - * copys -- makes a copy of a string - * - * input: - * s - string to be copied - * - * output: - * pointer to the new string - */ -char * -copys(s) - char *s; -{ - return (copyn(strlen(s) + 1, s)); -} - - -char * -chkalloc(int n) -/* int n; */ -{ - char *p; - - if ((p = (char *)calloc(1, (unsigned)n)) != 0) - { -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - return (p); - } - return NULL; -} - - -PTR_BFND -alloc_bfndnt (fi) - PTR_FILE fi; -{ - register PTR_BFND new; - - new = ALLOC (bfnd); - new->id = ++(fi->num_bfnds); - new->thread = BFNULL; - return (new); -} - -PTR_BFND -alloc_bfnd (fi) - PTR_FILE fi; -{ - register PTR_BFND new; - - new = ALLOC (bfnd); - new->id = ++(fi->num_bfnds); - new->thread = BFNULL; - if (fi->num_bfnds == 1) - fi->head_bfnd = new; - else - fi->cur_bfnd->thread = new; - fi->cur_bfnd = new; - return (new); -} - - -PTR_LLND -alloc_llnd (fi) - PTR_FILE fi; -{ - register PTR_LLND new; - - new = ALLOC (llnd); - new->id = ++(fi->num_llnds); - new->thread = LLNULL; - if (fi->num_llnds == 1) - fi->head_llnd = new; - else - fi->cur_llnd->thread = new; - fi->cur_llnd = new; - return (new); -} - - -PTR_TYPE -alloc_type (fi) - PTR_FILE fi; -{ - PTR_TYPE new; - - new = (PTR_TYPE) calloc (1, sizeof (struct data_type)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,new, 0); -#endif - new->id = ++(fi->num_types); - new->thread = TYNULL; - if (fi->num_types == 1) - fi->head_type = new; - else - fi->cur_type->thread = new; - fi->cur_type = new; - return (new); -} - - -PTR_SYMB -alloc_symb (fi) - PTR_FILE fi; -{ - PTR_SYMB new; - - if (fi->cur_symb && (fi->cur_symb->variant == 0)) - return (fi->cur_symb); - new = ALLOC (symb); - new->id = ++(fi->num_symbs); - new->thread = SMNULL; - if (fi->num_symbs == 1) - fi->head_symb = new; - else - fi->cur_symb->thread = new; - fi->cur_symb = new; - return (new); -} - - -PTR_LABEL -alloc_lab (fi) - PTR_FILE fi; -{ - PTR_LABEL new; - - new = ALLOC (Label); - new->id = ++(fi->num_label); - new->next = LBNULL; - if (fi->num_label == 1) - fi->head_lab = new; - else - fi->cur_lab->next = new; - fi->cur_lab = new; - return (new); -} - - -PTR_DEP -alloc_dep (fi) - PTR_FILE fi; -{ - PTR_DEP new; - - new = ALLOC (dep); - new->id = ++(fi->num_dep); - new->thread = NULL; - if (fi->num_dep == 1) - fi->head_dep = new; - else - fi->cur_dep->thread = new; - fi->cur_dep = new; - return (new); -} - - -/* - * Make a BIF node - */ -PTR_BFND -make_bfnd (PTR_FILE fi, int node_type, PTR_SYMB symb_ptr, PTR_LLND ll1, PTR_LLND ll2, PTR_LLND ll3) -/* PTR_FILE fi; */ -/* int node_type; */ -/* PTR_SYMB symb_ptr; */ -/* PTR_LLND ll1, ll2, ll3; */ -{ - register PTR_BFND new_bfnd; - - new_bfnd = alloc_bfnd (fi); /* should set up id field */ - new_bfnd->variant = node_type; - new_bfnd->filename = NULL; - new_bfnd->entry.Template.symbol = symb_ptr; - new_bfnd->entry.Template.ll_ptr1 = ll1; - new_bfnd->entry.Template.ll_ptr2 = ll2; - new_bfnd->entry.Template.ll_ptr3 = ll3; - new_bfnd->entry.Template.cmnt_ptr = NULL; - fi->cur_bfnd = new_bfnd; - return (new_bfnd); -} - -PTR_BFND -make_bfndnt (fi, node_type, symb_ptr, ll1, ll2, ll3) - PTR_FILE fi; - int node_type; - PTR_SYMB symb_ptr; - PTR_LLND ll1, ll2, ll3; -{ - register PTR_BFND new_bfnd; - - new_bfnd = alloc_bfndnt (fi); /* should set up id field */ - new_bfnd->variant = node_type; - new_bfnd->filename = NULL; - new_bfnd->entry.Template.symbol = symb_ptr; - new_bfnd->entry.Template.ll_ptr1 = ll1; - new_bfnd->entry.Template.ll_ptr2 = ll2; - new_bfnd->entry.Template.ll_ptr3 = ll3; - new_bfnd->entry.Template.cmnt_ptr = NULL; - fi->cur_bfnd = new_bfnd; - return (new_bfnd); -} - -/* - * Make a new low level node - */ -PTR_LLND -make_llnd (PTR_FILE fi, int node_type, PTR_LLND ll1, PTR_LLND ll2, PTR_SYMB symb_ptr) -/* PTR_FILE fi; */ -/* int node_type; */ -/* PTR_LLND ll1, ll2; */ -/* PTR_SYMB symb_ptr; */ -{ - PTR_LLND new_llnd; - - new_llnd = alloc_llnd (fi); /* should set up id field */ - - new_llnd->variant = node_type; - new_llnd->type = TYNULL; - new_llnd->entry.Template.ll_ptr1 = ll1; - new_llnd->entry.Template.ll_ptr2 = ll2; - switch (node_type) { - case INT_VAL: - /* new_llnd->entry.ival = (int) symb_ptr; */ - break; - case BOOL_VAL: - /* new_llnd->entry.bval = (int) symb_ptr; */ - break; - default: - new_llnd->entry.Template.symbol = symb_ptr; - break; - } - return (new_llnd); -} - - -/* - * Make a new low level node for label - */ -PTR_LLND -make_llnd_label (fi, node_type, lab) - PTR_FILE fi; - int node_type; - PTR_LABEL lab; -{ - PTR_LLND new_llnd; - - new_llnd = alloc_llnd (fi); /* should set up id field */ - - new_llnd->variant = node_type; - new_llnd->type = TYNULL; - new_llnd->entry.label_list.lab_ptr = lab; - new_llnd->entry.label_list.null_1 = LLNULL; - new_llnd->entry.label_list.next = LLNULL; - return (new_llnd); -} - - -/* - * Make a new symb node - */ -PTR_SYMB -make_symb (fi, node_type, string) - PTR_FILE fi; - int node_type; - char *string; -{ - PTR_SYMB new_symb; - - new_symb = alloc_symb (fi); - new_symb->variant = node_type; - new_symb->ident = copys (string); - return (new_symb); -} - - -/* - * Make a new type node - */ -PTR_TYPE -make_type (fi, node_type) - PTR_FILE fi; - int node_type; -{ - PTR_TYPE new_type; - - new_type = alloc_type (fi); - new_type->entry.Template.ranges = NULL; - new_type->variant = node_type; - return (new_type); -} - - -/* - * Make a new label node for Fortran. VPC has its own get_labe - */ -PTR_LABEL -make_label (fi, l) - PTR_FILE fi; - long l; -{ - PTR_LABEL new_lab; - PTR_BFND this_scope; - int num;/*podd*/ - num = fi->cur_bfnd ? fi->cur_bfnd->g_line : 0; /*podd*/ - if (l <= 0 || l > 99999) { - /* fprintf (stderr, "Error 038 on line %d of %s: Label out of range\n", num, fi->filename); */ - l = 0; - } - this_scope = NULL; - for (new_lab = fi->head_lab; new_lab; new_lab = new_lab->next) - if (new_lab->stateno == l && new_lab->scope == this_scope) - return (new_lab); - - new_lab = alloc_lab (fi); - - new_lab->stateno = l; - new_lab->scope = this_scope; - new_lab->labused = NO; - new_lab->labdefined = NO; - new_lab->labinacc = NO; - new_lab->labtype = LABUNKNOWN; - new_lab->statbody = BFNULL; - return (new_lab); -} - - -/* - * Make a DEP node - */ -PTR_DEP -make_dep(fi, sym,t,lls,lld,bns,bnd,dv) - PTR_FILE fi; - PTR_SYMB sym; /* symbol for variable name */ - char t; /* type: 0=flow 1=anti 2 = output */ - PTR_LLND lls, lld; /* term source and destination */ - PTR_BFND bns, bnd; /* biff nd source and destination */ - char *dv; /* dep. vector: 1="=" 2="<" 4=">" ? */ -{ - int i; - PTR_DEP d; - - if ((d = alloc_dep(fi)) == NULL) - return NULL; - d->type = t; - d->symbol = sym; - d->from.stmt = bns; d->from.refer = lls; - d->to.stmt = bnd; d->to.refer = lld; - for(i=0; i < MAX_DEP; i++) d->direct[i] = 0; - for(i=0; i < MAX_NEST_DEPTH; i++) d->direct[i] = dv[i]; - - return(d); -} - - -/*------------------------------------------------------* - * alloc_blob * - *------------------------------------------------------*/ -PTR_BLOB -alloc_blob1(fi) - PTR_FILE fi; -{ - PTR_BLOB new; - - new = ALLOC(blob); - ++(fi->num_blobs); - return (new); -} - - -PTR_CMNT -alloc_cmnt (fi) - PTR_FILE fi; -{ - PTR_CMNT new; - - new = ALLOC (cmnt); - new->id = ++(fi->num_cmnt); - new->thread = CMNULL; - if (fi->num_cmnt == 1) - fi->head_cmnt = new; - else - fi->cur_cmnt->thread = new; - fi->cur_cmnt = new; - return (new); -} - - -/*------------------------------------------------------* - * make_blob * - *------------------------------------------------------*/ -PTR_BLOB -make_blob (fi, ref, next) - PTR_FILE fi; - PTR_BFND ref; - PTR_BLOB next; -{ - PTR_BLOB new; - - new = alloc_blob1(fi); - new->ref = ref; - new->next = next; - return (new); -} - - -PTR_CMNT -make_comment (fi, s, t) - PTR_FILE fi; - char *s; - int t; -{ - PTR_CMNT new; - - new = alloc_cmnt(fi); - new->string = copys (s); - new->type = t; - return (new); -} - - -void -MakeBfnd (node_type, symb_ptr, ll1, ll2, ll3) - int node_type; - PTR_SYMB symb_ptr; - PTR_LLND ll1, ll2, ll3; -{ - PTR_BFND b; - - b = make_bfnd (cur_file, node_type, symb_ptr, ll1, ll2, ll3); - fprintf(stderr, "%d\n", b->id); -} - - -void -MakeLlnd (node_type, ll1, ll2, symb_ptr) - int node_type; - PTR_LLND ll1, ll2; - PTR_SYMB symb_ptr; -{ - PTR_LLND l; - - l = make_llnd (cur_file, node_type, ll1, ll2, symb_ptr); - fprintf(stderr, "%d\n", l->id); -} - - -void -Makellnd_label (node_type, lab) - int node_type; - PTR_LABEL lab; -{ - make_llnd_label (cur_file, node_type, lab); -} - - -void -MakeSymb (node_type, string) - int node_type; - char *string; -{ - PTR_SYMB s; - - s = make_symb (cur_file, node_type, string); - fprintf(stderr, "%d\n", s->id); -} - - -void -Maketype (node_type) - int node_type; -{ - PTR_TYPE t; - t = make_type (cur_file, node_type); - fprintf(stderr, "%d\n", t->id); -} - - -void -MakeLabel (l) - long l; -{ - PTR_LABEL l1; - - l1 = make_label (cur_file, l); - fprintf(stderr, "%d\n",l1->id); -} - - -void -MakeBlob (ref, next) - PTR_BFND ref; - PTR_BLOB next; -{ - make_blob (cur_file, ref, next); -} - - -void -MakeComment (s, t) - char *s; - int t; -{ - PTR_CMNT c; - - c = make_comment (cur_file, s, t); - fprintf(stderr, "%d\n",c->id); -} - - -/* - * declare variable can be used to create a new variable in the - * symbol table that is "like" another variable. For example - * if x is in a statement b and you wish to make a new variable - * with id x_new that is an array of the same type as x (which - * is a scalar), this function creates the new varaible and - * creates a declartion for it at the appropriate scope level - */ -PTR_SYMB -declare_variable (id, like, dimension, scope) - char *id; /* identifier for new variable */ - PTR_SYMB like; /* the Template variable */ - int dimension; /* if > 1 then this is an array */ - /* version of Template variable */ - PTR_BFND scope; /* pointer to a statment that is */ - /* in the block where this is to */ - /* be declared */ -{ - PTR_LLND expr_list, reference; - PTR_BFND decl_stmt; - PTR_LLND dimen_expr; - PTR_SYMB new_var; - - if (like == NULL) { - fprintf (stderr, "no Template in declare_varaible\n"); - return (NULL); - } - if (id == NULL) { - fprintf (stderr, "no id in declare_variable\n"); - return (NULL); - } - if (scope == NULL) { - fprintf (stderr, "no scope in declare_varaible\n"); - return (NULL); - } - new_var = make_symb (cur_file, VARIABLE_NAME, id); - if (dimension <= 1) { - if (like->type == NULL) { - fprintf (stderr, "problems with type of like in declare_variable\n"); - return (NULL); - } - new_var->type = like->type; - if (like->type->variant == T_ARRAY) { - dimen_expr = make_llnd (cur_file, INT_VAL, NULL, NULL, NULL); - dimen_expr = like->type->entry.ar_decl.ranges -> - entry.Template.ll_ptr1; - reference = make_llnd (cur_file, ARRAY_REF, dimen_expr, - NULL, new_var); - } else - reference = make_llnd (cur_file, VAR_REF, NULL, NULL, new_var); - } else { - dimen_expr = make_llnd (cur_file, INT_VAL, NULL, NULL, NULL); - dimen_expr->entry.ival = dimension; - reference = make_llnd (cur_file, ARRAY_REF, dimen_expr, NULL, new_var); - new_var->type = make_type (cur_file, T_ARRAY); - new_var->type->entry.ar_decl.base_type = like->type; - new_var->type->entry.ar_decl.num_dimensions = 1; - new_var->type->entry.ar_decl.ranges = dimen_expr; - } - expr_list = make_llnd (cur_file, EXPR_LIST, reference, NULL, NULL); - decl_stmt = make_bfnd (cur_file, VAR_DECL, NULL, expr_list, NULL, NULL); - scope = scope->control_parent; - while (scope != NULL && - scope->variant != GLOBAL && scope->variant != PROC_HEDR && - scope->variant != PROG_HEDR && scope->variant != FUNC_HEDR && - scope->variant != FOR_NODE && scope->variant != CDOALL_NODE && - scope->variant != PARFOR_NODE && scope->variant != PAR_NODE) - scope = scope->control_parent; - if (scope == NULL || scope->variant == GLOBAL) { - fprintf(stderr, "bad scope in declare_variable \n"); - return (NULL); - } - scope->entry.Template.bl_ptr1 = make_blob (cur_file, decl_stmt, - scope->entry.Template.bl_ptr1); - return (new_var); -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.uni b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.uni deleted file mode 100644 index e7a99b4..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.uni +++ /dev/null @@ -1,83 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/lib/oldsrc/makefile.sgi - -LIBDIR = ../../../lib - -OLDHEADERS = ../../h -H = ../../h -# Directory in which include file can be found -TOOLBOX_INCLUDE = ../include - -INCL = -I$(OLDHEADERS) -I../include - -CFLAGS = $(INCL) -c -DSYS5 -Wall - -EXTHDRS = $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \ - $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \ - $H/tag $H/vparse.h - -OBJS = anal_ind.o db.o db_unp.o \ - db_unp_vpc.o dbutils.o garb_coll.o \ - glob_anal.o ker_fun.o list.o \ - make_nodes.o mod_ref.o ndeps.o \ - readnodes.o sets.o setutils.o \ - symb_alg.o writenodes.o - -SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c \ - garb_coll.c glob_anal.c ker_fun.c list.c \ - make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \ - symb_alg.c writenodes.c - -$(LIBDIR)/libdb.a: $(OBJS) - ar qc $(LIBDIR)/libdb.a $(OBJS) - -all: $(LIBDIR)/libdb.a - @echo "*** COMPILING LIBRARY oldsrc DONE" - -clean: - rm -f $(OBJS) - -cleanall: - rm -f $(OBJS) - -### -anal_ind.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -db.o: $(H)/db.h $(H)/defs.h \ - $(H)/tag $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h -db_unp.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -db_unp_vpc.o: $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/db.h $(H)/vparse.h -dbutils.o: $(H)/db.h \ - $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h -garb-coll.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -glob_anal.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -ker_fun.o: $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h \ - $(H)/symb.h $(H)/sets.h -list.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/list.h -make_nodes.o: $(H)/db.h $(H)/defs.h $(H)/tag \ - $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h -mod_ref.o: $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h \ - $(H)/symb.h $(H)/sets.h $(H)/vparse.h $(H)/db.h -ndeps.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -readnodes.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/dep_str.h \ - $(H)/dep.h -sets.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -setutils.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -symb_alg.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ - $(H)/ll.h $(H)/symb.h $(H)/sets.h -writenodes.o: $(H)/db.h $(H)/defs.h $(H)/tag \ - $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/dep_str.h \ - $(H)/dep.h diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.win b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.win deleted file mode 100644 index 2a2f08a..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/makefile.win +++ /dev/null @@ -1,96 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# sage/lib/oldsrc/makefile.win - - -OUTDIR = ..\..\..\obj -LIBDIR = ..\..\..\lib - -OLDHEADERS = ..\..\h - -# Directory in which include file can be found -TOOLBOX_INCLUDE = ../include - -INCL = -I$(OLDHEADERS) -I../include - -# -w don't issue warning now. -#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ -# /Fp"$(OUTDIR)/oldsrc.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c -CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ - /Fp"$(OUTDIR)/oldsrc.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c - -.c{$(OUTDIR)/}.obj: - $(CC) $(CFLAGS) $< - -LIB32=$(LINKER) -lib -LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libdb.lib" - - -EXTHDRS = $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \ - $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \ - $H/tag $H/vparse.h - -OBJS = $(OUTDIR)/anal_ind.obj $(OUTDIR)/db.obj $(OUTDIR)/db_unp.obj \ - $(OUTDIR)/db_unp_vpc.obj $(OUTDIR)/dbutils.obj $(OUTDIR)/garb_coll.obj \ - $(OUTDIR)/glob_anal.obj $(OUTDIR)/ker_fun.obj $(OUTDIR)/list.obj \ - $(OUTDIR)/make_nodes.obj $(OUTDIR)/mod_ref.obj $(OUTDIR)/ndeps.obj \ - $(OUTDIR)/readnodes.obj $(OUTDIR)/sets.obj $(OUTDIR)/setutils.obj \ - $(OUTDIR)/symb_alg.obj $(OUTDIR)/writenodes.obj - -SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c \ - garb_coll.c glob_anal.c ker_fun.c list.c \ - make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \ - symb_alg.c writenodes.c - -$(LIBDIR)/libdb.lib: $(OBJS) - $(LIB32) @<< - $(LIB32_FLAGS) $(OBJS) -<< - -all: $(LIBDIR)/libdb.lib - @echo "*** COMPILING LIBRARY oldsrc DONE" - -clean: - -cleanall: - -### -anal_ind.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -db.o: $H/db.h $H/defs.h \ - $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h -db_unp.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -db_unp_vpc.o: $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h $H/db.h $H/vparse.h -dbutils.o: $H/db.h \ - $H/defs.h $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h -garb-coll.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -glob_anal.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -ker_fun.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ - $H/symb.h $H/sets.h -list.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h $H/list.h -make_nodes.o: $H/db.h $H/defs.h $H/tag \ - $H/bif.h $H/ll.h $H/symb.h $H/sets.h -mod_ref.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ - $H/symb.h $H/sets.h $H/vparse.h $H/db.h -ndeps.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -readnodes.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ - $H/dep.h -sets.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -setutils.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -symb_alg.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ - $H/ll.h $H/symb.h $H/sets.h -writenodes.o: $H/db.h $H/defs.h $H/tag \ - $H/bif.h $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ - $H/dep.h diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c deleted file mode 100644 index c13bf5d..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c +++ /dev/null @@ -1,540 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* file: mod_ref.c */ - -/* Modified by Jenq-Kuen Lee Feb 24,1988 */ -/* The simple un-parser for VPC++ */ -# include "db.h" -# include "vparse.h" - -#define BLOB1_NULL (PTR_BLOB1)NULL -#define R_VALUE 0 -#define L_VALUE 1 - -extern PCF UnparseBfnd[]; -extern PTR_BLOB1 chain_blob1(); -extern PTR_BLOB1 make_blob1(); -extern char *cunparse_llnd(); -extern PTR_FILE cur_file; - -static void ccheck_bfnd(); -static void ccheck_llnd(); -void print_out(); -void test_mod_ref(); -int is_i_code(); - -static void ccheck_bfnd(pbf, ref_list, mod_list) -PTR_BFND pbf; -PTR_BLOB1 *ref_list, *mod_list; -{ - PTR_BLOB1 list_r, list_m; - - *ref_list = BLOB1_NULL; - *mod_list = BLOB1_NULL; - if (!pbf) - return; - - switch (pbf->variant) { - case GLOBAL: - break; - case PROG_HEDR: - case PROC_HEDR: - break; - case FUNC_HEDR: - break; - case IF_NODE: - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case LOGIF_NODE: - case ARITHIF_NODE: - case WHERE_NODE: - break; - case FOR_NODE: - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pbf->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - ccheck_llnd(pbf->entry.Template.ll_ptr3, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case FORALL_NODE: - case WHILE_NODE: - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case ASSIGN_STAT: - case IDENTIFY: - case PROC_STAT: - case SAVE_DECL: - case CONT_STAT: - case FORMAT_STAT: - break; - case LABEL_STAT: - break; - case GOTO_NODE: - break; - case ASSGOTO_NODE: - case COMGOTO_NODE: - case STOP_STAT: - break; - case RETURN_STAT: - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case PARAM_DECL: - case DIM_STAT: - case EQUI_STAT: - case DATA_DECL: - case READ_STAT: - case WRITE_STAT: - case OTHERIO_STAT: - case COMM_STAT: - case CONTROL_END: - break; - case CLASS_DECL: /* New added for VPC */ - break; - case ENUM_DECL: /* New added for VPC */ - case UNION_DECL: /* New added for VPC */ - case STRUCT_DECL: /* New added for VPC */ - break; - case DERIVED_CLASS_DECL: /* Need More for VPC */ - case VAR_DECL: - break; - case EXPR_STMT_NODE: /* New added for VPC */ - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case DO_WHILE_NODE: /* New added for VPC */ - /* Need study */ - break; - case SWITCH_NODE: /* New added for VPC */ - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case CASE_NODE: /* New added for VPC */ - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case DEFAULT_NODE: /* New added for VPC */ - break; - case BASIC_BLOCK: - break; - case BREAK_NODE: /* New added for VPC */ - break; - case CONTINUE_NODE: /* New added for VPC */ - break; - case RETURN_NODE: /* New added for VPC */ - ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case ASM_NODE: /* New added for VPC */ - break; /* Need More */ - case SPAWN_NODE: /* New added for CC++ */ - break; - case PARFOR_NODE: /* New added for CC++ */ - ccheck_llnd(pbf->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case PAR_NODE: /* New added for CC++ */ - break; - default: - fprintf(stderr, "bad bfnd case\n"); - break; /* don't know what to do at this point */ - } -} - - -static void ccheck_llnd(pllnd, ref_list, mod_list, type) -PTR_LLND pllnd; -PTR_BLOB1 *ref_list, *mod_list; -int type; -{ - PTR_BLOB1 list_r, list_m; - - *ref_list = (PTR_BLOB1) NULL; - *mod_list = (PTR_BLOB1) NULL; - if (pllnd == NULL) - return; - - switch (pllnd->variant) { - case INT_VAL: - case STMT_STR: - case FLOAT_VAL: - case DOUBLE_VAL: - case STRING_VAL: - case BOOL_VAL: - case CHAR_VAL: - break; - case CONST_REF: - case ENUM_REF: - break; - case VAR_REF: - if (type == L_VALUE) { - *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - } - else { - *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - *mod_list = (PTR_BLOB1) NULL; - } - break; - case POINTST_OP: /* New added for VPC */ - case RECORD_REF: /* Need More */ - if (type == L_VALUE) { - *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - } - else { - *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - *mod_list = (PTR_BLOB1) NULL; - } - /* Need more */ - break; - case ARRAY_OP: - *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - if (type == L_VALUE) - *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - else - *mod_list = BLOB1_NULL; - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case ARRAY_REF: - *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - if (type == L_VALUE) - *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); - else - *mod_list = BLOB1_NULL; - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case CONSTRUCTOR_REF: - break; - case ACCESS_REF: - break; - case CONS: - break; - case ACCESS: - break; - case IOACCESS: - break; - case PROC_CALL: - case FUNC_CALL: - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case EXPR_LIST: - if (type == R_VALUE) { - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - } - else { - if (pllnd->entry.Template.ll_ptr2) { - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, L_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - } - else { - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE); - *ref_list = list_r; - *mod_list = list_m; - } - } - break; - case EQUI_LIST: - break; - case COMM_LIST: - break; - case VAR_LIST: - case CONTROL_LIST: - break; - case RANGE_LIST: - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case DDOT: - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case COPY_NODE: - break; - case VECTOR_CONST: /* NEW ADDED FOR VPC++ */ - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case INIT_LIST: - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case BIT_NUMBER: - break; - case DEF_CHOICE: - case SEQ: - break; - case SPEC_PAIR: - break; - case MOD_OP: - break; - - case ASSGN_OP: /* New added for VPC */ - case ARITH_ASSGN_OP: /* New added for VPC */ - case PLUS_ASSGN_OP: - case MINUS_ASSGN_OP: - case AND_ASSGN_OP: - case IOR_ASSGN_OP: - case MULT_ASSGN_OP: - case DIV_ASSGN_OP: - case MOD_ASSGN_OP: - case XOR_ASSGN_OP: - case LSHIFT_ASSGN_OP: - case RSHIFT_ASSGN_OP: - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case EQ_OP: - case LT_OP: - case GT_OP: - case NOTEQL_OP: - case LTEQL_OP: - case GTEQL_OP: - case ADD_OP: - case SUBT_OP: - case OR_OP: - case MULT_OP: - case DIV_OP: - case AND_OP: - case EXP_OP: - case LE_OP: /* New added for VPC *//* Duplicated */ - case GE_OP: /* New added for VPC *//* Duplicated */ - case NE_OP: /* New added for VPC *//* Duplicated */ - case BITAND_OP: /* New added for VPC */ - case BITOR_OP: /* New added for VPC */ - case LSHIFT_OP: /* New added for VPC */ - case RSHIFT_OP: /* New added for VPC */ - case NEW_OP: - case DELETE_OP: - case THIS_NODE: - case SCOPE_OP: - case INTEGER_DIV_OP: /* New added for VPC */ - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case ADDRESS_OP: /* New added for VPC */ - case SIZE_OP: /* New added for VPC */ - break; - case DEREF_OP: - break; - case SUB_OP: /* duplicated unary minus */ - case MINUS_OP: /* unary operations */ - case UNARY_ADD_OP: /* New added for VPC */ - case BIT_COMPLEMENT_OP: /* New added for VPC */ - case NOT_OP: - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - break; - case MINUSMINUS_OP: /* New added for VPC */ - case PLUSPLUS_OP: /* New added for VPC */ - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, L_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case STAR_RANGE: - break; - case CLASSINIT_OP: /* New added for VPC */ - break; - case CAST_OP: /* New added for VPC */ - break; - case FUNCTION_OP: - case EXPR_IF: /* New added for VPC */ - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case EXPR_IF_BODY: /* New added for VPC */ - ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); - *ref_list = list_r; - *mod_list = list_m; - ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); - *ref_list = chain_blob1(*ref_list, list_r); - *mod_list = chain_blob1(*mod_list, list_m); - break; - case FUNCTION_REF: /* New added for VPC */ - break; - case LABEL_REF: /* Fortran Version, For VPC we need more */ - break; - - default: - fprintf(stderr, "ccheck_llnd -- bad llnd ptr %d!\n", pllnd->variant); - break; - } -} - - -/* Very important routine to see a given bif node of a function is - * local-variable declaration or argument declaration - * return 1 ---TRUE - * 0 False - */ -int is_param_decl_interface(var_bf, functor) -PTR_BFND var_bf; -PTR_SYMB functor; -{ - PTR_LLND flow_ptr, lpr; - PTR_SYMB s; - - switch (var_bf->variant) { - case VAR_DECL: - case ENUM_DECL: - case CLASS_DECL: - case UNION_DECL: - case STRUCT_DECL: - case DERIVED_CLASS_DECL: - lpr = var_bf->entry.Template.ll_ptr1; - for (flow_ptr = lpr; flow_ptr; flow_ptr=flow_ptr->entry.Template.ll_ptr1) { - if ((flow_ptr->variant == VAR_REF) || - (flow_ptr->variant == ARRAY_REF) || - (flow_ptr->variant == FUNCTION_REF)) - break; - } - if (!flow_ptr) { - return 0; - } - - for (s = functor->entry.member_func.in_list; s;) { - if (flow_ptr->entry.Template.symbol == s) - return (1); - s = s->entry.var_decl.next_in; - } - return (0); - - default: - return (0); - } - -} - - -PTR_BLOB1 chain_blob1(b1, b2) -PTR_BLOB1 b1, b2; -{ - PTR_BLOB1 oldptr, temptr; - - if (!b1) - return (b2); - if (!b2) - return (b1); - for (oldptr = temptr = b1; temptr; temptr = temptr->next) - oldptr = temptr; - - oldptr->next = b2; - return (b1); -} - - -/* -------------------------------------------------------------------*/ -/* The following code for testing ccheck_bfnd and ccheck_llnd */ -void print_out(list, type) -PTR_BLOB1 list; -int type; -{ - PTR_BLOB1 b; - char *source_ptr; - - if (!list) - return; - if (type == R_VALUE) - fprintf(stderr, "------ reference ---------------------------------------------\n"); - else - fprintf(stderr, "------ modified ---------------------------------------------\n"); - for (b = list; b; b = b->next) { - source_ptr = (UnparseBfnd[cur_file->lang])(b->ref); - fprintf(stderr, "%s\n", source_ptr); - } - -} - -void test_mod_ref(pbf) -PTR_BFND pbf; -{ - PTR_BLOB b; - PTR_BLOB1 list_r, list_m; - - if (!pbf) - return; - ccheck_bfnd(pbf, &list_r, &list_m); - - if (is_i_code(pbf)) { - for (b = pbf->entry.Template.bl_ptr1; b; b = b->next) - test_mod_ref(b->ref); - for (b = pbf->entry.Template.bl_ptr2; b; b = b->next) - test_mod_ref(b->ref); - } - -} - -int is_i_code(pbf) -PTR_BFND pbf; -{ - switch (pbf->variant) { - case ENUM_DECL: - case STRUCT_DECL: - case UNION_DECL: - return (0); - default: - return (1); - } -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ndeps.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ndeps.c deleted file mode 100644 index 8bf3201..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/ndeps.c +++ /dev/null @@ -1,1076 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - -#include -#include -#include "db.h" - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -static PTR_BFND current_par_loop = NULL; -static char *depstrs[] = { "flow","anti","output","huh??","got me?"}; -static char *dirstrs[] = { " ", "= ", "- ", "0-", "+ ", "0+", ". ", "+-"}; -extern PCF UnparseBfnd[]; -extern PCF UnparseLlnd[]; - -extern PTR_FILE cur_file; - -/* Forward definitions */ -static PTR_BLOB1 Nsearch_deps(); -static void subtract_list(); -static int same_loop(); -void search_and_replace_call(); - -extern void normal_form(); -extern int identical(); - -PTR_LLND search_call(ll, s) -PTR_LLND ll; -PTR_SYMB *s; -{ - PTR_LLND t; - *s = NULL; - if(ll == NULL) return(NULL); - if(ll->variant == FUNC_CALL){ - *s = ll->entry.Template.symbol; - return(ll->entry.Template.ll_ptr1); - } - else{ - t = search_call(ll->entry.Template.ll_ptr1,s); - if(t != NULL) return(t); - return(search_call(ll->entry.Template.ll_ptr2,s)); - } -} - -PTR_REFL build_refl(b,s) -PTR_BFND b; -PTR_LLND s; -{ - PTR_REFL p,h,l,alloc_ref(); - h = NULL; l = NULL; - while(s!= NULL){ - p = alloc_ref(b,s->entry.Template.ll_ptr1); - if(p != NULL){ - if(h == NULL){ h = p;} - if(l != NULL) l->next = p; - l = p; - } - s = s->entry.Template.ll_ptr2; - } - return(h); -} - -/* find loop bounds takes a bif pointer b and addresses of */ -/* three other pointers low, hi, inc and computes loop bounds */ -/* and returns 1 if it succeds in finding these in terms of */ -/* constants, parameters and external varaibles and returns */ -/* 0 if it failed. */ -int find_loop_bounds(b,low,hi,inc) -PTR_BFND b; -PTR_LLND *low, *hi, *inc; -{return (0);} - -/* bind call site info will take a pointer to a call statement and */ -/* return a expression list of the used and modified sets in terms */ -/* of the actual parameters. */ -void bind_call_site_info(b, used, modified) -PTR_BFND b; -PTR_LLND *used, *modified; -{ - PTR_LLND funargs, formal_used, formal_modified; - PTR_SYMB fun, s,formal_args[50]; - PTR_BFND fun_bif; - /* PTR_BLOB bl; */ - PTR_LLND u, m, explst; - int i, num_formal_args; - PTR_LLND called_with[50]; - PTR_LLND copy_llnd(); - PTR_BFND find_fun_by_name(); - int fun_found ; - - *used = NULL; *modified = NULL; fun = NULL; fun_found = 0; - formal_used = NULL; formal_modified = NULL; - formal_args[0] = NULL; num_formal_args = 0;; - if(b == NULL) return; - if(b->variant == PROC_STAT){ - funargs = b->entry.Template.ll_ptr1; - fun = b->entry.Template.symbol; - } - else if(b->variant == ASSIGN_STAT){ - funargs = search_call(b->entry.Template.ll_ptr2,&fun); - } - else if(b->variant == EXPR_STMT_NODE){ - funargs = search_call(b->entry.Template.ll_ptr1,&fun); - } - /* if(fun != NULL) - fprintf(stderr, "funargs = %s\n", - (UnparseBfnd[cur_file->lang])(funargs)); */ - else { - fprintf(stderr, "serch_call error. node is %s", - (UnparseBfnd[cur_file->lang])(b)); - fprintf(stderr, "node type is %d\n",b->variant); - return; - } - if(fun == NULL) return; - if(funargs == NULL) return; - fun_bif = find_fun_by_name(fun->ident); /*no longer need loop search*/ - if(fun_bif == NULL){ - fprintf(stderr, "find fun_by_name failed %s\n",fun->ident); - return; - } - else if (strcmp(fun_bif->entry.Template.symbol->ident,fun->ident)){ - fprintf(stderr, "find fun by name returned wrong fun\n"); - return; - } - if(fun_bif->variant == PROC_HEDR || fun_bif->variant == FUNC_HEDR){ - if(!strcmp(fun_bif->entry.Template.symbol->ident,fun->ident)){ - fun_found = 1; - s = fun_bif->entry.Template.symbol; - s = s->entry.proc_decl.in_list; - while(s != NULL){ /* gather formal args in formal_args */ - formal_args[num_formal_args++] = s; - s = s->entry.var_decl.next_in; - } - explst = fun_bif->entry.Template.ll_ptr3; - if(explst == NULL) return; - if(explst->entry.Template.ll_ptr2 == NULL){ - /* only first pass analysis done */ - formal_used = explst->entry.Template.ll_ptr1; /* bif graph */ - } - else - formal_used = explst->entry.Template.ll_ptr2; - explst = fun_bif->entry.Template.ll_ptr2; - if(explst == NULL) return; - if(explst->entry.Template.ll_ptr2 == NULL){ - /* only first pass analysis done */ - formal_modified = explst->entry.Template.ll_ptr1; /* bif graph*/ - } - else - formal_modified = explst->entry.Template.ll_ptr2; - } - } - if(fun_found == 0){ - fprintf(stderr, "could not locate source for function %s\n",fun->ident); - return; - } - if(num_formal_args == 0) return; - u = copy_llnd(formal_used); - m = copy_llnd(formal_modified); - for(i = 0; i < num_formal_args; i++){ /* gather actual args in called_with*/ - if(funargs == NULL){ - printf("ERROR: function not called with enough arguments\n"); - exit(0); - } - called_with[i] = copy_llnd(funargs->entry.Template.ll_ptr1); - funargs = funargs->entry.Template.ll_ptr2; - } - search_and_replace_call(&u,num_formal_args,formal_args,called_with); - search_and_replace_call(&m,num_formal_args,formal_args,called_with); - *used = u; - *modified = m; - /* - fprintf(stderr, "formal_used are:\n"); - fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](formal_used)); - fprintf(stderr, "actual used are:\n"); - fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](u)); - fprintf(stderr, "formal_modified are:\n"); - fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](formal_modified)); - fprintf(stderr, "actual modified are:\n"); - fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](m)); - fprintf(stderr, "called with:\n"); - for(i = 0; i < num_formal_args; i++) - fprintf(stderr, " %s,",UnparseLlnd[cur_file->lang](called_with[i])); - fprintf(stderr, "\n"); - if(formal_args[0] == NULL) return; - fprintf(stderr, "formal args are:\n"); - for(i = 0; i < num_formal_args; i++) - fprintf(stderr, " %s,",formal_args[i]->ident); - fprintf(stderr, "\n"); - */ -} - -int get_fargs_index(s,n,fargs) -PTR_SYMB s; -int n; -PTR_SYMB fargs[]; -{ - int i; - for(i = 0; i < n; i++) - if(fargs[i] == s) return(i); - return(-1); -} - -void add_offset(offset,term) -PTR_LLND offset, *term; -{ - PTR_LLND p,q,r, make_llnd(), copy_llnd(); - if(offset == NULL){ - fprintf(stderr, "bad offset in add_offset\n"); - return; - } - if(term == NULL){ - fprintf(stderr, "badd term in add_offset\n"); - return; - } - if(*term == NULL){ - fprintf(stderr, " null term in add_offset\n"); - } - if(*term == NULL || ( - offset->variant == DDOT && *term != NULL && (*term)->variant == DDOT)){ - q = make_llnd(cur_file, STAR_RANGE,NULL,NULL,NULL); - *term = q; - } - else if((*term)->variant == STAR_RANGE){ - /* term is of the form x[:] and no offset will help */ - } - else if(offset->variant == STAR_RANGE){ /* MANNHO add 9/10 */ - *term = offset; - } - else if((*term)->variant == DDOT){ - PTR_LLND offset1, offset2; - offset1 = copy_llnd(offset); - p = (*term)->entry.Template.ll_ptr1; - q = make_llnd(cur_file, ADD_OP,p,offset1,NULL); - /* MANNHO delete - if(cur_file->lang == ForSrc){ - p = make_llnd(cur_file, INT_VAL,NULL,NULL,NULL); - p->entry.ival = 1; - q = make_llnd(cur_file, SUBT_OP,q,p,NULL); - } - */ - normal_form(&q); /* normal_form(&q); */ - (*term)->entry.Template.ll_ptr1 = q; - p = (*term)->entry.Template.ll_ptr2; - offset2 = copy_llnd(offset); - q = make_llnd(cur_file, ADD_OP,p,offset2,NULL); - /* MANNHO delete - if(cur_file->lang == ForSrc){ - p = make_llnd(cur_file, INT_VAL,NULL,NULL,NULL); - p->entry.ival = 1; - q = make_llnd(cur_file, SUBT_OP,q,p,NULL); - } - */ - /* normal_form(&q); */ - normal_form(&q); - (*term)->entry.Template.ll_ptr2 = q; - } - else if(offset->variant == DDOT){ - r = copy_llnd(*term); - offset = copy_llnd(offset); - p = offset->entry.Template.ll_ptr1; - q = make_llnd(cur_file, ADD_OP,p,r,NULL); - offset->entry.Template.ll_ptr1 = q; - p = offset->entry.Template.ll_ptr2; - q = make_llnd(cur_file, ADD_OP,p,r,NULL); - offset->entry.Template.ll_ptr2 = q; - *term = offset; - } - else{ - offset = copy_llnd(offset); - q = make_llnd(cur_file, ADD_OP,*term,offset,NULL); - *term = q; - } -} - -PTR_LLND get_array_dim_decl(AR) /* MANNHO add */ - PTR_LLND AR; /* ARRAY_REF */ -{ - PTR_LLND RL, R_L = NULL, ll0, ll1; - PTR_TYPE TY; - PTR_LLND copy_llnd(), make_llnd(); - - TY = AR->entry.Template.symbol->type; - switch (TY->variant) { - case T_ARRAY : /* MANNHO mod */ - R_L = TY->entry.ar_decl.ranges; - if (R_L->variant != EXPR_LIST) R_L = R_L->entry.Template.ll_ptr1; - break; - case T_POINTER : - R_L = NULL; - break; - } - - if (R_L == NULL) return(NULL); - - RL = R_L = copy_llnd(R_L); - while (RL) { - ll1 = RL->entry.Template.ll_ptr1; - if (ll1->variant != DDOT) { - if (cur_file->lang == ForSrc) - ll0 = make_llnd(cur_file, INT_VAL, NULL, NULL, 1); - else - ll0 = make_llnd(cur_file, INT_VAL, NULL, NULL, 0); - RL->entry.Template.ll_ptr1 = make_llnd(cur_file, DDOT, ll0, ll1, NULL); - } - RL = RL->entry.Template.ll_ptr2; - } - return (R_L); -} - -/* u is a reference to an expression describing the result of an action */ -/* by a call to the function. fargs is the associated set of formal */ -/* formal parameters. call is the actual values passed to the formal */ -/* parameter. search_and_replace modifies u so that it reflects the */ -/* the action in terms of the actual parameters. */ -void search_and_replace_call(u,n,fargs,call) -PTR_LLND *u; -int n; -PTR_SYMB fargs[]; -PTR_LLND call[]; -{ - int i; - PTR_LLND v,index,a,b, b1, b2; - PTR_LLND make_llnd(), copy_llnd(), linearize_array_range(); - PTR_LLND get_array_dim_decl(); - - if (*u == NULL) return ; - /* *u is the result of the call in terms of the formal params */ - switch((*u)->variant){ - case VAR_REF: - /* find the position of *u in the parameter list */ - i = get_fargs_index((*u)->entry.Template.symbol,n,fargs); - if (i<0) return ; - if(call[i]->variant == ADDRESS_OP) v = call[i]->entry.Template.ll_ptr1; - else v = call[i]; - *u = copy_llnd(v); - break; - case ARRAY_REF: - i = get_fargs_index((*u)->entry.Template.symbol,n,fargs); - if(i < 0) return ; - v = call[i]; /* v is the expression that is passed in position i */ - if(v->variant == VAR_REF){ - (*u)->entry.Template.symbol = v->entry.Template.symbol; - search_and_replace_call(&((*u)->entry.Template.ll_ptr1), - n,fargs,call); - search_and_replace_call(&((*u)->entry.Template.ll_ptr2), - n,fargs,call); - } - else if(cur_file->lang != ForSrc && v->variant == ARRAY_REF){ - /* if v has dim 1 greater than *u */ - index = (*u)->entry.Template.ll_ptr1; - (*u)->entry.Template.symbol = v->entry.Template.symbol; - search_and_replace_call(&index,n,fargs,call); - index = v->entry.Template.ll_ptr1; - while(index->entry.Template.ll_ptr2 != NULL) - index = index->entry.Template.ll_ptr2; - index->entry.Template.ll_ptr2 = (*u)->entry.Template.ll_ptr1; - (*u)->entry.Template.ll_ptr1 = v->entry.Template.ll_ptr1; - } - else if(v->variant == ADDRESS_OP){ - /* something like &(x[i]) */ - a = v->entry.Template.ll_ptr1; /* the x[i] part */ - if(a->variant == EXPR_LIST) a = a->entry.Template.ll_ptr1; - (*u)->entry.Template.symbol=a->entry.Template.symbol; - if(a->variant == VAR_REF ){ - search_and_replace_call(&((*u)->entry.Template.ll_ptr1), - n,fargs,call); - } - else if(a->variant == ARRAY_REF){ - PTR_LLND second_index; - /* we are adding the offset from &(x[i]) to y[10:2] */ - /* u is a *pointer to the summary data and a is a pointer to */ - /* the actual argument. make u look like a */ - search_and_replace_call(&((*u)->entry.Template.ll_ptr1), - n,fargs,call); - b = (*u)->entry.Template.ll_ptr1; /* range list */ - index = a->entry.Template.ll_ptr1; /*range list */ - if(index != NULL) second_index = index->entry.Template.ll_ptr2; - else second_index = NULL; - if(index == NULL){ - } - else if(b == NULL){ - (*u)->entry.Template.ll_ptr1 = copy_llnd(index); - } - else { - b1 = b->entry.Template.ll_ptr1; - b2 = b->entry.Template.ll_ptr2; - b->entry.Template.ll_ptr1 = - copy_llnd(index->entry.Template.ll_ptr1); - b->entry.Template.ll_ptr2 = copy_llnd(second_index); - while (b->entry.Template.ll_ptr2 != NULL) - b = b->entry.Template.ll_ptr2; - add_offset(b1, &(b->entry.Template.ll_ptr1)); - b->entry.Template.ll_ptr2 = b2; - } - } - else fprintf(stderr, "a variant is %d\n",a->variant); - } - else if (cur_file->lang == ForSrc && v->variant == ARRAY_REF) { - /* u is a *pointer to a copy of the summary data and v points to */ - /* the passed argument. make u look like v. */ - int udim, adim; - a = v; - if(a->variant == EXPR_LIST) a = a->entry.Template.ll_ptr1; - if(a->variant == VAR_REF ){ - (*u)->entry.Template.symbol=a->entry.Template.symbol; - /* u now has the symbol of v, now do the substitution on the subscripts */ - search_and_replace_call(&((*u)->entry.Template.ll_ptr1), - n,fargs,call); - } - else if(a->variant == ARRAY_REF){ - PTR_LLND size,ls,rs,adec; - /* we are adding the offset from &(a[i]) to u[10:2] */ - /* u is a *pointer to the summary data and a is a pointer to */ - /* the actual argument. make u look like a. first fix the index */ - /* terms in u */ - search_and_replace_call(&((*u)->entry.Template.ll_ptr1), - n,fargs,call); - /* next get the dimensions of these array references. */ - /* let b be the index expression range list for *u. */ - udim = (*u)->entry.Template.symbol->type->entry.ar_decl.num_dimensions; - adim = a->entry.Template.symbol->type->entry.ar_decl.num_dimensions; - size = get_array_dim_decl(*u); /* MANNHO mod */ - adec = get_array_dim_decl(a); - if(adec->variant == EXPR_LIST || adec->variant == RANGE_LIST) adec = adec->entry.Template.ll_ptr1; - - search_and_replace_call(&size,n,fargs,call); - (*u)->entry.Template.symbol=a->entry.Template.symbol; - /* we now must linearize the segments described by *u and */ - /* then add the offset provided by a */ - b = (*u)->entry.Template.ll_ptr1; /* range list */ - index = a->entry.Template.ll_ptr1; /*range list */ - if(index == NULL && udim == adim){ - /* *u already has the correct form */ - } - else if(index == NULL && adim < udim){ - /* if adim = 1 and udim is bigger */ - b = linearize_array_range(b,udim,size); - ls = b->entry.Template.ll_ptr1->entry.Template.ll_ptr1; - rs = b->entry.Template.ll_ptr1->entry.Template.ll_ptr2; - add_offset(adec->entry.Template.ll_ptr1, - &(b->entry.Template.ll_ptr1)); - b->entry.Template.ll_ptr2 = NULL; - /* fprintf(stderr," %s ",UnparseLlnd[cur_file->lang](b)); */ - } - else if(b == NULL){ - (*u)->entry.Template.ll_ptr1 = copy_llnd(index); - } - else if(index == NULL && adim > udim){ - int ii; - PTR_LLND c; - c = make_llnd(cur_file, INT_VAL,NULL,NULL,NULL); - c->entry.ival = 1; - for(ii = 0; ii < (adim-udim); ii++){ - b->entry.Template.ll_ptr2 = - make_llnd(cur_file, EXPR_LIST,copy_llnd(c),NULL,NULL); - b = b->entry.Template.ll_ptr2; - } - b->entry.Template.ll_ptr2 = NULL; - } - else { - b = linearize_array_range(b,udim,size); - add_offset(index->entry.Template.ll_ptr1, - &(b->entry.Template.ll_ptr1)); - if(index->entry.Template.ll_ptr2 == NULL) b->entry.Template.ll_ptr2 = NULL; - else{ - if(index->entry.Template.ll_ptr2 !=NULL && - index->entry.Template.ll_ptr2->variant != EXPR_LIST) - b->entry.Template.ll_ptr2 = - make_llnd(cur_file, EXPR_LIST,index->entry.Template.ll_ptr2,NULL,NULL); - else b->entry.Template.ll_ptr2 = index->entry.Template.ll_ptr2; - } - - } - } - else fprintf(stderr, "a variant is %d\n",a->variant); - } - else{ /* something like p+3 for a pointer p */ - fprintf(stderr, "a strange pointer case in ser. and repl.\n"); - } - break; - default: /* an expression */ - search_and_replace_call(&((*u)->entry.Template.ll_ptr1), - n,fargs,call); - search_and_replace_call(&((*u)->entry.Template.ll_ptr2), - n,fargs,call);; - } -} - -/* MANNHO delete whole this procedure -PTR_LLND get_leading_arr_dim(s) -PTR_SYMB s; -{ - PTR_LLND x, copy_llnd(); - x = s->type->entry.ar_decl.ranges; - if(x->variant == ARRAY_REF) x = x->entry.Template.ll_ptr1; - if(x->variant == EXPR_LIST) x = x->entry.Template.ll_ptr1; - return(copy_llnd(x)); -} -*/ - -void make_zero_base(ref, decl) /* MANNHO add */ -PTR_LLND ref, decl; -{ - PTR_LLND ref_index, ref_low, ref_up, decl_low, dlow; - PTR_LLND make_llnd(), copy_llnd(); - - while (ref) { - ref_index = ref->entry.Template.ll_ptr1; - decl_low =decl->entry.Template.ll_ptr1->entry.Template.ll_ptr1; - - if (ref_index->variant == DDOT) { - ref_low = ref_index->entry.Template.ll_ptr1; - ref_up = ref_index->entry.Template.ll_ptr2; - if(ref_low != NULL && decl_low != NULL){ - dlow = copy_llnd(decl_low); - ref_low = make_llnd(cur_file, SUBT_OP, ref_low, dlow, NULL); - } - if(ref_up != NULL && decl_low != NULL){ - dlow = copy_llnd(decl_low); - ref_up = make_llnd(cur_file, SUBT_OP, ref_up, dlow, NULL); - } - ref_index->entry.Template.ll_ptr1 = ref_low; - ref_index->entry.Template.ll_ptr2 = ref_up; - } - else if(decl_low != NULL && ref_index->variant != STAR_RANGE){ - dlow = copy_llnd(decl_low); - ref_index = make_llnd(cur_file, SUBT_OP, ref_index, dlow, NULL); - ref->entry.Template.ll_ptr1 = ref_index; - } - - ref = ref->entry.Template.ll_ptr2; - decl = decl->entry.Template.ll_ptr2; - } -} - -/* linearize_array_range takes a range list and returns a range */ -/* list consiting of a 1-D ddot discription of the range */ -PTR_LLND linearize_array_range(rl,dim,size) /* MANNHO mod */ -PTR_LLND rl; /* a range list of expressions and ddots */ -int dim; -PTR_LLND size; /* size is the declared dimension of the parameter */ -{ - PTR_LLND RL, sz1, s; - PTR_LLND size_upto, size_up, addend, low, up, one; - PTR_LLND index, index_low, index_up; - int shift_needed; - PTR_LLND make_llnd(), copy_llnd(); - - make_zero_base(rl, size); - s = size; shift_needed = 0; - while(s != NULL){ - sz1 = s->entry.Template.ll_ptr1; - if(sz1->entry.Template.ll_ptr1 != NULL && - (( sz1->entry.Template.ll_ptr1->variant != CONST_REF && - sz1->entry.Template.ll_ptr1->variant != INT_VAL) || - sz1->entry.Template.ll_ptr1->entry.ival != 1)){ - printf(" ival is %d\n",sz1->entry.Template.ll_ptr1->entry.ival); - shift_needed = 1; - } - s = s->entry.Template.ll_ptr2; - } - s = copy_llnd(size); - make_zero_base(size, s); - if(shift_needed) s = copy_llnd(size); - /* - fprintf(stderr, " rl = %s",UnparseLlnd[cur_file->lang](rl)); - fprintf(stderr, " size = %s",UnparseLlnd[cur_file->lang](size)); - */ - size_upto = NULL; low = NULL; up = NULL; - RL = rl; - while (RL) { - index = RL->entry.Template.ll_ptr1; - sz1 = size->entry.Template.ll_ptr1; - if (index->variant == DDOT) { - index_low = index->entry.Template.ll_ptr1; - index_up = index->entry.Template.ll_ptr2; - } else { - index_low = index; - index_up = copy_llnd(index); - } - if(index->variant == STAR_RANGE){ - index->variant = DDOT; - index_low = sz1->entry.Template.ll_ptr1; - index_up = sz1->entry.Template.ll_ptr2; - } - if (low == NULL) { /* 1st index */ - low = index_low; - up = index_up; - } - else { - if(low != NULL && size_upto != NULL){ - addend = make_llnd(cur_file, MULT_OP, copy_llnd(size_upto), - index_low, NULL); - low = make_llnd(cur_file, ADD_OP, low, addend, NULL); - } - if(up != NULL && size_upto != NULL){ - addend = make_llnd(cur_file, MULT_OP, copy_llnd(size_upto), - index_up, NULL); - up = make_llnd(cur_file, ADD_OP, up, addend, NULL); - } - } - size_up = s->entry.Template.ll_ptr1->entry.Template.ll_ptr2; - if(shift_needed){ - one = make_llnd(cur_file, INT_VAL, NULL, NULL, 1); - size_up = make_llnd(cur_file, ADD_OP, size_up, one, NULL); - } - size_upto = (size_upto == NULL) ? - size_up : - make_llnd(cur_file, MULT_OP, size_upto, size_up, NULL); - size = size->entry.Template.ll_ptr2; - s = s->entry.Template.ll_ptr2; - RL = RL->entry.Template.ll_ptr2; - } - if (low == NULL && up == NULL){ - RL = make_llnd(cur_file,STAR_RANGE,NULL, NULL, NULL); - } - else if (identical(low, up)) { - RL = low; - /* free_ll_tree(up); */ - } else { - RL = make_llnd(cur_file, DDOT, low, up, NULL); - } - rl->entry.Template.ll_ptr1 = RL; - rl->entry.Template.ll_ptr2 = NULL; - return(rl); -} - -PTR_BLOB1 - NGetCallInfo(filename,line) -char *filename; -int line; -{ - PTR_BLOB1 lb, nb,tb; - PTR_BFND b, FindBifNode(); - char *s; - PTR_LLND used, modified; - - used = NULL; modified = NULL; - b = FindBifNode(filename,line); - if(b == NULL){ - nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,nb, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"Could not find code at line %d\n",line); - nb->ref = s; - nb->next = NULL; - return(nb); - } - if(b->variant != PROC_STAT && b->variant != EXPR_STMT_NODE){ - nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,nb, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"Cound not find call at line %d\n",line); - nb->ref = s; - nb->next = NULL; - return(nb); - } - bind_call_site_info(b,&used,&modified); - if(used == NULL){ - tb = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,tb, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"nothing used in call. \n"); - nb->ref = s; - nb->next = NULL; - lb = nb; - } - else{ - tb = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,tb, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"variables used in call are: \n"); - nb->ref = s; - tb->next = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,tb->next, 0); -#endif - s = (UnparseLlnd[cur_file->lang])(used); - nb->ref = s; - nb->next = NULL; - lb = nb; - } - if(modified == NULL){ - lb->next = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,lb->next, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"nothing modified by call. \n"); - nb->ref = s; - nb->next = NULL; - return(tb); - } - else{ - lb->next = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,lb->next, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"variables modified in call are: \n"); - nb->ref = s; - nb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,nb->next, 0); -#endif - nb = nb->next; - s = (UnparseLlnd[cur_file->lang])(modified); - nb->ref = s; - nb->next = NULL; - return(tb); - } -} - - - -PTR_BLOB1 - NGetDepInfo(filename, line) -char *filename; -int line; -{ - PTR_BFND b,bpar; - PTR_DEP d; - int depth; - char * s; - PTR_BLOB1 nb, lb, btmp; - - PTR_BLOB q; - PTR_SYMB induct_list[100], local_list[100], rename_list[100]; - int induct_num, local_num, rename_num; - /* PTR_LLND used, modified; */ - PTR_BFND FindBifNode(); - int i; - - induct_num = 0; local_num = 0; rename_num = 0; - b = FindBifNode(filename,line); - /* bind_call_site_info(b,&used,&modified);*/ - if(b == NULL){ - nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,nb, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"Could not find code at line %d\n",line); - nb->ref = s; - nb->next = NULL; - return(nb); - } - /* if b is a loop, we look for all loop carried deps for */ - /* this loop. otherwise just list dependence going out */ - if(b->variant == FOR_NODE || b->variant == WHILE_NODE){ - depth = 0; - bpar = b; - current_par_loop = b; - while(bpar != NULL && bpar->variant != GLOBAL){ - if(bpar->variant == FOR_NODE || - bpar->variant == CDOALL_NODE || - bpar->variant == WHILE_NODE || - bpar->variant == FORALL_NODE) depth++; - bpar = bpar->control_parent; - } - q = b->entry.Template.bl_ptr1; - nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,nb, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"Loop Carried Dependences Prohibiting Parallelism:\n"); - nb->ref = s; - nb->next = NULL; - nb = Nsearch_deps(nb,q,depth,induct_list, &induct_num, - local_list,&local_num, rename_list, &rename_num); - if (nb->next == NULL) - { - if (induct_num == 0 && local_num == 0 && rename_num == 0) - sprintf(nb->ref, "this loop is perfect! parallelize it.\n"); - else - sprintf(nb->ref, - "Loop is Parallelizable. First fix these problems.\n"); - } - for(lb = nb; lb->next != NULL; lb = lb->next); - if(induct_num > 0){ - btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); - lb->next = btmp; lb = btmp; - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"The following seem to be pseudo induction variables:\n"); - lb->ref = s; - lb->next = NULL; - for(i = 0; i < induct_num; i++){ - lb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,lb->next, 0); -#endif - lb = lb->next; - s = malloc(3+strlen(induct_list[i]->ident) ); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"%s\n",induct_list[i]->ident); - lb->next = NULL; - lb->ref = s; - } - subtract_list(induct_list,&induct_num,local_list,&local_num); - subtract_list(induct_list,&induct_num,rename_list,&rename_num); - } - if(local_num > 0){ - btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); -#endif - lb->next = btmp; lb = btmp; - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"Variables that should be made local to loop:\n"); - lb->ref = s; - lb->next = NULL; - for(i = 0; i < local_num; i++){ - lb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,lb->next, 0); -#endif - lb = lb->next; - s = malloc(3+strlen(local_list[i]->ident)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"%s\n",local_list[i]->ident); - lb->next = NULL; - lb->ref = s; - } - subtract_list(local_list, &local_num, rename_list, &rename_num); - } - if(rename_num > 0){ - btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); -#endif - lb->next = btmp; lb = btmp; - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"Variables that are reused in a funny way:\n"); - lb->ref = s; - lb->next = NULL; - for(i = 0; i < rename_num; i++){ - lb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,lb->next, 0); -#endif - lb = lb->next; - s = malloc(64); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"%s\n",rename_list[i]->ident); - lb->next = NULL; - lb->ref = s; - } - } - return(nb); - } /* if loop case */ - d = b->entry.Template.dep_ptr1; - nb = NULL; - btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); -#endif - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"variant of this node is %d\n",b->variant); - btmp->ref = s; - btmp->next = NULL; - nb = lb = btmp; - while(d != NULL){ - btmp = (PTR_BLOB1) malloc( sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); -#endif - if (nb == NULL){ nb = btmp; lb = btmp;} - else{ lb->next = btmp; lb = btmp;} - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s,"id:%s type:%s to line %d dir_vect =(%s,%s,%s)\n", - d->symbol->ident, depstrs[(int) (d->type)], - d->to.stmt->g_line, - dirstrs[(int) (d->direct[1])], dirstrs[(int) (d->direct[2])], - dirstrs[(int) (d->direct[3])]); - btmp->ref = s; - btmp->next = NULL; - d = d->from_fwd; - } - return(nb); -} - -static void subtract_list(a,na, b, nb) -PTR_SYMB a[], b[]; -int *na, *nb; -{ - int i, j; - for(i = 0; i < *na; i++){ - for(j = 0; j < *nb; j++){ - if(a[i] == b[j]){ - if(j < *nb-1) b[j] = b[*nb -1]; - (*nb)--; - } - } - } -} - -int pointer_as_array(d) -PTR_DEP d; -{ - /* - if(d->from.refer == NULL) fprintf(stderr, "no from llnode\n"); - if(d->to.refer == NULL) fprintf(stderr, "no to llnode\n"); - fprintf(stderr, " from <%s to <%s\n", - unparse_llnd(d->from.refer), unparse_llnd(d->to.refer)); - */ - if (d->to.refer->variant == ARRAY_REF || d->from.refer->variant==ARRAY_REF) - return 1; - else return 0; -} - -static PTR_BLOB1 - Nsearch_deps(nb,q,depth,induct_list, induct_num, - local_list,local_num,rename_list,rename_num) -PTR_BLOB1 nb; -PTR_BLOB q; -int depth; -PTR_SYMB induct_list[], local_list[], rename_list[]; -int *induct_num, *local_num, *rename_num; -{ - PTR_BFND bchild; - PTR_DEP d; - char *s; - PTR_BLOB1 lb = NULL, btmp; - int i,found; - PTR_LLND from_list[500]; - int from_line[500], to_line[500]; - int from_num; - - if(nb != NULL) lb = nb; - from_num = 0; - while(q != NULL){ - bchild = q->ref; - q = q->next; - d = bchild->entry.Template.dep_ptr1; - while(d != NULL){ - /* if the dependence is a carried array dependence (on a array type */ - /* or used as an array (fix)) or it is a flow dependence that is */ - /* caried then classify appropriately. */ - if (((d->symbol->type->variant == T_ARRAY || pointer_as_array(d)) && - d->direct[depth] >1) || (d->type == 0 && d->direct[depth] >1)){ - /* this is a loop carried flow dependence */ - if(d->from.stmt == d->to.stmt && - (d->symbol->type->variant == T_INT || - (pointer_as_array(d) == 0 && - d->symbol->type->variant == T_POINTER) )){ - for(i = 0, found = 0; i < *induct_num; i++) - if( induct_list[i] == d->symbol) found = 1; - if(found == 0) induct_list[(*induct_num)++] = d->symbol; - } - else if(same_loop(d->from.stmt,d->to.stmt)){ - found = 0; - for(i = 0; i < from_num; i++) - if(d->from.refer == from_list[i] && d->from.stmt->g_line == from_line[i] - && d->to.stmt->g_line == to_line[i]) found = 1; - if(found == 0){ - btmp = (PTR_BLOB1) malloc( sizeof(struct blob1)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,btmp, 0); -#endif - if (nb == NULL){ nb = btmp; lb = btmp;} - else{ lb->next = btmp; lb = btmp;} - s = malloc(256); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - sprintf(s, "an assignment to %s at line %d used in line %d in another iteration\n", - (UnparseLlnd[cur_file->lang])(d->from.refer), - d->from.stmt->g_line, d->to.stmt->g_line); - btmp->ref = s; - btmp->next = NULL; - from_list[from_num] = d->from.refer; - from_line[from_num] = d->from.stmt->g_line; - to_line[from_num++] = d->to.stmt->g_line; - } - } - } - else if(d->symbol->type->variant != T_ARRAY && d->type != 0 && - d->direct[depth] > 1 && same_loop(d->from.stmt,d->to.stmt)){ - /* this is a loop caried output or anti dep */ - /* add symbol to list for suggestion for localization */ - for(i = 0, found = 0; i < *local_num; i++) - if( local_list[i] == d->symbol) found = 1; - if(found == 0) local_list[(*local_num)++] = d->symbol; - } - else if(d->type == 2 && d->direct[depth] <= 1 && - same_loop(d->from.stmt,d->to.stmt)){ - /* this is an output dependence of distance 0 */ - /* suggest renaming. */ - for(i = 0, found = 0; i < *rename_num; i++) - if( rename_list[i] == d->symbol) found = 1; - if(found == 0) rename_list[(*rename_num)++] = d->symbol; - } - d = d->from_fwd; - } - if(bchild->entry.Template.bl_ptr1 != NULL){ - nb = Nsearch_deps(nb,bchild->entry.Template.bl_ptr1,depth,induct_list, - induct_num, local_list, - local_num, rename_list, rename_num); - lb = nb; while(lb != NULL && lb->next != NULL) lb = lb->next; - } - if(bchild->entry.Template.bl_ptr2 != NULL){ - nb = Nsearch_deps(nb,bchild->entry.Template.bl_ptr2,depth,induct_list, - induct_num, local_list, - local_num, rename_list, rename_num); - lb = nb; while(lb != NULL && lb->next != NULL) lb = lb->next; - } - } - return(nb); -} - -static int same_loop(from, to) -PTR_BFND from, to; -{ - PTR_BFND c; - c = from; - while(c != NULL && c->variant != GLOBAL && c != current_par_loop) - c = c->control_parent; - if(c != current_par_loop) return(0); - c = to; - while(c != NULL && c->variant != GLOBAL && c != current_par_loop) - c = c->control_parent; - if(c != current_par_loop) return(0); - return(1); -} - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/readnodes.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/readnodes.c deleted file mode 100644 index 9a3f49d..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/readnodes.c +++ /dev/null @@ -1,1124 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/*------------------------------------------------------* - * * - * Routines to read in BIF graph * - * * - *------------------------------------------------------*/ - -#include -#include -#ifdef SYS5 -#include -#else -#include -#endif - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -/*typedef unsigned int u_short;*/ -#include "db.h" -#include "dep_str.h" -/*extern int strncmp(); */ -#define NULL_CHECK(BASE,VALUE) ((VALUE) ? (BASE + (VALUE-1)): 0) - -/* - * External variables/functions referenced - */ -extern int debug; - -int language; /* type of language of this dep file */ - -/* - * Local variables - */ -static struct locs floc; /* used to read in preamble "floc" */ -static struct preamble head; /* used to read in preamble "head" */ -static struct bf_nd bf; /* used to read in bif nodes */ -static struct ll_nd ll; /* used to read in ll nodes */ -static struct sym_nd sym; /* used to read in symbol nodes */ -static struct typ_nd typ; /* used to read in type nodes */ -static struct lab_nd lab; /* used to read in label nodes */ -static struct fil_nd fil; /* used to read in file nodes */ -static struct cmt_nd cmt; /* used to read in comment nodes */ -static struct dep_nd dpd; /* used to read in dep nodes */ - -static PTR_BLOB head_blob, cur_blob; -static PTR_BFND head_bfnd, cur_bfnd; -static PTR_LLND head_llnd, cur_llnd; -static PTR_SYMB head_symb, cur_symb; -static PTR_TYPE head_type, cur_type; -static PTR_DEP head_dep, cur_dep; -static PTR_LABEL head_lab, cur_lab; -static PTR_FNAME head_file; -static PTR_CMNT head_cmnt, cur_cmnt; -static PTR_BFND global_bfnd; - -static char **strtbl; /* starting address of string table */ -static u_shrt tmp[10000]; /* temp working area */ -static FILE *fd; /* local copy of file id for the dep file */ -static PTR_FILE lfi; -static int need_swap = 0; /* set to 1 if we need to swap bytes */ - -void swab(); -/******************************************************** - * swap_w * - * * - * Swap bytes of one word (2 bytes) * - ********************************************************/ -static void -swap_w(p) - char *p; -{ - char c; - - c = *(p+1); - *(p+1) = *p; - *p = c; -} - - -/******************************************************** - * swap_i * - * * - * Swap bytes of an integer (4 bytes) * - ********************************************************/ -static void -swap_i(p) - char *p; -{ - char c; - - c = *(p+3); /* swap the 1st and 4th bytes */ - *(p+3) = *p; - *p++ = c; - c = *p; /* swap the 2nd and 3rd bytes */ - *p = *(p+1); - *(p+1) = c; -} - - -/******************************************************** - * swap_l (phb) * - * * - * Swap bytes of an 64bit long (8 bytes) * - ********************************************************/ -/* UNDER CONSTRUCTION, FIXME */ -/*static void -swap_l(p) - char *p; -{ - char c; - c = *(p+3); // swap the 1st and 4th bytes - *(p+3) = *p; - *p++ = c; - c = *p; // swap the 2nd and 3rd bytes - *p = *(p+1); - *(p+1) = c; -}*/ - - -/*------------------------------------------------------* - * read_str_tbl * - * * - * Read in the string table in dep file * - *------------------------------------------------------*/ -static int -read_str_tbl() -{ - int i, n, sz; - u_shrt u; - char *s; - char **cp; - - /* - * Fast forward to where the string table starts - */ - if (fseek(fd, floc.strs, 0) < 0) - return -1; - - /* - * The first word is the total number of strings in the dep file - */ - - /* get size of string table */ - if ((int)fread( (char *) &u, sizeof(u_shrt), 1, fd) < 0) - return -1; - - if (need_swap) - swap_w((char *)&u); - sz = (int) u; - if ((cp = strtbl = (char **)malloc(sz * sizeof(char *))) == NULL) - { - fprintf(stderr, "read_str_tbl: No more space\n"); - exit(1); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,cp, 0); -#endif - - /* - * Then followed by strings in the form of - * ------------------------- - * | str length | contents | - * ------------------------- - */ - for (i = 0; i < sz; i++) { - /* get string length */ - if ((int)fread( (char *) &u, sizeof(u_shrt), 1, fd) < 0) - - return -1; - if (need_swap) - swap_w((char *)&u); - n = (int) u; - if ((s = malloc(n+1)) == NULL) - { - fprintf(stderr, "read_str_tbl: No more space\n"); - exit(1); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - if ((int)fread(s, sizeof(char), n, fd) < 0) /* now the content */ - return -1; - *(s+n) = '\0'; - *cp++ = s; - } - return 0; -} - - -/*--------------------------------------------------------------* - * read_preamble * - * Read in the preamble part of the dep file * - *--------------------------------------------------------------*/ -static int -read_preamble() -{ - int i; - char filemagic[10]; - - /* The first 8 bytes is the file magic (see /etc/magic) PHB */ - if ((int)fread(filemagic, sizeof(char), 8, fd) < 0) - return -1; - if (strncmp("sage.dep",filemagic,8) != 0) { - fprintf(stderr, "This is not a legal .dep file\n"); - return -2; - } - - /* First word (2 bytes) in the dep file is a pre-selected magic number */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (*tmp != D_MAGIC) { /* Is this a dep file? */ - need_swap = 1; /* No... */ - swap_w((char *)tmp); /* ... Maybe we need to swap bytes */ - if(*tmp != D_MAGIC) { /* Try again */ - fprintf(stderr, "Are you sure this is a legal dep file? %x\n",*tmp); - return -2; - } - } - - /* - * The second part is for double checking machanism. Here we have - * the starting locations (offsets) of low level nodes, symbol nodes, - * type nodes, label nodes, comment nodes, file nodes, dep nodes and - * string table (relative to the beginning of file). - */ - - /* Some more data */ - if ((int)fread( (char *) &floc, sizeof(struct locs), 1, fd) < 0) - return -1; - - if (need_swap) { - swap_i((char *)&floc.llnd); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.symb); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.type); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.labs); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.cmnt); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.file); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.deps); /* !! long !! 64bit? (phb) */ - swap_i((char *)&floc.strs); /* !! long !! 64bit? (phb) */ - } - - /* Reconstruct the string table first */ - if (read_str_tbl() < 0) - return -1; - - /* rewind back to the point after "locs" information (8 is filemagic) */ - if (fseek(fd, sizeof(u_shrt)+sizeof(struct locs)+8, 0) < 0) - return -1; - - /* - * Read in the second part of preamble. Here we have numbers of - * all nodes (bif, low level, etc.) for this dep file - */ - if ((int)fread( (char *) &head, sizeof(struct preamble), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&head, (char *)&head, sizeof(struct preamble)); - - language = lfi->lang = (int)head.language; - - if ((sizeof(void *) * 8) != (int) head.ptrsize) { - fprintf(stderr, "WARNING: .dep file created on a %d bit machine\n", - head.ptrsize); - return -2; - } - - lfi->num_blobs = (int) head.num_blobs; - lfi->num_bfnds = (int) head.num_bfnds; - lfi->num_llnds = (int) head.num_llnds; - lfi->num_symbs = (int) head.num_symbs; - lfi->num_types = (int) head.num_types; - lfi->num_label = (int) head.num_label; - lfi->num_dep = (int) head.num_dep; - lfi->num_cmnt = (int) head.num_cmnts; - lfi->num_files = (int) head.num_files; - - /* - * Now use those numbers to allocate all nodes for this dep file - */ - lfi->head_blob = head_blob = (PTR_BLOB)(lfi->num_blobs>0? calloc(lfi->num_blobs, sizeof(struct blob)): NULL); - lfi->head_bfnd = head_bfnd = (PTR_BFND)(lfi->num_bfnds>0? calloc(lfi->num_bfnds, sizeof(struct bfnd)): NULL); - lfi->head_llnd = head_llnd = (PTR_LLND)(lfi->num_llnds>0? calloc(lfi->num_llnds, sizeof(struct llnd)): NULL); - lfi->head_symb = head_symb = (PTR_SYMB)(lfi->num_symbs>0? calloc(lfi->num_symbs, sizeof(struct symb)): NULL); - lfi->head_type = head_type = (PTR_TYPE)(lfi->num_types>0? calloc(lfi->num_types, sizeof(struct data_type)): NULL); - lfi->head_dep = head_dep = (PTR_DEP)(lfi->num_dep >0 ? calloc(lfi->num_dep, sizeof(struct dep)) : NULL); - lfi->head_lab = head_lab = (PTR_LABEL)(lfi->num_label>0? calloc(lfi->num_label, sizeof(struct Label)): NULL); - lfi->head_cmnt = head_cmnt = (PTR_CMNT)(lfi->num_cmnt>0 ? calloc(lfi->num_cmnt, sizeof(struct cmnt)): NULL); - lfi->head_file = head_file = (PTR_FNAME)(lfi->num_files>0? calloc(lfi->num_files, sizeof(struct file_name)): NULL); - -#ifdef __SPF - if (lfi->head_blob) addToCollection(__LINE__, __FILE__,lfi->head_blob, 0); - if (lfi->head_bfnd) addToCollection(__LINE__, __FILE__,lfi->head_bfnd, 0); - if (lfi->head_llnd) addToCollection(__LINE__, __FILE__,lfi->head_llnd, 0); - if (lfi->head_symb) addToCollection(__LINE__, __FILE__,lfi->head_symb, 0); - if (lfi->head_type) addToCollection(__LINE__, __FILE__,lfi->head_type, 0); - if (lfi->head_dep) addToCollection(__LINE__, __FILE__,lfi->head_dep, 0); - if (lfi->head_lab) addToCollection(__LINE__, __FILE__,lfi->head_lab, 0); - if (lfi->head_cmnt) addToCollection(__LINE__, __FILE__,lfi->head_cmnt, 0); - if (lfi->head_file) addToCollection(__LINE__, __FILE__,lfi->head_file, 0); -#endif - - lfi->global_bfnd = global_bfnd = head_bfnd + ((int)head.global_bfnd - 1); - - cur_blob = head_blob; - cur_bfnd = lfi->num_bfnds>0 ? head_bfnd + (lfi->num_bfnds - 1) : NULL; - cur_llnd = lfi->num_llnds>0 ? head_llnd + (lfi->num_llnds - 1) : NULL; - cur_symb = lfi->num_symbs>0 ? head_symb + (lfi->num_symbs - 1) : NULL; - cur_type = lfi->num_types>0 ? head_type + (lfi->num_types - 1) : NULL; - cur_dep = lfi->num_dep >0 ? head_dep + (lfi->num_dep - 1) : NULL; - cur_lab = lfi->num_label>0 ? head_lab + (lfi->num_label - 1) : NULL; - cur_cmnt = lfi->num_cmnt >0 ? head_cmnt + (lfi->num_cmnt - 1) : NULL; - - for (i = 0; i < lfi->num_bfnds; i++) { - (head_bfnd + i)->id = i + 1; - (head_bfnd + i)->thread = head_bfnd + (i + 1); - } - if (lfi->num_bfnds > 0) /* the thread field of the last entry was... */ - cur_bfnd->thread = NULL; /* ...changed in the previous loop */ - - for (i = 0; i < lfi->num_llnds; i++) { - (head_llnd + i)->id = i + 1; - (head_llnd + i)->thread = head_llnd + (i + 1); - } - if (lfi->num_llnds > 0) - cur_llnd->thread = NULL; - - for (i = 0; i < lfi->num_symbs; i++) { - (head_symb + i)->id = i + 1; - (head_symb + i)->thread = head_symb + (i + 1); - } - if (lfi->num_symbs > 0) - cur_symb->thread = NULL; - - for (i = 0; i < lfi->num_types; i++) { - (head_type + i)->id = i + 1; - (head_type + i)->thread = head_type + (i + 1); - } - if (lfi->num_types > 0) - cur_type->thread = NULL; - - for (i = 0; i < lfi->num_files; i++){ - (head_file + i)->id = i + 1; - (head_file + i)->next = head_file + (i + 1); - } - if (lfi->num_files > 0) - (head_file+(lfi->num_files-1))->next = NULL; - - for (i = 0; i < lfi->num_dep; i++) { - (head_dep + i)->id = i + 1; - (head_dep + i)->thread = head_dep + (i + 1); - } - if (lfi->num_dep > 0) - cur_dep->thread = NULL; - - for (i = 0; i < lfi->num_label; i++) { - (head_lab + i)->id = i + 1; - (head_lab + i)->next = head_lab + (i + 1); - } - if (lfi->num_label > 0) - cur_lab->next = NULL; - - for (i = 0; i < lfi->num_cmnt; i++) { - (head_cmnt + i)->id = i + 1; - (head_cmnt + i)->thread = head_cmnt + (i + 1); - } - if (lfi->num_cmnt > 0) - cur_cmnt->thread = NULL; - return 0; -} - - -/*------------------------------------------------------* - * read_blob_nodes * - * * - * Reads in a blob list * - *------------------------------------------------------*/ -static PTR_BLOB -read_blob_nodes() -{ - int i, n; - PTR_BLOB head, blnd_ptr = NULL; - - /* read in the count */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) { - perror("read_blob_nodes:"); - return NULL; - } - if (need_swap) - swap_w((char *)tmp); - if (!(n = (int)(*tmp))) - return NULL; /* count = 0; empty list */ - - head = cur_blob; - - /* read in blob list */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), n, fd) < 0) { - perror("read_blob_nodes:"); - return NULL; - } - if (need_swap) - swab((char *)tmp, (char*)tmp, n*sizeof(u_shrt)); - - for (i = 0; i < n; i++) { /* re-contruct the blob nodes */ - blnd_ptr = cur_blob++; - blnd_ptr->next = cur_blob; - blnd_ptr->ref = head_bfnd + (tmp[i] - 1); - } - blnd_ptr->next = NULL; - - return head; -} - - -/*--------------------------------------------------------------* - * read_bif_nodes * - * * - * routines to read in bif nodes * - *--------------------------------------------------------------*/ -static int -read_bif_nodes() -{ - PTR_BFND bfnd_ptr; - int i; - - for (i = 0; i < lfi->num_bfnds; i++) { - /* read in a bif node */ - if ((int)fread( (char *) &bf, sizeof(struct bf_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&bf, (char *)&bf, sizeof(struct bf_nd)); - if (debug) - fprintf(stderr,"Processing bif %d\n",i); - bfnd_ptr = head_bfnd + i; - bfnd_ptr->variant = (int) bf.variant; - bfnd_ptr->filename = NULL_CHECK(head_file, bf.filename); - bfnd_ptr->control_parent = NULL_CHECK(head_bfnd, bf.cp); - bfnd_ptr->label = NULL_CHECK(head_lab, bf.label); - bfnd_ptr->entry.Template.bf_ptr1 = NULL_CHECK(head_bfnd,bf.bf_ptr1); - bfnd_ptr->entry.Template.cmnt_ptr = NULL_CHECK(head_cmnt,bf.cmnt_ptr); - bfnd_ptr->entry.Template.symbol = NULL_CHECK(head_symb,bf.symbol); - bfnd_ptr->entry.Template.ll_ptr1 = NULL_CHECK(head_llnd,bf.ll_ptr1); - bfnd_ptr->entry.Template.ll_ptr2 = NULL_CHECK(head_llnd,bf.ll_ptr2); - bfnd_ptr->entry.Template.ll_ptr3 = NULL_CHECK(head_llnd,bf.ll_ptr3); - bfnd_ptr->entry.Template.dep_ptr1 = NULL_CHECK(head_dep, bf.dep_ptr1); - bfnd_ptr->entry.Template.dep_ptr2 = NULL_CHECK(head_dep, bf.dep_ptr2); - bfnd_ptr->entry.Template.lbl_ptr = NULL_CHECK(head_lab, bf.lbl_ptr); - bfnd_ptr->g_line = (int) bf.g_line; - bfnd_ptr->l_line = (int) bf.l_line; - bfnd_ptr->decl_specs = (int) bf.decl_specs; - bfnd_ptr->entry.Template.bl_ptr1 = read_blob_nodes(); - bfnd_ptr->entry.Template.bl_ptr2 = read_blob_nodes(); - } - return 0; -} - - -/*--------------------------------------------------------------* - * read_ll_nodes * - * * - * routines to read ll_nodes * - *--------------------------------------------------------------*/ -static int -read_ll_nodes() -{ - PTR_LLND llnd_ptr; - int i; - - for(i = 0; i < lfi->num_llnds; i++) { - if ((int)fread( (char *) &ll, sizeof(struct ll_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&ll, (char *)&ll, sizeof(struct ll_nd)); - - llnd_ptr = head_llnd + i; - llnd_ptr->variant = (int) ll.variant; - llnd_ptr->type = NULL_CHECK(head_type, ll.type); - - switch(llnd_ptr->variant) { - case INT_VAL : - if ((int)fread( (char *) &llnd_ptr->entry.ival, sizeof(int), 1, fd) < 0) - return -1; - if (need_swap) - swap_i((char *)&llnd_ptr->entry.ival); - break; - case BOOL_VAL : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - llnd_ptr->entry.bval = (int)(*tmp); - break; - case CHAR_VAL : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - llnd_ptr->entry.cval = (char)(*tmp); - break; - case DOUBLE_VAL: - case FLOAT_VAL : - case STMT_STR : - case STRING_VAL: - case KEYWORD_VAL: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - llnd_ptr->entry.string_val = *(strtbl+(*tmp)); - break; - case RANGE_OP : - case UPPER_OP : - case LOWER_OP : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); - llnd_ptr->entry.array_op.symbol= NULL_CHECK(head_symb,(*tmp)); - llnd_ptr->entry.array_op.dim = (int)tmp[1]; - break; - case LABEL_REF : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - llnd_ptr->entry.label_list.lab_ptr= NULL_CHECK(head_lab,(*tmp)); - break; -/* case ARITH_ASSGN_OP:*/ /* New added for VPC++ */ -/* if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); -*/ -/* The next line is a _REAL_ hack, I added the cast (PHB) */ -/* llnd_ptr->entry.Template.symbol = (PTR_SYMB) ((int) tmp[0]); - llnd_ptr->entry.Template.ll_ptr1 = NULL_CHECK(head_llnd,tmp[1]); - llnd_ptr->entry.Template.ll_ptr2 = NULL_CHECK(head_llnd,tmp[2]); - break; -*/ - default: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); - llnd_ptr->entry.Template.symbol =NULL_CHECK(head_symb,(*tmp)); - llnd_ptr->entry.Template.ll_ptr1=NULL_CHECK(head_llnd,tmp[1]); - llnd_ptr->entry.Template.ll_ptr2=NULL_CHECK(head_llnd,tmp[2]); - } - } - return 0; -} - - -/*--------------------------------------------------------------* - * * - * routines to read symbol table * - * * - *--------------------------------------------------------------*/ -static int -read_symb_nodes() -{ - PTR_SYMB symb_ptr; - int i; - - for(i = 0; i < lfi->num_symbs; i++) { - if ((int)fread( (char *) &sym, sizeof(struct sym_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&sym, (char *)&sym, sizeof(struct sym_nd)); - - symb_ptr = head_symb + i; - symb_ptr->variant = (int) sym.variant; - symb_ptr->type = NULL_CHECK(head_type, sym.type); - symb_ptr->attr = (int) sym.attr; - symb_ptr->next_symb = NULL_CHECK(head_symb, sym.next); - symb_ptr->scope = NULL_CHECK(head_bfnd, sym.scope); - symb_ptr->ident = *(strtbl + sym.ident); - - switch (symb_ptr->variant) { - case DEFAULT : - case TYPE_NAME : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 1*sizeof(u_shrt)); - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[0]); - break; - case CONST_NAME : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - /*swap_w((char *)tmp);*/ - swab((char *)tmp, (char *)tmp, (2)*sizeof(u_shrt)); - symb_ptr->entry.const_value = NULL_CHECK(head_llnd,(*tmp)); - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[1]); - break; - case ENUM_NAME : - case FIELD_NAME : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 5, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 5*sizeof(u_shrt)); - symb_ptr->entry.field.tag = (int)(*tmp); - symb_ptr->entry.field.next = NULL_CHECK(head_symb,tmp[1]); - symb_ptr->entry.field.base_name= NULL_CHECK(head_symb,tmp[2]); - symb_ptr->entry.field.declared_name = NULL_CHECK(head_symb,tmp[3]); - symb_ptr->entry.field.restricted_bit= NULL_CHECK(head_llnd,tmp[4]); - break; - case VARIABLE_NAME: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 3+1, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, (3+1)*sizeof(u_shrt)); - symb_ptr->entry.var_decl.local = (int)(*tmp); - symb_ptr->entry.var_decl.next_in= NULL_CHECK(head_symb,tmp[1]); - symb_ptr->entry.var_decl.next_out=NULL_CHECK(head_symb,tmp[2]); - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[3]); - break; - case PROGRAM_NAME: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2+1, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, (2+1)*sizeof(u_shrt)); - - symb_ptr->entry.prog_decl.symb_list = NULL_CHECK(head_symb,(*tmp)); - symb_ptr->entry.prog_decl.prog_hedr = NULL_CHECK(head_bfnd,tmp[1]); - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[2]); - break; - break; - case PROCEDURE_NAME : - case PROCESS_NAME: - case FUNCTION_NAME: - case INTERFACE_NAME: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 8+1, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, (8+1)*sizeof(u_shrt)); - - symb_ptr->entry.proc_decl.num_input = (int)(*tmp); - symb_ptr->entry.proc_decl.num_output = (int)tmp[1]; - symb_ptr->entry.proc_decl.num_io = (int)tmp[2]; - symb_ptr->entry.proc_decl.in_list =NULL_CHECK(head_symb,tmp[3]); - symb_ptr->entry.proc_decl.out_list =NULL_CHECK(head_symb,tmp[4]); - symb_ptr->entry.proc_decl.symb_list=NULL_CHECK(head_symb,tmp[5]); - symb_ptr->entry.proc_decl.proc_hedr=NULL_CHECK(head_bfnd,tmp[6]); - symb_ptr->entry.proc_decl.local_size = (int)tmp[7]; - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[8]); - break; - case MODULE_NAME: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2+1, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, (2+1)*sizeof(u_shrt)); - - symb_ptr->entry.Template.symb_list = NULL_CHECK(head_symb,(*tmp)); - symb_ptr->entry.Template.func_hedr = NULL_CHECK(head_bfnd,tmp[1]); - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[2]); - break; - case MEMBER_FUNC: /* NEW ADDED FOR VPC */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 11, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 11*sizeof(u_shrt)); - symb_ptr->entry.member_func.num_input = (int)(*tmp); - symb_ptr->entry.member_func.num_output = (int)tmp[1]; - symb_ptr->entry.member_func.num_io = (int)tmp[2]; - symb_ptr->entry.member_func.in_list =NULL_CHECK(head_symb,tmp[3]); - symb_ptr->entry.member_func.out_list =NULL_CHECK(head_symb,tmp[4]); - symb_ptr->entry.member_func.symb_list =NULL_CHECK(head_symb,tmp[5]); - symb_ptr->entry.member_func.func_hedr =NULL_CHECK(head_bfnd,tmp[6]); - symb_ptr->entry.member_func.next =NULL_CHECK(head_symb,tmp[7]); - symb_ptr->entry.member_func.base_name =NULL_CHECK(head_symb,tmp[8]); - symb_ptr->entry.member_func.declared_name =NULL_CHECK(head_symb,tmp[9]); - symb_ptr->entry.member_func.local_size = (int)tmp[10]; - - break; - case VAR_FIELD : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 4, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 4*sizeof(u_shrt)); - symb_ptr->entry.variant_field.tag = tmp[0]; - symb_ptr->entry.variant_field.next = NULL_CHECK(head_symb, tmp[1]); - symb_ptr->entry.variant_field.base_name = NULL_CHECK(head_symb, tmp[2]); - symb_ptr->entry.variant_field.variant_list = NULL_CHECK(head_llnd, tmp[3]); - break; - default: - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 1*sizeof(u_shrt)); - symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[0]); - break; - } - } - return 0; -} - - -/*----------------------------------------------------------------------* - * * - * routines to read type table * - * * - *----------------------------------------------------------------------*/ -static int -read_type_nodes() -{ - PTR_TYPE type_ptr; - int i, uss1, uss2; - - for(i = 0; i < lfi->num_types; i++) { - if ((int)fread( (char *) &typ, sizeof(struct typ_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&typ, (char *)&typ, sizeof(struct typ_nd)); - - type_ptr = head_type + i; - type_ptr->variant = (int)typ.variant; - type_ptr->name = NULL_CHECK(head_symb,typ.name); - - switch (type_ptr->variant) { - case T_INT : - case T_FLOAT : - case T_DOUBLE : - case T_CHAR : - case T_BOOL : - case T_COMPLEX : - case T_DCOMPLEX : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - /* swab((char *)tmp, (char *)tmp, sizeof(u_shrt)); */ - type_ptr->entry.Template.ranges = NULL_CHECK(head_llnd,tmp[0]); - type_ptr->entry.Template.kind_len = NULL_CHECK(head_llnd,tmp[1]); - break; - case T_STRING : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - type_ptr->entry.Template.ranges = NULL_CHECK(head_llnd,tmp[0]); - type_ptr->entry.Template.kind_len = NULL_CHECK(head_llnd,tmp[1]); - type_ptr->entry.Template.dummy1 = (int)tmp[2]; - break; - case DEFAULT : - case T_VOID : /* NEW ADDED FOR VPC */ - case T_UNKNOWN : - case T_ENUM_FIELD: - break; - case T_SUBRANGE : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); - type_ptr->entry.subrange.base_type = NULL_CHECK(head_type,tmp[0]); - type_ptr->entry.subrange.lower = NULL_CHECK(head_llnd,tmp[1]); - type_ptr->entry.subrange.upper = NULL_CHECK(head_llnd,tmp[2]); - break; - case T_ARRAY : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); - type_ptr->entry.ar_decl.num_dimensions = (int)tmp[0]; - type_ptr->entry.ar_decl.base_type = NULL_CHECK(head_type,tmp[1]); - type_ptr->entry.ar_decl.ranges = NULL_CHECK(head_llnd,tmp[2]); - break; - case T_LIST : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - type_ptr->entry.base_type = NULL_CHECK(head_type,(*tmp)); - break; - - case T_RECORD : - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); - type_ptr->entry.re_decl.num_fields = (int)(*tmp); - type_ptr->entry.re_decl.first = NULL_CHECK(head_symb,tmp[1]); - break; - case T_DESCRIPT: /* NEW ADDED FOR VPC */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 7, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 7*sizeof(u_shrt)); - type_ptr->entry.descriptive.signed_flag = (int)tmp[0] ; - uss1 = (int)tmp[1]; - uss2 = (int)tmp[2]; - type_ptr->entry.descriptive.long_short_flag = (int) ((uss1 << 16) | uss2); - type_ptr->entry.descriptive.mod_flag = (int)tmp[3] ; - type_ptr->entry.descriptive.storage_flag = (int)tmp[4] ; - type_ptr->entry.descriptive.access_flag = (int)tmp[5] ; - type_ptr->entry.descriptive.base_type = NULL_CHECK(head_type,tmp[6]); - break; - case T_REFERENCE: /* NEW ADDED FOR VPC */ - case T_POINTER: { /* NEW ADDED FOR VPC */ - short int s; - if ((int)fread( (char *) tmp, sizeof(u_shrt), 4, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 4*sizeof(u_shrt)); - type_ptr->entry.Template.base_type = NULL_CHECK(head_type,tmp[0]); - s = tmp[1]; /* hack!! since this is a singed short */ - type_ptr->entry.Template.dummy1 = (int) s; - uss1 = (int)tmp[2]; - uss2 = (int)tmp[3]; - type_ptr->entry.Template.dummy5 = (int) ((uss1 << 16) | uss2); - } - break; - case T_FUNCTION: /* NEW ADDED FOR VPC */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) - return -1; - if (need_swap) - swap_w((char *)tmp); - type_ptr->entry.Template.base_type = NULL_CHECK(head_type,(*tmp)); - break; - case T_DERIVED_TYPE : /* NEW ADDED FOR VPC */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); - type_ptr->entry.derived_type.symbol = NULL_CHECK(head_symb,tmp[0]); - type_ptr->entry.derived_type.scope_symbol = NULL_CHECK(head_symb,tmp[1]); - break; - case T_MEMBER_POINTER: /* for C::* same as derived collection in structure */ - case T_DERIVED_COLLECTION: /* NEW ADDED FOR PC++ */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); - type_ptr->entry.col_decl.collection_name = NULL_CHECK(head_symb,tmp[0]); - type_ptr->entry.col_decl.base_type = NULL_CHECK(head_type,tmp[1]); - break; - case T_DERIVED_TEMPLATE: /* NEW ADDED FOR PC++ */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); - type_ptr->entry.templ_decl.templ_name = NULL_CHECK(head_symb,tmp[0]); - type_ptr->entry.templ_decl.args = NULL_CHECK(head_llnd,tmp[1]); - break; - - case T_ENUM : - case T_UNION : /* NEW ADDED FOR VPC */ - case T_CLASS : /* NEW ADDED FOR VPC */ - case T_STRUCT : /* NEW ADDED FOR VPC */ - case T_DERIVED_CLASS : /* NEW ADDED FOR VPC */ - case T_COLLECTION: /* NEW ADDED FOR PC++ */ - if ((int)fread( (char *) tmp, sizeof(u_shrt), 4, fd) < 0) - return -1; - if (need_swap) - swab((char *)tmp, (char *)tmp, 4*sizeof(u_shrt)); - type_ptr->entry.derived_class.num_fields = (int)tmp[0] ; - type_ptr->entry.derived_class.first = NULL_CHECK(head_symb,tmp[1]); - type_ptr->entry.derived_class.original_class = NULL_CHECK(head_bfnd,tmp[2]); - type_ptr->entry.derived_class.base_type = NULL_CHECK(head_type,tmp[3]); - break; - - default : - break; - } - } - return 0; -} - - -/*----------------------------------------------------------------------* - * read_label_nodes * - * * - * Reads the label nodes * - *----------------------------------------------------------------------*/ -static int -read_label_nodes() -{ - PTR_LABEL lab_ptr; - int i; - - for (i=0; i < lfi->num_label; i++) { - if ((int)fread( (char *) &lab, sizeof(struct lab_nd), 1, fd) < 0) - return -1; - if (need_swap) { - swab((char *)&lab, (char *)&lab, sizeof(struct lab_nd)-sizeof(long)); - swap_i((char *)&lab.stat_no); - } - - lab_ptr = head_lab +i; - lab_ptr->stateno = lab.stat_no; - lab_ptr->labtype = lab.labtype; - lab_ptr->statbody= NULL_CHECK(head_bfnd, lab.body); - lab_ptr->label_name= NULL_CHECK(head_symb,lab.name); /* for VPC */ - } - return 0; -} - - -/*----------------------------------------------------------------------* - * read_dep_nodes * - * * - * Reads the dep nodes * - *----------------------------------------------------------------------*/ -static int -read_dep_nodes() -{ - PTR_DEP dep; - int i, j; - - for ( i=0; i < lfi->num_dep; i++ ) { - if ((int)fread( (char *) &dpd, sizeof(struct dep_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&dpd, (char *)&dpd, sizeof(struct dep_nd)); - - dep = head_dep + (--dpd.id); - dep->type = (int)dpd.type; - dep->symbol = NULL_CHECK(head_symb,dpd.sym); - dep->from.stmt = NULL_CHECK(head_bfnd,dpd.from_stmt); - dep->from.refer = NULL_CHECK(head_llnd,dpd.from_ref); - dep->to.stmt = NULL_CHECK(head_bfnd,dpd.to_stmt); - dep->to.refer = NULL_CHECK(head_llnd,dpd.to_ref); - /* i dont know what these are!!! - dep->from_hook = NULL_CHECK(head_bfnd,dpd.from_hook); - dep->to_hook = NULL_CHECK(head_bfnd,dpd.to_hook); - */ - dep->from_fwd = NULL_CHECK(head_dep,dpd.from_fwd); - dep->from_back = NULL_CHECK(head_dep,dpd.from_back); - dep->to_fwd = NULL_CHECK(head_dep,dpd.to_fwd); - dep->to_back = NULL_CHECK(head_dep,dpd.to_back); - - for (j=0; jdirect[j] = (char)dpd.dire[j]; - } - } - return 0; -} - - -/*----------------------------------------------------------------------* - * read_cmnt_nodes * - * * - * Reads the comment nodes * - *----------------------------------------------------------------------*/ -static int -read_cmnt_nodes() -{ - PTR_CMNT cmnt = lfi->head_cmnt; - int i; - - for (i = 0; i < lfi->num_cmnt; i++) { - if ((int)fread( (char *) &cmt, sizeof(struct cmt_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&cmt, (char *)&cmt, sizeof(struct cmt_nd)); - - cmnt->type = (int) cmt.type; - cmnt->next = NULL_CHECK(head_cmnt, cmt.next); - cmnt->string = *(strtbl + cmt.str); - cmnt++; - } - return 0; -} - - -/* - * strip_dot_slash tries to strip "./" from the filename - */ -static -void strip_dot_slash(s) - char *s; -{ - char *p, *q, ch; - - while ((ch = *s++)) - if (ch == '.') { - if (*s == '/') { - p = q = s++ - 1; - while ((*p++ = *s++)); - s = q; - } else if (*s == '.') - s++; - } -} - - -/*----------------------------------------------------------------------* - * read_filename_nodes * - * * - * Reads the filename nodes * - *----------------------------------------------------------------------*/ -static int -read_filename_nodes() -{ - int i; - PTR_FNAME fp = head_file; - - for (i = 0; i < lfi->num_files; i++) { - if ((int)fread( (char *) &fil, sizeof(struct fil_nd), 1, fd) < 0) - return -1; - if (need_swap) - swab((char *)&fil, (char *)&fil, sizeof(struct fil_nd)); - - strip_dot_slash(fp->name = *(strtbl + fil.name)); - fp++; - } - lfi->filename = head_file->name; - return 0; -} - - -/*------------------------------------------------------* - * read_nodes * - * * - * Drives the read routines * - *------------------------------------------------------*/ -int -read_nodes(fi) - PTR_FILE fi; -{ - need_swap = 0; - lfi = fi; - fd = fi->fid; - if (read_preamble() < 0) - return -1; - - if (read_bif_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"bif nodes loaded\n"); - - if (ftell(fd) != floc.llnd) { - fprintf (stderr,"read_nodes: wrong location of low level nodes\n"); - if (fseek(fd, floc.llnd, 0) < 0) - return -1; - } - if (read_ll_nodes() < 0) { - perror("read_ll_nodes:"); - return -1; - } - - if (debug) - fprintf(stderr,"low level nodes loaded\n"); - - if (ftell(fd) != floc.symb) { - fprintf(stderr,"read_nodes: wrong location of symbol nodes\n"); - if(fseek(fd, floc.symb, 0) < 0) - return -1; - } - if (read_symb_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"symbol table loaded \n"); - - if (ftell(fd) != floc.type) { - fprintf(stderr,"read_nodes: wrong location of type nodes\n"); - if(fseek(fd, floc.type, 0) < 0) - return -1; - } - if (read_type_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"type table loaded \n"); - - if (ftell(fd) != floc.labs) { - fprintf(stderr,"read_nodes: wrong location of label nodes\n"); - if(fseek(fd, floc.labs, 0) < 0) - return -1; - } - if (read_label_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"label table loaded\n"); - - if (ftell(fd) != floc.cmnt) { - fprintf(stderr,"read_nodes: wrong location of comment nodes\n"); - if(fseek(fd, floc.cmnt, 0) < 0) - return -1; - } - if (read_cmnt_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"comment strings loaded \n"); - - if (ftell(fd) != floc.file) { - fprintf(stderr,"read_nodes: wrong location of filename nodes\n"); - if(fseek(fd, floc.file, 0) < 0) - return -1; - } - if (read_filename_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"filename table loaded\n"); - - if (ftell(fd) != floc.deps) { - fprintf(stderr,"read_nodes: wrong location of dependence arc nodes\n"); - if(fseek(fd, floc.deps, 0) < 0) - return -1; - } - if (read_dep_nodes() < 0) - return -1; - if (debug) - fprintf(stderr,"dependence arcs loaded \n"); - - /* Now set up the returned values */ - global_bfnd->control_parent = (PTR_BFND) fi; - fi->cur_blob = cur_blob; - fi->cur_bfnd = cur_bfnd; - fi->cur_llnd = cur_llnd; - fi->cur_symb = cur_symb; - fi->cur_type = cur_type; - fi->cur_dep = cur_dep; - fi->cur_lab = cur_lab; - fi->cur_cmnt = cur_cmnt; - return 0; -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/sets.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/sets.c deleted file mode 100644 index ef45328..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/sets.c +++ /dev/null @@ -1,1818 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* File: sets.c */ -#include "db.h" - -extern PCF UnparseBfnd[]; -extern PCF UnparseLlnd[]; - -extern PTR_FILE cur_file; - -#define PLUS 2 -#define ZPLUS 3 -#define MINUS 4 -#define ZMINUS 5 -#define PLUSMINUS 6 -#define NODEP -1 -#define FLOWD 1 -#define OUTPUTD 2 -#define ANTID -1 -#define INPUTD 3 - -extern char *tag[611]; -extern struct subscript source[AR_DIM_MAX]; /* a source reference or def. */ -extern struct subscript destin[AR_DIM_MAX]; /* a destination ref. or def. */ -extern PTR_SYMB induct_list[MAX_NEST_DEPTH]; -extern int is_forall[MAX_NEST_DEPTH]; -extern int language; /* is either ForSrc or CSrc */ -extern int num_ll_allocated; - -extern char *funparse_bfnd(); -extern char *cunparse_bfnd(); -extern char *funparse_llnd(); -extern char *cunparse_llnd(); -extern void collect_garbage(); -extern void normal_form(); -extern void bind_call_site_info(); -extern PTR_LLND make_llnd(); -extern PTR_FILE cur_file; -extern int show_deps; -extern void disp_refl(); -int search_decl(); -extern int comp_dist(); -extern int identical(); -extern void assign(); -int node_count = 0; - -void fix_symbol_list( b) -PTR_BFND b; -{ - PTR_BLOB bp; - PTR_SYMB f, v; - if(b == NULL || b->variant != GLOBAL) return; - bp = b->entry.Template.bl_ptr1; - while(bp){ - if(bp->ref->variant == PROC_HEDR || - bp->ref->variant == FUNC_HEDR){ - f = bp->ref->entry.Template.symbol; - if(f->entry.proc_decl.symb_list == NULL){ - v = f->thread; - while(v){ - if(v->scope == bp->ref){ - f->entry.proc_decl.symb_list = v; - v = NULL; - } - else{ - v = v->thread; - } - } - } - } - bp=bp->next; - } - } - - - - -/*******************************************************************/ -/* The following external functions found in setutils.c and */ -/* anal_index.c. and symb_alg.c */ -/*******************************************************************/ - -void *malloc(); -PTR_SETS alloc_sets(); -PTR_REFL alloc_ref(); -PTR_REFL copy_refl(); -PTR_REFL union_refl(); -PTR_REFL intersect_refl(); -PTR_REFL make_name_list(); -PTR_REFL remove_locals_from_list(); -PTR_REFL build_refl(), merge_array_refs(); -void print_subscr(); -void append_refl(); -void normal_form(); -void bind_call_site_info(); - -/* Gather_ref is a function that makes a reference node and a list */ -/* for each reference to a varialbe at the tree rooted at the low */ -/* level node ll. the parameter defs is used by C programs. in */ -/* this case defs points to a list of definitions that are generated*/ -/* durring the evaluation of this expression. */ - -PTR_REFL gather_refl(rnd, defs, bif, ll) -int rnd; /* flag = 1 to gather refs for func. calls */ -PTR_REFL *defs; /* for C expressions that define values */ -PTR_BFND bif; -PTR_LLND ll; -{ - PTR_REFL p, q, t; - PTR_REFL r; - PTR_LLND a; - - if (ll == NULL) - return (NULL); - - if (bif->variant == PROC_STAT && rnd) { - PTR_LLND bused, bmodified; - PTR_REFL brlu, brlm; - /* assume global analysis done. */ - bind_call_site_info(bif, &bused, &bmodified); - brlu = build_refl(bif, bused); - brlu = merge_array_refs(brlu); - brlu = merge_array_refs(brlu); /* one more pass */ - brlm = build_refl(bif, bmodified); - brlm = merge_array_refs(brlm); - brlm = merge_array_refs(brlm); /* one more pass */ - append_refl(defs, brlm); - return (brlu); - } - - if (ll->variant == VAR_REF) - return (alloc_ref(bif, ll)); - else if ((ll->variant == PROC_CALL) || (ll->variant == FUNC_CALL)) - if (rnd) { - PTR_LLND bused, bmodified; - PTR_REFL brlu, brlm; - /* assume global analysis done. */ - bind_call_site_info(bif, &bused, &bmodified); - brlu = build_refl(bif, bused); - brlu = merge_array_refs(brlu); - brlu = merge_array_refs(brlu); /* one more pass */ - brlm = build_refl(bif, bmodified); - brlm = merge_array_refs(brlm); - brlm = merge_array_refs(brlm); /* one more pass */ - append_refl(defs, brlm); - return (brlu); - } - else - return (NULL); - else if (ll->variant == ARRAY_REF) { - r = alloc_ref(bif, ll); - p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - if (rnd == 0 && bif->variant == PROC_STAT) - t = p; - else { - t = union_refl(r, p); - disp_refl(p); - } - return (t); - } - else if (ll->variant == DEREF_OP) { - p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - return (p); - } - else if (ll->variant == ADDRESS_OP) { - p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - return (p); - } - else if (ll->variant == POINTST_OP || ll->variant == RECORD_REF) { - /* a->b type operation. in this case we have a */ - /* reference to a substructure of a struct. */ - r = alloc_ref(bif, ll); - r->id = NULL; - return (r); - } - else if (ll->variant == PLUSPLUS_OP || ll->variant == MINUSMINUS_OP) { - p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - q = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - /* better check for predecriment too! */ - append_refl(defs, q); - disp_refl(q); - return (p); - } - else if (ll->variant == ASSGN_OP || ll->variant == ARITH_ASSGN_OP) { - if (ll->entry.Template.ll_ptr2->variant == DEREF_OP) { - /* create an equivalence pair for later use */ - /* i don't know what to return */ - return (NULL); - } - else { - p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr2); - a = ll->entry.Template.ll_ptr1; - if (a->variant == VAR_REF || a->variant == POINTST_OP - || a->variant == RECORD_REF) { - r = alloc_ref(bif, a); - append_refl(defs, r); - if (ll->variant == ARITH_ASSGN_OP) { - r = alloc_ref(bif, a); - append_refl(&p, r); - } - return (p); - } - else if (a->variant == ARRAY_REF) { - r = alloc_ref(bif, a); - append_refl(defs, r); - q = gather_refl(rnd, defs, bif, a->entry.Template.ll_ptr1); - t = union_refl(p, q); - disp_refl(p); - disp_refl(q); - if (ll->variant == ARITH_ASSGN_OP) { - r = alloc_ref(bif, a); - append_refl(&t, r); - } - return (t); - } - else if (a->variant == DEREF_OP) { - /* not so sure about this! */ - q = gather_refl(rnd, defs, bif, a->entry.Template.ll_ptr1); - if (ll->variant == ARITH_ASSGN_OP) { - r = alloc_ref(bif, a); - append_refl(&q, r); - } - return (q); - } - else { - q = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - append_refl(defs, q); - disp_refl(q); - if (ll->variant == ARITH_ASSGN_OP) { - r = alloc_ref(bif, a); - append_refl(&p, r); - } - return (p); - } - } - } - else { - p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); - q = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr2); - t = union_refl(p, q); - disp_refl(p); - disp_refl(q); - return (t); - } -} - -static int before(bsor, bdes) -PTR_BFND bsor, bdes; -{ - return (bsor->id < bdes->id); -} - - -PTR_REFL rem_kill(in, gen) -PTR_REFL in, gen; -{ - /* search "in" for things in "in" that are killed by gen. */ - /* for scalars this means we just look at the ID. */ - /* for arrays we have to check for an induction variable expression */ - /* that is constant in the current iteration. */ - PTR_REFL t, g, rk, tmp; - - t = copy_refl(in); - for (g = gen; g; g = g->next) - for (tmp = t; tmp; tmp = tmp->next) - if (tmp->id == g->id) { - if ((tmp->node && (tmp->node->refer->variant == POINTST_OP || - tmp->node->refer->variant == RECORD_REF)) || - (g->node && (g->node->refer->variant == POINTST_OP || - g->node->refer->variant == RECORD_REF)) - ) { - /* don't know what to do! */ - } - /* have a hit here. */ - else if (tmp->node->refer->variant == VAR_REF) { - tmp->id = NULL; - tmp->node = NULL; - /* just killed a scalar */ - } - else { - /* it is an ARRAY_REF so we need much work */ - /* the key is to kill definitions to the same subscripted */ - /* variables that are defined in the same iteration */ - /* and are lexically before the current definition. */ - /* But you must then do subscript analysis. the code */ - /* below gives the idea. funct. match_subs not yet done */ - /* it does not hurt to leave this out. the extra dep. */ - /* that are generated are not harmfull. */ - /* for now we only kill off unsubscripted array refs */ - /* because they are redefinitions of the whole array */ - if (tmp->node->refer->variant == ARRAY_REF) - if (g->node->refer->entry.array_ref.index == NULL) { - tmp->id = NULL; - tmp->node = NULL; - } - } - } - - /* now prune out all killed nodes from t */ - rk = NULL; - while (t) { - tmp = t; - t = t->next; - tmp->next = NULL; - if (tmp->node == NULL) - disp_refl(tmp); - else { - tmp->next = rk; - rk = tmp; - } - } - return (rk); -} - - -/**************************************************************************** - * the rountines search_local and remove_local are used to surpress carried * - * deps for forall loops. search the reference list looking for references * - * to locals * - ****************************************************************************/ -int search_local(b, s) -PTR_BFND b; -PTR_SYMB s; -{ - PTR_SYMB locs; - PTR_BLOB blob; - - if (b->variant == FORALL_NODE) { - locs = b->entry.forall_nd.control_var; - while (locs != NULL && s != locs) - locs = locs->next_symb; - if (locs == s) - return (0); - else - return (1); - } - else if (language != ForSrc) { - blob = b->entry.Template.bl_ptr1; - return (search_decl(blob, s)); - } - else - return (1); -} - -int search_decl(blob, s) -PTR_BLOB blob; -PTR_SYMB s; -{ - PTR_BFND b; - PTR_LLND ll, v; - - while (blob != NULL && blob->ref->variant != CONTROL_END) { - b = blob->ref; - if (b->variant == VAR_DECL) { - ll = b->entry.Template.ll_ptr1; - /* ll should be an expression list */ - while (ll != NULL) { - if (ll->entry.Template.ll_ptr1 != NULL) { - v = ll->entry.Template.ll_ptr1; - if ((v->variant == VAR_REF || - v->variant == ARRAY_REF) && - v->entry.Template.symbol == s) - return (0); - } - ll = ll->entry.Template.ll_ptr2; - } - } - blob = blob->next; - } - return (1); -} - - -PTR_REFL remove_locals(b, in) -PTR_BFND b; -PTR_REFL in; -{ - PTR_SYMB i; - PTR_REFL t, rk, tmp; - PTR_BFND loop; - int notfound; - - /* prune out all killed nodes from t */ - rk = NULL; - t = in; - while (t != NULL) { - tmp = t; - t = t->next; - i = tmp->id; - tmp->next = NULL; - loop = b; - notfound = 1; - while (loop != NULL && - (loop->variant != FOR_NODE && - loop->variant != WHILE_NODE && - loop->variant != LOOP_NODE && - loop->variant != CDOALL_NODE && - loop->variant != PARFOR_NODE && - loop->variant != IF_NODE && - loop->variant != LOGIF_NODE && - loop->variant != PAR_NODE)) { - loop = loop->control_parent; - } - if (loop != NULL) - notfound = search_local(loop, i); - if (notfound == 0) - disp_refl(tmp); - else { - tmp->next = rk; - rk = tmp; - } - } - return (rk); -} - -int is_star_range(p) -PTR_LLND p; -{ - PTR_LLND q, q2; - - if (p->entry.Template.ll_ptr1 == NULL) - return (1); - q = p->entry.Template.ll_ptr1;/* q should be an index list */ - q2 = q->entry.Template.ll_ptr1; /* q2 is the first index */ - if ((q2 == NULL || q2->variant == STAR_RANGE) - && q->entry.Template.ll_ptr2 == NULL) { - return (1); - } - return (0); -} - -PTR_REFL remove_scalar_dups(s) -PTR_REFL s; -{ - PTR_SYMB i; - PTR_REFL t, arr_no_subs, arr_with_subs, final, loop, tmp, point_exps; - PTR_LLND p; - int notfound; - - /* prune out all killed nodes from t */ - final = NULL; - arr_no_subs = NULL; - arr_with_subs = NULL; - point_exps = NULL; - t = s; - while (t != NULL) { - tmp = t; - t = t->next; - p = tmp->node->refer; - i = p->entry.Template.symbol; - tmp->next = NULL; - if (p->variant == VAR_REF || - (p->variant == ARRAY_REF && is_star_range(p))) { - if (p->variant == ARRAY_REF) { - loop = arr_no_subs; - notfound = 1; - while (loop != NULL) { - if (loop->node->refer->entry.Template.symbol == i) { - notfound = 0; - } - loop = loop->next; - } - if (notfound) { - tmp->next = arr_no_subs; - arr_no_subs = tmp; - } - } - else { - loop = final; - notfound = 1; - while (loop != NULL) { - if (loop->node->refer->entry.Template.symbol == i) - notfound = 0; - loop = loop->next; - } - if (notfound) { - tmp->next = final; - final = tmp; - } - } - } - else if (tmp->node->refer->variant == ARRAY_REF) { - tmp->next = arr_with_subs; - arr_with_subs = tmp; - } - else - if(tmp->node->refer->variant==POINTST_OP - || tmp->node->refer->variant == RECORD_REF) { - tmp->next = point_exps; - point_exps = tmp; - } - } /* end while */ - t = arr_with_subs; - while (t != NULL) { - tmp = t; - t = t->next; - i = tmp->node->refer->entry.Template.symbol; - tmp->next = NULL; - notfound = 1; - loop = arr_no_subs; - while (loop != NULL) { - if (loop->node->refer->entry.Template.symbol == i) - notfound = 0; - loop = loop->next; - } - if (notfound) { - tmp->next = final; - final = tmp; - } - } - t = arr_no_subs; - while (t != NULL) { - tmp = t; - t = t->next; - tmp->next = final; - final = tmp; - } - t = point_exps; - while (t != NULL) { - tmp = t; - t = t->next; - tmp->next = final; - final = tmp; - } - return (final); -} - - -/***********************************************************************/ -/* */ -/* dependence manipulation routines rm_dep() and append_dep() */ -/* taken from lists.c in bled. should be deleted from that file */ -/* */ -/***********************************************************************/ -void rm_dep(b, d) /* remove dep d from the list out of b */ -PTR_BFND b; -PTR_DEP d; -{ - PTR_DEP s, olds = NULL; - - s = b->entry.Template.dep_ptr1; - if (s == d) { - b->entry.Template.dep_ptr1 = d->from_fwd; - d->from_fwd = NULL; - } - else { - while ((s != NULL) && (s != d)) { - olds = s; - s = s->from_fwd; - } - if (s) { - olds->from_fwd = s->from_fwd; - d->from_fwd = NULL; - } - } -} - -static int check_dep_copy(b, t, s, bf, lf, bt, lt) -PTR_BFND b, bf, bt; -PTR_SYMB s; -int t; -PTR_LLND lf, lt; -{ - PTR_DEP lst; - lst = b->entry.Template.dep_ptr1; - while(lst){ - if(lst->type == t && lst->symbol == s && - lst->from.stmt == bf && lst->from.refer == lf && - lst->to.stmt == bt && lst->to.refer == lt) - return 0; - lst = lst->from_fwd; - } - return 1; - } - -void append_dep(b, d) /* add the dep d to the list from b */ -PTR_BFND b; -PTR_DEP d; -{ - PTR_BFND t; - - d->from_fwd = b->entry.Template.dep_ptr1; - b->entry.Template.dep_ptr1 = d; - t = d->to.stmt; - d->to_fwd = t->entry.Template.dep_ptr2; - t->entry.Template.dep_ptr2 = d; -} - - - -/**************************************************************/ -/* make deps is the key routine that checks two references to */ -/* see if they are in fact a dependence. if so a new dep is */ -/* created and linked into the structure */ -/**************************************************************/ -void make_deps(type, def, use) -PTR_REFL def, use; -int type; -{ - PTR_REFL g; /* temporary reference list */ - PTR_SYMB s; /* symbol for varialble name */ - PTR_SYMB ivar; /* an induction variable name */ - int i, j, befr, notrub, type1; - int vect[MAX_NEST_DEPTH], troub[MAX_NEST_DEPTH]; - - PTR_DEP dptr; /* pointer to dependence inserted */ - PTR_DEP make_dep(); /* functions from list.c */ - char t; /* type: 0=flow 1=anti 2 = output */ - PTR_LLND lls, lld; /* term source and destination */ - PTR_BFND bns, bnd; /* biff nd source and destination */ - char dv[MAX_NEST_DEPTH]; /* dep. vector: 1="=" 2="<" 4=">" ? */ - while (def != NULL) { - s = def->id; - g = use; - if ((s != NULL) && (s->type != NULL) && - ((type != INPUTD) || (s->type->variant == T_ARRAY))) - while (g != NULL) { - if (g->id == s) { - /* compute the distance vector and trouble vector */ - - befr = before(def->node->stmt, g->node->stmt); - comp_dist(vect, troub, def->node, g->node, befr); - - /* first zero out all vector components */ - /* outside the scope of the variable */ - - /* this is to fix the problem with */ - /* nested foralls. */ - s = def->id; - notrub = 1; - for (i = vect[0]; i >= 1; i--) { - if (is_forall[i - 1]) { - ivar = induct_list[i - 1]; - while (ivar != NULL && ivar != s) - ivar = ivar->next_symb; - if (ivar == s) { /* found local */ - notrub = 0; - } - } - if (notrub == 0) { - vect[i] = 0; - troub[i] = 0; - } - } - - - if (troub[0] == 1) { - /* no dependence here */ - } - else { - /* dependence exists, so generate the record and information */ - bns = def->node->stmt; - lls = def->node->refer; - bnd = g->node->stmt; - lld = g->node->refer; - type1 = type; - if(bns == bnd && (lls != lld) && identical(lls, lld)){ - /* this is an accumulation recurrence if lls and lld are */ - /* identical. They should be compared. if they are the */ - /* same, create an accumulation dep ACCD. Check this */ - /* for flow and avoid generating the output and anti deps*/ - if (type1 == FLOWD) type1 = 5; - else type1 = 6; - } - /* convert to standard bif constants */ - switch (type1) { - case 5: /* ACCD: */ - t = 3; - break; - case FLOWD: - if (show_deps) - fprintf(stderr, "flow dependence on var:`%s' -", s->ident); - t = 0; - break; - case OUTPUTD: - case -OUTPUTD: - if (show_deps) - fprintf(stderr, " output dependence on var:`%s' -", s->ident); - t = 2; - break; - case ANTID: - if (show_deps) - fprintf(stderr, "anti dependence on var:`%s' -", s->ident); - t = 1; - break; - case INPUTD: - t = 4; - break; - default: - if (show_deps) - fprintf(stderr, " bad type -"); - t = 5; - } - if(t == 5) break; - if (show_deps &&(t != 4)) - fprintf(stderr, "((level=%d)", vect[0]); - for (j = 0; j < MAX_NEST_DEPTH; j++) - dv[j] = 0; - for (j = 1; j <= vect[0]; j++) - switch (troub[j]) { - case NODEP: - case -99: - case 0: - if (show_deps) - if (t != 4) - fprintf(stderr, ", %d ", vect[j]); - if (vect[j] > 0) - dv[j] = 4; - else if (vect[j] == 0) - dv[j] = 1; - else - dv[j] = 2; - break; - case PLUS: - if (show_deps) - if (t != 4) - fprintf(stderr, ", +"); - dv[j] = 4; - break; - case ZPLUS: - if (show_deps) - if (t != 4) - fprintf(stderr, ", 0/+"); - dv[j] = 5; - break; - case MINUS: - if (show_deps) - if (t != 4) - fprintf(stderr, ", -"); - dv[j] = 2; - break; - case ZMINUS: - if (show_deps) - if (t != 4) - fprintf(stderr, ", 0/-"); - dv[j] = 3; - break; - case PLUSMINUS: - if (show_deps) - if (t != 4) - fprintf(stderr, ", +/-"); - dv[j] = 7; - break; - default: - if (show_deps) - if (t != 4) - fprintf(stderr, ", ??%d ", troub[j]); - dv[j] = 8; - } - if (show_deps && (t != 4)) - fprintf(stderr, ")\n"); - for (j = 1; j <= vect[0]; j++) { - if (is_forall[j - 1] && (t != 4)) { - if (troub[j] == 0 || troub[j] == NODEP - || troub[j] == -99) { - if (vect[j] != 0) - fprintf(stderr, "WARNING!! may be potential concurrency conflict\n"); - } - else - fprintf(stderr, "WARNING!! May be potential Concurrency conflict\n"); - } - } - - - /* now make the dependences... */ - /* only generate uniformly generated input deps. */ - /* Temp for cftn. disable input deps */ - /* disabled: note unif_gen has more arguments */ - if (t != 4 && t != 5 && - check_dep_copy(bns,t,s,bns,lls,bnd,lld)){ - dptr = make_dep(cur_file, s, t, lls, lld, bns, bnd, dv); - append_dep(bns, dptr); - } - - /* note: only appends to from list */ - /* if you want more fix append_dep */ - } - } - else { - /* symbols do not agree */ - } - g = g->next; - } - def = def->next; - } -} -/***************************************************************/ -/* link_set_list() builds a expr list of low level expressions */ -/* that describe the use of variable in the list. it will list*/ -/* each scalar only once and for each array reference it will */ -/* build an expression that describes the use of the variable */ -/* using ddot form. lots of common subexpressions are used. */ -/* find_bounds() is found in anal_ind.c */ -/***************************************************************/ - -PTR_LLND link_set_list(s) -PTR_REFL s; -{ - PTR_LLND p, q, newq, make_llnd(), find_bounds(); - PTR_BFND b; - PTR_REFL remove_scalar_dups(); - PTR_LLND remove_array_dups(), merge_ll_array_list(); - - s = remove_scalar_dups(s); - p = NULL; - while (s != NULL) { - switch (s->node->refer->variant) { - case VAR_REF: - case POINTST_OP: - case RECORD_REF: - p = make_llnd(cur_file, EXPR_LIST, s->node->refer, p, NULL); - break; - case ARRAY_REF: - q = s->node->refer; - b = s->node->stmt; - newq = make_llnd(cur_file, ARRAY_REF,NULL,NULL,q->entry.Template.symbol); - newq = find_bounds(b, q, newq); - /* now put q into normal form */ - normal_form(&(newq->entry.Template.ll_ptr1)); - q = newq->entry.Template.ll_ptr1; - /* now link into expr list chain p */ - p = make_llnd(cur_file, EXPR_LIST, newq, p, NULL); - break; - default: - fprintf(stderr, "something wrong here "); - break; - } - s = s->next; - } - return (merge_ll_array_list(merge_ll_array_list(p))); /* two passes */ -} - -PTR_LLND remove_array_dups(elist) -PTR_LLND elist; -{ - PTR_LLND star_range_list; - PTR_LLND tmp_list; - PTR_LLND final_list, cons, item, p, q; - PTR_SYMB var; - int not_found; - - /* first pull off all star range arrays from elist and put them */ - /* on the star_range_list. Others go to tmp_list. Then tmp_list */ - /* compared to star_range list. If not there it is added to final */ - /* list and star_range_list is appended to tmp_list. */ - star_range_list = NULL; - tmp_list = NULL; - final_list = NULL; - while (elist != NULL) { - cons = elist; - elist = elist->entry.Template.ll_ptr2; - cons->entry.Template.ll_ptr2 = NULL; - item = cons->entry.Template.ll_ptr1; - var = item->entry.Template.symbol; - p = star_range_list; - q = tmp_list; - if (item->variant == ARRAY_REF && is_star_range(item)) { - not_found = 1; - while (p != NULL) { - if (var == p->entry.Template.ll_ptr1->entry.Template.symbol) { - not_found = 0; - break; - } - p = p->entry.Template.ll_ptr2; - } - if (not_found) { - cons->entry.Template.ll_ptr2 = star_range_list; - star_range_list = cons; - } - } - else { - not_found = 1; - while (q != NULL) { - if (identical(q->entry.Template.ll_ptr1, item)) { - not_found = 0; - break; - } - q = q->entry.Template.ll_ptr2; - } - if (not_found) { - cons->entry.Template.ll_ptr2 = tmp_list; - tmp_list = cons; - } - } - } - while (tmp_list != NULL) { - cons = tmp_list; - tmp_list = tmp_list->entry.Template.ll_ptr2; - cons->entry.Template.ll_ptr2 = NULL; - item = cons->entry.Template.ll_ptr1; - var = item->entry.Template.symbol; - p = star_range_list; - if (item->variant == ARRAY_REF) { - not_found = 1; - while (p != NULL) { - if (var == p->entry.Template.ll_ptr1->entry.Template.symbol) { - not_found = 0; - break; - } - p = p->entry.Template.ll_ptr2; - } - if (not_found) { - cons->entry.Template.ll_ptr2 = final_list; - final_list = cons; - } - } - else { - cons->entry.Template.ll_ptr2 = final_list; - final_list = cons; - } - } - q = final_list; - while (q != NULL && q->entry.Template.ll_ptr2 != NULL) - q = q->entry.Template.ll_ptr2; - if (q == NULL) - final_list = star_range_list; - else - q->entry.Template.ll_ptr2 = star_range_list; - return (final_list); -} -/* buid_recur_expr will try to reduce simple recurrences like */ -/* i = i+1 in loop into expressions involving an induction var*/ -PTR_LLND build_recur_expr(stmt, s,lls, lld) -PTR_BFND stmt; -PTR_SYMB s; -PTR_LLND lls,lld; -{ - PTR_BFND parent; - PTR_LLND init_val, index_ref, rhs, new_expr, coef, lb, one; - PTR_LLND copy_llnd(); - - parent = stmt->control_parent; - if(parent->variant == FOR_NODE || parent->variant == CDOALL_NODE){ - if(stmt->variant == ASSIGN_STAT){ - init_val = lld->entry.Template.ll_ptr1; - lb = copy_llnd(parent->entry.Template.ll_ptr1->entry.Template.ll_ptr1); - index_ref = make_llnd(cur_file,VAR_REF,NULL,NULL, - parent->entry.Template.symbol); - one = make_llnd(cur_file,INT_VAL,NULL,NULL,NULL); - one->entry.ival = 0; - lb = make_llnd(cur_file,SUBT_OP,one,lb,NULL); - index_ref = make_llnd(cur_file,ADD_OP,index_ref,lb,NULL); - rhs = stmt->entry.Template.ll_ptr2; - /* - printf("index:%s init_val:%s rhs:%s", - (UnparseLlnd[cur_file->lang])(index_ref), - (UnparseLlnd[cur_file->lang])(init_val), - (UnparseLlnd[cur_file->lang])(rhs)); - */ - if(rhs->variant == ADD_OP){ - if(rhs->entry.Template.ll_ptr1 == lld) - coef = rhs->entry.Template.ll_ptr2; - else if(rhs->entry.Template.ll_ptr2 == lld) - coef = rhs->entry.Template.ll_ptr1; - else return NULL; - new_expr = make_llnd(cur_file,MULT_OP, - copy_llnd(coef),index_ref,NULL); - new_expr = make_llnd(cur_file,ADD_OP,new_expr,init_val,NULL); - /*printf("new expr:%s",(UnparseLlnd[cur_file->lang])(new_expr));*/ - return new_expr; - } - else if(rhs->variant == SUBT_OP){ - if(rhs->entry.Template.ll_ptr1 == lld) - coef = rhs->entry.Template.ll_ptr2; - else return NULL; - if(coef == NULL) return NULL; - new_expr = make_llnd(cur_file,MULT_OP, - copy_llnd(coef),index_ref,NULL); - new_expr = make_llnd(cur_file,SUBT_OP,init_val,new_expr,NULL); - /*printf("new expr:%s",(UnparseLlnd[cur_file->lang])(new_expr));*/ - return new_expr; - } - else return NULL; - } - else return NULL; - } - else return NULL; -} -/* propogate will do the scalar propogation. (test version). */ -void propogate(def, use) -PTR_REFL def, use; -{ - PTR_REFL g; /* temporary reference list */ - PTR_SYMB s; /* symbol for varialble name */ - PTR_LLND lls, lld; /* term source and destination */ - PTR_BFND bns; /* biff nd source and destination */ - PTR_LLND p; - - /* search through each of the definitions */ - while (def != NULL) { - s = def->id; /* s is the symbol table entry */ - g = use; - if ((s != NULL) && (s->type != NULL) && - (s->type->variant == T_INT)) - while (g != NULL) { - if (g->id == s) { - lld = g->node->refer; - if (def->node->stmt == g->node->stmt) { - /* definition is reaching itself where it is used */ - /* printf("recurrence\n"); */ - lld = g->node->refer; - lls = def->node->refer; - if(lld->entry.Template.ll_ptr1 != NULL) - lld->entry.Template.ll_ptr1 = build_recur_expr(g->node->stmt,s,lls,lld); - else lld->entry.Template.ll_ptr1 = NULL; - } - else{ - /* a definition is reaching a different use */ - bns = def->node->stmt; - lld = g->node->refer; - lls = def->node->refer; - if (bns->variant == FOR_NODE) { - lld->entry.Template.ll_ptr1 = NULL; - } - else if (bns->variant != EXPR_STMT_NODE) { - /* a Fortran assignment, p <- rhs of source */ - p = bns->entry.Template.ll_ptr2; - if (lld->entry.Template.ll_ptr1 == NULL) - lld->entry.Template.ll_ptr1 = p; - else if (lld->entry.Template.ll_ptr1 != p) - lld->entry.Template.ll_ptr1 = NULL; - } - else { - /* a C EXPR_STMT_NODE */ - p = bns->entry.Template.ll_ptr1; - /* assume it is expr list then asign op */ - p = p->entry.Template.ll_ptr1; - while (p != NULL && - p->entry.Template.ll_ptr1 != lls) - p = p->entry.Template.ll_ptr2; - if (p != NULL) - p = p->entry.Template.ll_ptr2; - if (lld->entry.Template.ll_ptr1 == NULL) - lld->entry.Template.ll_ptr1 = p; - else if (lld->entry.Template.ll_ptr1 != p) - lld->entry.Template.ll_ptr1 = NULL; - } - } - } - else { - /* symbols do not agree */ - } - g = g->next; - } - def = def->next; - } -} - - -/***************************************************************/ -/* build sets is called four times.Once with pass = 1 and once */ -/* with pass = 2. On the first pass: */ -/* 1. synthesized attributes: gen and use are passed up tree */ -/* 2. the id fields of the biff nodes are renumbered in */ -/* control flow tree preorder. i.e. lexical order */ -/* on the second pass: */ -/* 1. the inherited attributes are propogated down the tree */ -/* 2. dependence arcs are generated. */ -/* the variable rnd is used to destinguish between using info */ -/* from a global analysis sweep and ignoring the effect of */ -/* function calls. */ -/***************************************************************/ -PTR_SETS build_sets(int rnd, PTR_BFND b, PTR_REFL in_use, PTR_REFL in_def,int pass) -/*int rnd;*/ /* rnd = 0 first time and rnd = 1 after - * global analysis */ -/*PTR_BFND b;*/ -/*PTR_REFL in_use, in_def;*/ -/*int pass;*/ -{ - PTR_BLOB bl; - PTR_SETS s; - PTR_REFL gen, use, out_use, out_def, detmp; - PTR_REFL out_useT, out_useF, out_defT, out_defF; - PTR_REFL remove_locals(); - PTR_LLND link_set_list(); - PTR_REFL tmp1, tmp2, tmp3; - - if (b == NULL) - fprintf(stderr, "null bfnd!!\n"); - - if (b != NULL) - switch (b->variant) { - - case GLOBAL: - node_count = 0; - bl = b->entry.Template.bl_ptr1; - b->id = node_count++; - while ((bl != NULL) && (bl->ref != b)) { - if ((bl->ref->variant == PROG_HEDR) || - (bl->ref->variant == FUNC_HEDR) || - (bl->ref->variant == PROC_HEDR)) - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - bl = bl->next; - } - break; - - case PROG_HEDR: - /* PASS 1 ---------------------- */ - /* visit each child */ - if (pass == 1) { - b->id = node_count++; - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->out_use = NULL; - b->entry.Template.sets->in_use = NULL; - b->entry.Template.sets->out_def = NULL; - b->entry.Template.sets->in_def = NULL; - b->entry.Template.sets->gen = NULL; - b->entry.Template.sets->use = NULL; - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - bl = bl->next; - } - return (b->entry.Template.sets); - } - else { - PTR_REFL t1, t2; - /* PASS 2 ---------------------- */ - in_use = NULL; - out_def = NULL; - out_use = NULL; - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_use, out_def, pass); - out_use = s->out_use; - out_def = s->out_def; - bl = bl->next; - } - /* at this point intersect out_use and */ - /* out_def with the global and commons */ - /* and set to out_use and out_def */ - t1 = intersect_refl(b->entry.Template.sets->in_def, out_def); - t2 = remove_locals_from_list(out_def); - b->entry.Template.sets->out_def = union_refl(t1, t2); - disp_refl(t1); - disp_refl(t2); - t1 = intersect_refl(b->entry.Template.sets->in_def, out_use); - t2 = remove_locals_from_list(out_use); - b->entry.Template.sets->out_use = union_refl(t1, t2); - disp_refl(t1); - disp_refl(t2); - if (rnd == 0) { - fprintf(stderr, "%%program %s --\n", - b->entry.procedure.proc_symb->ident); - fprintf(stderr, "%s\n", - b->entry.procedure.proc_symb->ident); - fprintf(stderr, ">>L %d \n", b->g_line); - fprintf(stderr, "%%defines variables\n"); - b->entry.Template.ll_ptr2 = - make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); - b->entry.Template.ll_ptr2->entry.Template.ll_ptr1 = - link_set_list(b->entry.Template.sets->out_def); - b->entry.Template.ll_ptr3 = - make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); - b->entry.Template.ll_ptr3->entry.Template.ll_ptr1 = - link_set_list(b->entry.Template.sets->out_use); - fprintf(stderr, "%s", - (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr2)); - fprintf(stderr, "%% and uses\n"); - fprintf(stderr, "%s\n", - (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr3)); - fprintf(stderr, "\n"); - } - return (b->entry.Template.sets); - } - - case PROC_HEDR: - case FUNC_HEDR: - /* PASS 1 ---------------------- */ - if (pass == 1) { - b->id = node_count++; - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->out_use = NULL; - b->entry.Template.sets->in_use = NULL; - b->entry.Template.sets->out_def = NULL; - b->entry.Template.sets->in_def = NULL; - b->entry.Template.sets->gen = NULL; - b->entry.Template.sets->use = NULL; - /* set in_def to be a ref list of all */ - /* parameters to this proc. this is */ - /* appended with commons and then it is */ - /* interesected with the real ref and */ - /* use list in pass 2. */ - b->entry.Template.sets->in_def = - make_name_list(b->entry.Template.symbol->entry.proc_decl.in_list); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - bl = bl->next; - } - return (b->entry.Template.sets); - } - else { - PTR_REFL t1, t2; - - /* PASS 2 ---------------------- */ - /* visit each child */ - /* in_def = in_params; in_use = {}; out_def = in_def; out_use = {}; - * for each child do pass out_use and out_def; visit child; out_use = - * child.out_use; out_def = child.out_def; end; */ - in_use = NULL; - out_def = NULL; - out_use = NULL; - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_use, out_def, pass); - out_use = s->out_use; - out_def = s->out_def; - bl = bl->next; - } - /* interest out_use and out_def with the */ - /* parameters and common statements */ - t1 = intersect_refl(b->entry.Template.sets->in_def, out_def); - t2 = remove_locals_from_list(out_def); - b->entry.Template.sets->out_def = union_refl(t1, t2); - disp_refl(t1); - disp_refl(t2); - t1 = intersect_refl(b->entry.Template.sets->in_def, out_use); - t2 = remove_locals_from_list(out_use); - b->entry.Template.sets->out_use = union_refl(t1, t2); - disp_refl(t1); - disp_refl(t2); - t1 = b->entry.Template.sets->out_def; - t2 = b->entry.Template.sets->out_use; - if (rnd == 0) { - b->entry.Template.ll_ptr2 = - make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); - b->entry.Template.ll_ptr2->entry.Template.ll_ptr1 = - link_set_list(t1); - b->entry.Template.ll_ptr3 = - make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); - b->entry.Template.ll_ptr3->entry.Template.ll_ptr1 = - link_set_list(t2); - fprintf(stderr, "%%procedure %s-\n", - b->entry.procedure.proc_symb->ident); - fprintf(stderr, "%s", (UnparseBfnd[cur_file->lang])(b)); - fprintf(stderr, ">>L %d \n", b->g_line); - fprintf(stderr, "%%which defines values for-\n"); - fprintf(stderr, "%s", - (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr2)); - fprintf(stderr, "\n%%and uses values-\n"); - fprintf(stderr, "%s\n", - (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr3)); - } - return (b->entry.Template.sets); - } - case COMM_STAT: - if (pass == 1) { - b->id = node_count++; - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->gen = NULL; - b->entry.Template.sets->use = NULL; - /* now gather up all the varaibles and */ - /* link them in to the parent node. */ - /* not done yet. */ - detmp = NULL; - tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); - tmp2 = b->control_parent->entry.Template.sets->in_def; - while ((tmp2 != NULL) && (tmp2->next != NULL)) - tmp2 = tmp2->next; - if (tmp2 == NULL) - b->control_parent->entry.Template.sets->in_def = tmp1; - else - tmp2->next = tmp1; - return (b->entry.Template.sets); - } - else { - /* PASS 2 ----------------------- */ - /* just pass everything through! */ - b->entry.Template.sets->out_def = in_def; - b->entry.Template.sets->out_use = in_use; - return (b->entry.Template.sets); - } - case EXPR_STMT_NODE: - /* PASS 1 ----------------------- */ - /* make synth. attribs gen, use */ - if (pass == 1) { - b->id = node_count++; - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - if (b->entry.Template.sets->gen == NULL) { - detmp = NULL; - tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); - /* we only want the first. the others are uses */ - b->entry.Template.sets->gen = detmp; - b->entry.Template.sets->use = tmp1; - } - return (b->entry.Template.sets); - } - else { - /* PASS 2 ----------------------- */ - b->entry.Template.sets->in_use = copy_refl(in_use); - b->entry.Template.sets->in_def = copy_refl(in_def); - - /* set local kill = { X in in_def | ref(X) in gen } */ - out_def = rem_kill(in_def, b->entry.Template.sets->gen); - - assign(&out_def,union_refl(out_def, b->entry.Template.sets->gen)); - b->entry.Template.sets->out_def = out_def; - - /* out_use = in_use + use */ - b->entry.Template.sets->out_use = - union_refl(in_use, b->entry.Template.sets->use); - propogate(in_def, b->entry.Template.sets->use); - return (b->entry.Template.sets); - } - case ASSIGN_STAT: - case M_ASSIGN_STAT: - case SUM_ACC: - case MULT_ACC: - case MAX_ACC: - case MIN_ACC: - case CAT_ACC: - case OR_ACC: - case AND_ACC: - case READ_STAT: - case WRITE_STAT: - case PROC_STAT: - /* PASS 1 ----------------------- */ - /* make synth. attribs gen, use */ - if (pass == 1) { - b->id = node_count++; - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - if (b->entry.Template.sets->gen == NULL) { - detmp = NULL; - tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); - if (b->variant == PROC_STAT) { - b->entry.Template.sets->gen = detmp; - b->entry.Template.sets->use = tmp1; - return (b->entry.Template.sets); - } - /* we only want the first. the others are uses */ - if (tmp1 == NULL) { - tmp2 = NULL; - b->entry.Template.sets->gen = NULL; - } - else { - tmp2 = tmp1->next; - tmp1->next = NULL; - b->entry.Template.sets->gen = tmp1; - } - } - else - tmp2 = NULL; - if (b->entry.Template.sets->use == NULL) { - detmp = NULL; - tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); - if (tmp2 != NULL) { - tmp3 = union_refl(tmp1, tmp2); - disp_refl(tmp1); - disp_refl(tmp2); - } - else - tmp3 = tmp1; - b->entry.Template.sets->use = tmp3; - } - return (b->entry.Template.sets); - } - else { - /* PASS 2 ----------------------- */ - b->entry.Template.sets->in_use = copy_refl(in_use); - b->entry.Template.sets->in_def = copy_refl(in_def); - - /* set local kill = { X in in_def | ref(X) in gen } */ - out_def = rem_kill(in_def, b->entry.Template.sets->gen); - - /* create synth. attrib. out_def = in_def - kill + gen */ - assign(&out_def, - union_refl(out_def, b->entry.Template.sets->gen) - ); - b->entry.Template.sets->out_def = out_def; - - /* out_use = in_use + use */ - b->entry.Template.sets->out_use = - union_refl(in_use, b->entry.Template.sets->use); - - propogate(in_def, b->entry.Template.sets->use); - return (b->entry.Template.sets); - } - - case LOOP_NODE: - case FOR_NODE: - case WHILE_NODE: - /* PASS 1 ---------------------- */ - /* for each child collect gen and use */ - if (pass == 1) { - b->id = node_count++; - use = NULL; - gen = NULL; - detmp = NULL; - if (b->entry.Template.symbol == NULL) { /* this is a C loop */ - use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); - gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); - assign(&use, union_refl(use, gen)); - gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr3); - assign(&use, union_refl(use, gen)); - assign(&gen, detmp); - } - else - use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - assign(&use, union_refl(use, s->use)); - gen = rem_kill(gen, s->gen); /* try to fix propogation prob */ - assign(&gen, union_refl(gen, s->gen)); - bl = bl->next; - } - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->out_use = NULL; - b->entry.Template.sets->in_use = NULL; - b->entry.Template.sets->out_def = NULL; - b->entry.Template.sets->in_def = NULL; - b->entry.Template.sets->gen = remove_locals(b, gen); - b->entry.Template.sets->use = remove_locals(b, use); - return (b->entry.Template.sets); - } - else { - /* PASS 2 ---------------------- */ - s = b->entry.Template.sets; - b->entry.Template.sets->in_use = copy_refl(in_use); - b->entry.Template.sets->out_def = copy_refl(in_def); - /* first take care of range varible propogation. */ - detmp = NULL; - if (b->entry.Template.symbol == NULL) { /* this is a C loop */ - use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); - gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); - assign(&use, union_refl(use, gen)); - gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr3); - assign(&use, union_refl(use, gen)); - gen = detmp; - } - else - use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); - propogate(in_def, use); - /* now take care of children */ - out_use = union_refl(in_use, s->use); - out_def = union_refl(in_def, s->gen); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_use, out_def, pass); - assign(&out_use, copy_refl(s->out_use)); - assign(&out_def, copy_refl(s->out_def)); - bl = bl->next; - } - b->entry.Template.sets->out_use = out_use; - b->entry.Template.sets->out_def = out_def; - return (b->entry.Template.sets); - } - case PARFOR_NODE: - case CDOALL_NODE: - /* PASS 1 ---------------------- */ - /* for each child collect gen and use */ - if (pass == 1) { - b->id = node_count++; - use = NULL; - gen = NULL; - detmp = NULL; - if (b->variant == PARFOR_NODE) { - use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); - bl = b->entry.Template.bl_ptr1; - } - else { - use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); - bl = b->entry.Template.bl_ptr2; - } - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - assign(&use, union_refl(use, s->use)); - assign(&gen, union_refl(gen, s->gen)); - bl = bl->next; - } - if (b->variant == CDOALL_NODE && - b->entry.Template.bl_ptr1 != NULL) { - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - assign(&use, union_refl(use, s->use)); - assign(&gen, union_refl(gen, s->gen)); - bl = bl->next; - } - } - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->out_use = NULL; - b->entry.Template.sets->in_use = NULL; - b->entry.Template.sets->out_def = NULL; - b->entry.Template.sets->in_def = NULL; - /* here is difference with other loops */ - /* locals must be deleted from gen and use */ - b->entry.Template.sets->gen = remove_locals(b, gen); - b->entry.Template.sets->use = remove_locals(b, use); - return (b->entry.Template.sets); - } - else { - /* PASS 2 ---------------------- */ - s = b->entry.Template.sets; - b->entry.Template.sets->in_use = copy_refl(in_use); - b->entry.Template.sets->in_def = copy_refl(in_def); - detmp = NULL; - if (b->variant == PARFOR_NODE) { - use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); - bl = b->entry.Template.bl_ptr1; - } - else { - use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); - bl = b->entry.Template.bl_ptr2; - } - out_use = union_refl(in_use, s->use); - out_def = union_refl(in_def, s->gen); - propogate(in_def, use); - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_use, out_def, pass); - assign(&out_use, copy_refl(s->out_use)); - assign(&out_def, copy_refl(s->out_def)); - bl = bl->next; - } - if (b->variant == CDOALL_NODE && - b->entry.Template.bl_ptr1 != NULL) { - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_use, out_def, pass); - assign(&out_use, copy_refl(s->out_use)); - assign(&out_def, copy_refl(s->out_def)); - bl = bl->next; - } - } - b->entry.Template.sets->out_use = out_use; - b->entry.Template.sets->out_def = out_def; - return (b->entry.Template.sets); - } - case LOGIF_NODE: - case ELSEIF_NODE: - case IF_NODE: - /* PASS 1 ---------------------- */ - /* for each child collect gen and use */ - if (pass == 1) { - b->id = node_count++; - use = NULL; - gen = NULL; - use = gather_refl(rnd, &gen, b, b->entry.Template.ll_ptr1); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - assign(&use, union_refl(use, s->use)); - assign(&gen, union_refl(gen, s->gen)); - bl = bl->next; - } - if (b->variant != LOGIF_NODE) { - bl = b->entry.Template.bl_ptr2; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, NULL, NULL, pass); - assign(&use, union_refl(use, s->use)); - assign(&gen, union_refl(gen, s->gen)); - bl = bl->next; - } - } - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->out_use = NULL; - b->entry.Template.sets->in_use = NULL; - b->entry.Template.sets->out_def = NULL; - b->entry.Template.sets->in_def = NULL; - b->entry.Template.sets->gen = gen; - b->entry.Template.sets->use = use; - return (b->entry.Template.sets); - } - else { - /* PASS 2 ------------------------------------------------ */ - /* for each branch do */ - /* out_use = in_use; out_def_branch = in_def; */ - /* for each child do */ - /* pass out_use and out_def_branch; */ - /* visit child */ - /* out_use = child.out_use; */ - /* out_def_branch = child.out_def; */ - /* end; */ - /* out_def = out_def_lbranch+out_def_rbranch */ - /* ________________________________________________________ */ - out_defT = in_def; - out_useT = in_use; - /* visit True children */ - b->entry.Template.sets->in_use = - copy_refl(in_use); - b->entry.Template.sets->in_def = - copy_refl(in_def); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_useT, out_defT, pass); - out_useT = s->out_use; - out_defT = s->out_def; - bl = bl->next; - } - out_defF = in_def; - out_useF = in_use; - /* visit False children */ - bl = b->entry.Template.bl_ptr2; - while ((bl != NULL) && (bl->ref != b)) { - s = build_sets(rnd, bl->ref, out_useF, out_defF, pass); - out_useF = s->out_use; - out_defF = s->out_def; - bl = bl->next; - } - gen = NULL; - use = gather_refl(rnd, &gen, b, b->entry.Template.ll_ptr1); - assign(&use, union_refl(out_useF, use)); - assign(&gen, union_refl(out_defF, gen)); - b->entry.Template.sets->out_use = - union_refl(use, out_useT); - b->entry.Template.sets->out_def = - union_refl(gen, out_defT); - - return (b->entry.Template.sets); - } - case EXIT_NODE: - fprintf(stderr, "exit node found! no dep ananysis!\n"); - - default: /* assume a no op */ - if (pass == 1) { - b->id = node_count++; - if (b->entry.Template.sets == NULL) - b->entry.Template.sets = alloc_sets(); - b->entry.Template.sets->gen = NULL; - b->entry.Template.sets->use = NULL; - return (b->entry.Template.sets); - } - else { - /* PASS 2 ----------------------- */ - /* just pass everything through! */ - b->entry.Template.sets->out_def = in_def; - b->entry.Template.sets->out_use = in_use; - return (b->entry.Template.sets); - } - } - return (NULL); -} - -void gendeps(b) -PTR_BFND b; -{ - PTR_BLOB bl; - - if (b != NULL) - switch (b->variant) { - - case GLOBAL: - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - bl = bl->next; - } - break; - - case PROG_HEDR: - /* visit each child */ - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - bl = bl->next; - } - break; - case PROC_HEDR: - case FUNC_HEDR: - /* visit each child */ - if (show_deps) - fprintf(stderr, "---------Procedure %s------------------\n", - b->entry.procedure.proc_symb->ident); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - if (num_ll_allocated > 10000) - collect_garbage(cur_file); - bl = bl->next; - } - break; - case EXPR_STMT_NODE: - case ASSIGN_STAT: - case M_ASSIGN_STAT: - case SUM_ACC: - case MULT_ACC: - case MAX_ACC: - case MIN_ACC: - case CAT_ACC: - case OR_ACC: - case AND_ACC: - case READ_STAT: - case WRITE_STAT: - case PROC_STAT: - if (num_ll_allocated > 10000) - collect_garbage(cur_file); - if (show_deps) - fprintf(stderr, "----- line %d \n", b->g_line); - make_deps(FLOWD, b->entry.Template.sets->in_def, - b->entry.Template.sets->use); - - make_deps(OUTPUTD, b->entry.Template.sets->in_def, - b->entry.Template.sets->gen); - - make_deps(ANTID, b->entry.Template.sets->in_use, - b->entry.Template.sets->gen); - - make_deps(INPUTD, b->entry.Template.sets->in_use, - b->entry.Template.sets->use); - - break; - - case LOOP_NODE: - case FOR_NODE: - case WHILE_NODE: - if (show_deps) - fprintf(stderr, "----- line %d \n", b->g_line); - make_deps(FLOWD, b->entry.Template.sets->in_def, - b->entry.Template.sets->use); - - make_deps(OUTPUTD, b->entry.Template.sets->in_def, - b->entry.Template.sets->gen); - - make_deps(ANTID, b->entry.Template.sets->in_use, - b->entry.Template.sets->gen); - - make_deps(INPUTD, b->entry.Template.sets->in_use, - b->entry.Template.sets->use); - - if (num_ll_allocated > 10000) - collect_garbage(cur_file); - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - if (num_ll_allocated > 10000) - collect_garbage(cur_file); - bl = bl->next; - } - break; - case FORALL_NODE: - case CDOALL_NODE: - case PARFOR_NODE: - if (show_deps) - fprintf(stderr, "----- line %d \n", b->g_line); - make_deps(FLOWD, b->entry.Template.sets->in_def, - b->entry.Template.sets->use); - - make_deps(OUTPUTD, b->entry.Template.sets->in_def, - b->entry.Template.sets->gen); - - make_deps(ANTID, b->entry.Template.sets->in_use, - b->entry.Template.sets->gen); - - make_deps(INPUTD, b->entry.Template.sets->in_use, - b->entry.Template.sets->use); - - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - bl = bl->next; - } - break; - case LOGIF_NODE: - case IF_NODE: - if (show_deps) - fprintf(stderr, "----- line %d \n", b->g_line); - make_deps(FLOWD, b->entry.Template.sets->in_def, - b->entry.Template.sets->use); - - make_deps(OUTPUTD, b->entry.Template.sets->in_def, - b->entry.Template.sets->gen); - - make_deps(ANTID, b->entry.Template.sets->in_use, - b->entry.Template.sets->gen); - - make_deps(INPUTD, b->entry.Template.sets->in_use, - b->entry.Template.sets->use); - - /* visit True children */ - bl = b->entry.Template.bl_ptr1; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - if (num_ll_allocated > 10000) - collect_garbage(cur_file); - bl = bl->next; - } - /* visit False children */ - if (b->variant != LOGIF_NODE) { - bl = b->entry.Template.bl_ptr2; - while ((bl != NULL) && (bl->ref != b)) { - gendeps(bl->ref); - if (num_ll_allocated > 10000) - collect_garbage(cur_file); - bl = bl->next; - } - } - break; - case EXIT_NODE: - fprintf(stderr, "exit node found! no dep ananysis!\n"); - break; - default: /* assume a no op */ - /* just pass everything through! */ - break; - } -} - -void relink(fi) -PTR_FILE fi; -{ - PTR_BFND bf_ptr; - int count = 1; - - for (bf_ptr = fi->head_bfnd; bf_ptr != NULL; bf_ptr = bf_ptr->thread) - bf_ptr->id = count++; -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/setutils.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/setutils.c deleted file mode 100644 index eba6593..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/setutils.c +++ /dev/null @@ -1,2518 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* file: setutils.c */ -#include -#include "db.h" - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -extern PCF UnparseBfnd[]; -extern PCF UnparseLlnd[]; - -PTR_SYMB induct_list[MAX_NEST_DEPTH]; -int stride[MAX_NEST_DEPTH]; -int is_forall[MAX_NEST_DEPTH]; - -/* variable default value structure. */ -struct dflts { - PTR_SYMB name; - int value; - struct dflts *next; -}; - -typedef struct dflts *PTR_DFLT; -PTR_DFLT glob_dflts = NULL; -PTR_SETS free_sets = NULL; -PTR_REFL free_refl = NULL; -PTR_DEP free_dep = NULL; -/*char *malloc();*/ - -extern PTR_FILE cur_file; -extern int language; - -/* Forward declarations */ -int is_not_loc(); -void disp_refl(); -int make_range(); -void disp_refl(); -int make_induct_list(); - -extern int identical(); -extern int integer_difference(); - -int get_dflt(df, s) -int *df; -PTR_SYMB s; -{ - PTR_DFLT p; - int v; - - p = glob_dflts; - *df = 1; - while (p != NULL) { - if (p->name == s) - return (p->value); - p = p->next; - } - p = (PTR_DFLT) malloc(sizeof(struct dflts)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - p->next = glob_dflts; - glob_dflts = p; - p->name = s; - *df = 1; - v = 100; - p->value = v; - return (v); -} - -PTR_SETS alloc_sets() -{ - PTR_SETS s; - - s = (PTR_SETS) malloc(sizeof(struct sets)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,s, 0); -#endif - if (s == NULL) - fprintf(stderr, "! out of space for sets!!\n"); - s->use = NULL; - s->gen = NULL; - s->in_use = NULL; - s->in_def = NULL; - s->out_use = NULL; - s->out_def = NULL; - s->arefl = NULL; - return (s); -} - -/*********************************************************************/ -/* is_not_local() is used to find out if a reference is to a global */ -/* variable. The way it works is that it traverses the biffnd tree */ -/* up to the level of a procedure or function checking for local */ -/* declarations. It understands the static scoping of C. */ -/*********************************************************************/ -static int search_for_dec(b, s) -PTR_BFND b; -PTR_SYMB s; -{ - PTR_BFND par; - PTR_BLOB p; - PTR_LLND ll, def; - - par = b->control_parent; - p = par->entry.Template.bl_ptr1; - while (p != NULL && p->ref != b) { - switch (p->ref->variant) { - case VAR_DECL: - case STRUCT_DECL: - ll = p->ref->entry.Template.ll_ptr1; - while (ll != NULL) { - def = ll->entry.Template.ll_ptr1; - while (def != NULL && def->variant == DEREF_OP) - def = def->entry.Template.ll_ptr1; - - if ((def != NULL) && - (def->variant == VAR_REF || def->variant == ARRAY_REF) - && (s == def->entry.Template.symbol)) - return (0); - ll = ll->entry.Template.ll_ptr2; - } - break; - default: - break; - } - p = p->next; - } - if (par->variant == GLOBAL || par->variant == FUNC_HEDR) - return (1); - else - return (search_for_dec(par, s)); -} - -int non_exec_statement(fBF) -PTR_BFND fBF; -{ - switch (fBF->variant) { - case PROS_COMM: - case COMM_STAT: - case EXTERN_STAT: - case INTRIN_STAT: - case EQUI_STAT: - case STMTFN_STAT: - case ATTR_DECL: - case DIM_STAT: - case VAR_DECL: - case PARAM_DECL: - case IMPL_DECL: - case DATA_DECL: - case SAVE_DECL: - case BLOCK_DATA: - case COMMENT_STAT: - case ENTRY_STAT: - case CONTROL_END: - return (1); - default: - return (0); - } -} - -int search_for_common_decl(b, s) -PTR_BFND b; -PTR_SYMB s; -{ - PTR_BFND par; - PTR_BLOB p; - PTR_LLND ll, def; - - par = b; - while (par != NULL && par->variant != PROG_HEDR && - par->variant != PROC_HEDR && - par->variant != FUNC_HEDR) - par = par->control_parent; - if (par == NULL) - return (0); - - p = par->entry.Template.bl_ptr1; - while (p != NULL && non_exec_statement(p->ref)) { - if (p->ref->variant == COMM_STAT) { - ll = p->ref->entry.Template.ll_ptr1; /* COMM_LIST */ - ll = ll->entry.Template.ll_ptr1; /* EXPR_LIST */ - while (ll != NULL) { - def = ll->entry.Template.ll_ptr1; - if ((def != NULL) && - (def->variant == VAR_REF || def->variant == ARRAY_REF) && - (s == def->entry.Template.symbol)) - return (1); - ll = ll->entry.Template.ll_ptr2; - } - } - p = p->next; - } - return (0); -} - -int is_not_local(r) -struct ref *r; -{ - PTR_BFND b; - PTR_LLND ll; - - b = r->stmt; - ll = r->refer; - return (is_not_loc(b, ll)); -} - -int is_not_loc(b, ll) -PTR_BFND b; -PTR_LLND ll; -{ - PTR_BFND curfun; - PTR_SYMB s, params; - PTR_LLND q; - int i; - - curfun = b; - while (curfun != NULL && curfun->variant != GLOBAL && - curfun->variant != FUNC_HEDR && curfun->variant != PROC_HEDR) - curfun = curfun->control_parent; - if (curfun->variant == FUNC_HEDR || curfun->variant == PROC_HEDR) { - params = curfun->entry.Template.symbol; - params = params->entry.proc_decl.in_list; - } - else - params = NULL; - - switch (ll->variant) { - case VAR_REF: - case ARRAY_REF: - s = ll->entry.Template.symbol; - break; - case POINTST_OP: - q = ll; - while (q != NULL && q->variant != VAR_REF) - q = q->entry.Template.ll_ptr1; - if (q == NULL) - return (1); - else { - s = q->entry.Template.symbol; - } - break; - default: - s = NULL; - break; - } - while (s != NULL && params != NULL) { - if (params == s) - return (1); - params = params->entry.var_decl.next_in; - } - if (language == ForSrc) { - if (search_for_common_decl(b, s)) - return (1); - if (s->attr == 1) - return (1); /* attribute is global */ - return (0); - } - if (s != NULL) { - if ((i = search_for_dec(b, s)) == 0) { - } - else { - } - return (i); - } - else { - return (1); - } -} - -PTR_REFL remove_locals_from_list(rl) -PTR_REFL rl; -{ - PTR_REFL t, local, global; - - local = NULL; - global = NULL; - while (rl != NULL) { - if (is_not_local(rl->node)) { - t = rl; - rl = rl->next; - t->next = global; - global = t; - } - else { - t = rl; - rl = rl->next; - t->next = local; - local = t; - } - } - disp_refl(local); - return (global); -} - -int subsumed(p, q) -PTR_LLND p,q; -{ - PTR_LLND pind[10], qind[10], newpind[10], t; - int pdim, qdim, i, same, not_same[10], k,ns ; - - if (p->variant != ARRAY_REF) - return (0); - if (q->variant != ARRAY_REF) - return (0); - if (p->entry.Template.symbol != q->entry.Template.symbol) - return (0); - - pdim = 0; - t = p->entry.Template.ll_ptr1; - while(t && (t->variant == EXPR_LIST) && pdim < 10){ - pind[pdim++] = t; - t = t->entry.Template.ll_ptr2; - /* printf("pind[%d] = %s",pdim-1,(UnparseLlnd[cur_file->lang])(pind[pdim-1]));*/ - } - qdim = 0; - t = q->entry.Template.ll_ptr1; - while(t && (t->variant == EXPR_LIST) && qdim < 10){ - qind[qdim++] = t; - t = t->entry.Template.ll_ptr2; - /* printf("qind[%d] = %s",qdim-1,(UnparseLlnd[cur_file->lang])(qind[qdim-1]));*/ - } - - if(pdim != qdim) return 0; - if(pdim == 0) return 1; - - ns = 0; - for(i = 0; i < pdim; i++){ - same = identical(pind[i]->entry.Template.ll_ptr1, - qind[i]->entry.Template.ll_ptr1); - if (same == 0){ ns = 1; not_same[i] = 1;} - else not_same[i] = 0; - } - - if(ns == 0) return 1; - /* if(not_same > 1) return 0; */ - - for(k = 0; k < pdim; k++) - if(not_same[k] && - (make_range(pind[k]->entry.Template.ll_ptr1, - qind[k]->entry.Template.ll_ptr1, &(newpind[k])) == 0)) return 0; - - for(k = 0; k < pdim; k++) - if(not_same[k]){ - if( k == 0) - p->entry.Template.ll_ptr1->entry.Template.ll_ptr1 = newpind[k]; - else - pind[k]->entry.Template.ll_ptr1 = newpind[k]; - } - return 1; -} - -int make_range(p,q, newp) -PTR_LLND p,q, *newp; -{ - PTR_LLND plow, phi, qlow, qhi, newlow, newhi,d1,d2; - PTR_LLND make_llnd(); - int diff, pconst, qconst; - - if(p == NULL) {*newp = NULL; return 1;} - if(q == NULL) {*newp = NULL; return 1;} - if(p->variant == STAR_RANGE){ *newp = p; return 1; } - if(q->variant == STAR_RANGE){ *newp = q; return 1; } - - pconst = qconst = 0; - if(p->variant == DDOT){ - plow = p->entry.Template.ll_ptr1; - phi = p->entry.Template.ll_ptr2; - if(plow == NULL || phi == NULL){ - *newp = make_llnd(cur_file, STAR_RANGE, NULL, NULL); - return 1; - } - if(phi->variant == DDOT) phi = p->entry.Template.ll_ptr1; - } - else {plow = phi = p; pconst = 1;} - if(q->variant == DDOT){ - qlow = q->entry.Template.ll_ptr1; - qhi = q->entry.Template.ll_ptr2; - if(qlow == NULL || qhi == NULL){ - *newp = make_llnd(cur_file, STAR_RANGE, NULL, NULL); - return 1; - } - if(qhi->variant == DDOT) qhi = q->entry.Template.ll_ptr1; - } - else {qlow = qhi = q; qconst = 1;} - if(pconst && qconst == 0){ - if(integer_difference(p,qlow, &diff, &d1) && (diff >= -1)){ - if(diff == 1 || diff == 0){ - /* we have qlow < p ? qhi. we need to know the range of qhi */ - *newp = q; - return 1; - } - else if (diff == -1){ - /* we hve p = qlow-1 < qhi o */ - *newp = make_llnd(cur_file, DDOT, p, qhi, NULL); - return 1; - } - } - if(integer_difference(p,qhi, &diff, &d1) && (diff <= 1)){ - if(diff == -1 || diff == 0){ - /* we have qlow < qhi = p+1 */ - *newp = q; - return 1; - } - else if(diff == 1){ - /* we hve qlow < qhi = p-1 < p */ - *newp = make_llnd(cur_file, DDOT, qlow, p, NULL); - return 1; - } - } - return 0; - } - if(pconst == 0 && qconst){ - if(integer_difference(plow,q, &diff, &d1) && (diff <= 1)){ - if(diff == -1 || diff == 0){ - /* we have plow < q ? phi. we need to know the range of phi */ - *newp = p; - return 1; - } - else if(diff == 1){ - /* we hve q = plow-1= -1)){ - if(diff == 1 || diff == 0){ - /* we have qlow ? p < qhi */ - *newp = p; - return 1; - } - else if(diff == -1){ - /* we hve plow < phi = q-1lang])(d1)); */ - return 0; - } - if(diff <= 0) newlow = plow; else newlow = qlow; - if(integer_difference(phi, qhi, &diff,&d2) == 0){ - /* printf("hi diff is %s", (UnparseLlnd[cur_file->lang])(d2)); */ - return 0; - } - if(diff <= 0) newhi = qhi; else newhi = phi; - *newp = make_llnd(cur_file, DDOT, newlow, newhi, NULL); - /* printf("new ref is%s",(UnparseLlnd[cur_file->lang])(*newp)); */ - return 1; -} - - - - -PTR_LLND merge_ll_array_list(rl) -PTR_LLND rl; -{ - PTR_LLND t, newlist, junk; - int stop; - - newlist = NULL; - junk = NULL; - while (rl != NULL) { - if (rl->variant != EXPR_LIST) { - fprintf(stderr, "problem in merge_ll_array_list, not exprlist\n%s\n", - (UnparseLlnd[cur_file->lang])(rl)); - break; - } - t = newlist; - stop = 0; - while (t != NULL) { - if (subsumed(t->entry.Template.ll_ptr1, - rl->entry.Template.ll_ptr1)) { - stop = 1; - } - t = t->entry.Template.ll_ptr2; - } - if (stop == 0) { - t = rl; - rl = rl->entry.Template.ll_ptr2; - t->entry.Template.ll_ptr2 = newlist; - newlist = t; - } - else { - t = rl; - rl = rl->entry.Template.ll_ptr2; - t->entry.Template.ll_ptr2 = junk; - junk = t; - } - } - return (newlist); -} - -PTR_REFL merge_array_refs(rl) -PTR_REFL rl; -{ - - PTR_REFL t, newlist, junk; - int stop; - - newlist = NULL; - junk = NULL; - while (rl != NULL) { - t = newlist; - stop = 0; - while (t != NULL) { - if (subsumed(t->node->refer, rl->node->refer)) { - stop = 1; - } - t = t->next; - } - if (stop == 0) { - t = rl; - rl = rl->next; - t->next = newlist; - newlist = t; - } - else { - t = rl; - rl = rl->next; - t->next = junk; - junk = t; - } - } - disp_refl(junk); - return (newlist); -} - - -PTR_REFL alloc_ref(bif, ll) -PTR_BFND bif; -PTR_LLND ll; -{ - struct ref *p; - PTR_REFL q; - if ((bif == NULL) || (ll == NULL)) - return (NULL); - - if ((ll->variant == VAR_REF) || (ll->variant == ARRAY_REF) || - (ll->variant == RECORD_REF) || (ll->variant == POINTST_OP)) { - p = (struct ref *) malloc(sizeof(struct ref)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,p, 0); -#endif - if (p == NULL) - fprintf(stderr, "! out of space for references !!\n"); - p->stmt = bif; - p->refer = ll; - if (free_refl != NULL) { - q = free_refl; - free_refl = free_refl->next; - } - else - { - q = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,q, 0); -#endif - } - if (q == NULL) - fprintf(stderr, "out of space for reference lists !!\n"); - q->next = NULL; - if (ll->variant == RECORD_REF || ll->variant == POINTST_OP) - q->id = NULL; - else - q->id = p->refer->entry.Template.symbol; - q->node = p; - return (q); - } - else - return (NULL); -} - -void disp_refl(p) -PTR_REFL p; -{ - PTR_REFL q; - - while (p != NULL) { - q = p->next; - p->node = NULL; - p->id = NULL; - p->next = free_refl; - free_refl = p; - p = q; - } -} - -PTR_REFL copy_refl(p) -PTR_REFL p; -{ - PTR_REFL q; - PTR_REFL tail, neo_q; - - if (p == NULL) - return (NULL); - q = NULL; - tail = q; - - if (free_refl == NULL) - { - q = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,q, 0); -#endif - } - else { - q = free_refl; - free_refl = free_refl->next; - } - if (q == NULL) { - fprintf(stderr, "!! out of space for reference lists !\n"); - return NULL; - } - q->node = p->node; - q->id = p->id; - q->next = NULL; - /* now copy the rest of p */ - tail = q; - p = p->next; - while (p) { - if (free_refl == NULL) - { - neo_q = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,neo_q, 0); -#endif - } - else { - neo_q = free_refl; - free_refl = free_refl->next; - } - if (neo_q == NULL) { - fprintf(stderr, "!! out of space for reference lists !\n"); - return NULL; - } - neo_q->node = p->node; - neo_q->id = p->id; - neo_q->next = NULL; - tail->next = neo_q; - tail = neo_q; - p = p->next; - } - return q; -} -/* create a new reference list that is the interesction of two others */ -/* the intersection is based on names and the actual reference comes */ -/* from the second argument of the pair. */ -/* in the case of a pair p p->a we include p->a in the intersection */ -PTR_REFL intersect_refl(p, q) -PTR_REFL p, q; -{ - PTR_REFL s, t, inter; - PTR_SYMB id; - PTR_LLND z; - int match_found; - - inter = NULL; - s = q; - while (p != NULL) { - id = p->id; - if (id == NULL) { /* this is a ref to a p->a sub struct */ - z = p->node->refer; - while (z != NULL && z->variant != VAR_REF) - z = z->entry.Template.ll_ptr1; - if (z == NULL) - id = NULL; - else - id = z->entry.Template.symbol; - } - match_found = 0; - while (s != NULL && (match_found == 0)) { - if (s->id == NULL) { /* a ref to a p->a sub struct */ - z = s->node->refer; - while (z != NULL && z->variant != VAR_REF) - z = z->entry.Template.ll_ptr1; - if (z == NULL) - s = s->next; - else if (z->entry.Template.symbol == id) - match_found = 1; - else - s = s->next; - } - else { - if (s->id == id) - match_found = 1; - else - s = s->next; - } - } - - if (match_found && id != NULL) { - if (free_refl == NULL) - { - t = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,t, 0); -#endif - } - else { - t = free_refl; - free_refl = free_refl->next; - } - if (t == NULL) - fprintf(stderr, "!!! out of space for reference lists\n"); - if (p->node != NULL && - (p->node->refer->variant == POINTST_OP || - p->node->refer->variant == RECORD_REF)) { - t->node = p->node; - t->id = NULL; - } - else { - t->node = s->node; - t->id = s->id; - } - t->next = inter; - inter = t; - s = s->next; - } - else { - p = p->next; - s = q; - } - } - return (inter); -} - -/* make name list makes a reference list based on a list of symbol */ -/* table names. The node field is null. This is used for making */ -/* a dummy list for arguments to procedures. */ -PTR_REFL make_name_list(p) -PTR_SYMB p; -{ - PTR_REFL list, t; - - list = NULL; - while (p != NULL) { - if (free_refl == NULL) - { - t = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,t, 0); -#endif - } - else { - t = free_refl; - free_refl = free_refl->next; - } - if (t == NULL) - fprintf(stderr, "!!! out of space for reference lists\n"); - t->node = NULL; - t->id = p; - t->next = list; - list = t; - p = p->entry.var_decl.next_in; - } - return (list); -} - -void append_refl(s, p) /* and remove dups */ -PTR_REFL *s, p; -{ - PTR_REFL t; - struct ref *n; - - while (p != NULL) { - n = p->node; - t = *s; - while ((t != NULL) && (t->node != n)) - t = t->next; - if (t == NULL) { - if (free_refl == NULL) - { - t = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,t, 0); -#endif - } - else { - t = free_refl; - free_refl = free_refl->next; - } - if (t == NULL) - fprintf(stderr, "!!! out of space for reference lists\n"); - t->node = p->node; - t->id = p->id; - t->next = *s; - *s = t; - } - p = p->next; - } -} - -PTR_REFL union_refl(p, q) -PTR_REFL p, q; -{ - PTR_REFL s, t; - struct ref *n; - - s = copy_refl(q); - while (p != NULL) { - n = p->node; - t = q; - while ((t != NULL) && (t->node != n)) - t = t->next; - if (t == NULL) { - if (free_refl == NULL) - { - t = (PTR_REFL)malloc(sizeof(struct refl)); -#ifdef __SPF - addToCollection(__LINE__, __FILE__,t, 0); -#endif - } - else { - t = free_refl; - free_refl = free_refl->next; - } - if (t == NULL) { - fprintf(stderr, "!!! out of space for reference lists\n"); - exit(0); - } - t->node = p->node; - t->id = p->id; - t->next = s; - s = t; - } - p = p->next; - } - return (s); -} - -void assign(to, from) -PTR_REFL *to; -PTR_REFL from; -{ - disp_refl(*to); - *to = from; -} - -void print_refl(p) -PTR_REFL p; -{ - int i; - PTR_LLND z; - - fprintf(stderr, " ref list :"); - i = 0; - while (p != NULL) { - if (p->id != NULL) - fprintf(stderr, " %s", p->id->ident); - else { - fprintf(stderr, " pointer de-ref"); - z = p->node->refer; - while (z != NULL && z->variant != VAR_REF) - z = z->entry.Template.ll_ptr1; - if (z == NULL) - fprintf(stderr, "-unknown"); - else - fprintf(stderr, " %s", z->entry.Template.symbol->ident); - } - p = p->next; - i++; - if (i > 10) { - i = 0; - fprintf(stderr, "\n"); - } - } - fprintf(stderr, "\n"); -} - -int is_param(plist, s) -PTR_REFL plist; -PTR_SYMB s; -{ - while (plist != NULL) { - if (plist->id == s) - return (1); - plist = plist->next; - } - return (0); -} - - -/********************************************************************/ -/* function equiv_ll_exp(p,q) returns 1 if p and q are equivalent */ -/* algebraic expressions. both are low level experessions */ -/********************************************************************/ - -int equiv_ll_exp(p, q) -PTR_LLND p, q; -{ - if (p == NULL && q == NULL) - return (1); - if (p == NULL || q == NULL) - return (0); - return (0); -} - -int flat_check(p, q) -PTR_LLND p, q; -{ - if (p == NULL && q == NULL) - return (1); - if (p == NULL || q == NULL) - return (0); - if (p->variant != q->variant) - return (0); - if (p->variant == VAR_REF || p->variant == ARRAY_REF) { - if (p->entry.var_ref.symbol != q->entry.var_ref.symbol) - return (0); - } - if (flat_check(p->entry.Template.ll_ptr1, q->entry.Template.ll_ptr1) == 0) - return (0); - if (flat_check(p->entry.Template.ll_ptr2, q->entry.Template.ll_ptr2) == 0) - return (0); - return (1); -} - - -/********************************************************************/ -/* function reduce_ll_exp(p,newp) takes a low level pointer and */ -/* returns a new expression (or the same old one) that is a an */ -/* simple algebraic expression in terms of constants and parameter */ -/* common references. the function returns 1 if sucessfull and 0 */ -/* if it failed. if a 2 is returned then an integer value has been*/ -/* generated and its value is return in the value newv. */ -/* newp is the pointer to the new expression. */ -/********************************************************************/ -int reduce_ll_exp(b, plist, induct_list, p, newp, newv) -PTR_BFND b; /* bif node of expression (needed for - * context) */ -PTR_REFL plist; /* list of parameters and commons in - * enclosing scope */ -PTR_SYMB induct_list[]; /* induction variable list for current scope */ -PTR_LLND p, *newp; -int *newv; -{ - int lf, rf, lv, rv; - PTR_LLND lp, rp, make_llnd(); - - lv = 0; - rv = 0; - lf = 0; - rf = 0; - if (p == NULL) { - *newp = NULL; - return (1); - } - if ((p->variant == EXPR_LIST || p->variant == RANGE_LIST) - && p->entry.Template.ll_ptr2 == NULL) - p = p->entry.Template.ll_ptr1; - if (p->variant == VAR_REF) { - /* first check for scalar propogation possibility */ - if (p->entry.Template.ll_ptr1 != NULL) { - lf = reduce_ll_exp(b, plist, induct_list, - p->entry.Template.ll_ptr1, newp, newv); - return (lf); - } - /* second check to see if this is a parameter or global */ - else if (is_param(plist, p->entry.Template.symbol) || - is_not_loc(b, p)) { - *newp = p; - return (1); - } - /* this is some other variable and no propogation */ - /* can reduce it to a simple expression. give up */ - else { - *newp = p; - return (0); - } - } - else if (p->variant == CONST_REF) { - *newp = p->entry.Template.symbol->entry.const_value; - if ((*newp)->variant == INT_VAL) { - *newv = (*newp)->entry.ival; - return (2); - } - return (1); - } - else if (p->variant == INT_VAL) { - *newv = p->entry.ival; - *newp = p; - return (2); - } - else if (p->variant != ADD_OP && p->variant != SUBT_OP && - p->variant != MULT_OP && p->variant != DIV_OP && - p->variant != MINUS_OP) { - *newp = p; - return (0); - } - else { - lf = reduce_ll_exp(b, plist, induct_list, - p->entry.Template.ll_ptr1, &lp, &lv); - rf = reduce_ll_exp(b, plist, induct_list, - p->entry.Template.ll_ptr2, &rp, &rv); - if (lf == 2 && rf == 2) { - *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - switch (p->variant) { - case ADD_OP: - (*newp)->entry.ival = lv + rv; - break; - case SUBT_OP: - (*newp)->entry.ival = lv - rv; - break; - case MULT_OP: - (*newp)->entry.ival = lv * rv; - break; - case MINUS_OP: - (*newp)->entry.ival = -lv; /* not sure */ - break; - case DIV_OP: - if (rv != 0) - (*newp)->entry.ival = lv / rv; - else - return (0); - break; - default: - *newp = p; - *newv = 0; - return (0); - } - (*newp)->type = cur_file->head_type; - *newv = (*newp)->entry.ival; - return (2); - } - else { /* both not integer case */ - if (lf == 2 && lv == 1 && p->variant == MULT_OP) { - *newp = rp; - return (rf); - } - if ((lf == 2) && (lv < 0)) { - switch (p->variant) { - case ADD_OP: - *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*newp)->entry.ival = -lv; - *newp = make_llnd(cur_file, SUBT_OP, rp, *newp, NULL); - return (rf); - - case SUBT_OP: - *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*newp)->entry.ival = -lv; - *newp = make_llnd(cur_file, ADD_OP, rp, *newp, NULL); - return (rf); - - case MULT_OP: - if (lv == -1) { - if (rp->variant == MINUS_OP) { - *newp = rp->entry.Template.ll_ptr1; - *newv = rv; - return (rf); - } - else { - *newp = make_llnd(cur_file, MINUS_OP, rp, NULL, NULL); - return (rf); - } - } - break; - case MINUS_OP: - case DIV_OP: - default: - break; - } - } /* end if lf == 2 && lv < 0 */ - - if (rf == 2 && rv == 1 && p->variant == MULT_OP) { - *newp = lp; - return (lf); - } - if (rf == 2 && (rv < 0)) { - switch (p->variant) { - case ADD_OP: - *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*newp)->entry.ival = -rv; - *newp = make_llnd(cur_file, SUBT_OP, lp, *newp, NULL); - return (lf); - - case SUBT_OP: - *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*newp)->entry.ival = -rv; - *newp = make_llnd(cur_file, ADD_OP, lp, *newp, NULL); - return (lf); - - case MULT_OP: - if (rv == -1) { - if (rp->variant == MINUS_OP) { - *newp = lp->entry.Template.ll_ptr1; - *newv = lv; - return (lf); - } - else { - *newp = make_llnd(cur_file, MINUS_OP, lp, NULL, NULL); - return (lf); - } - } - break; - case MINUS_OP: - case DIV_OP: - default: - break; - } - } /* end if rf == 2 && rv < 0 */ - if (p->variant == ADD_OP) { - if (rp->variant == MINUS_OP) { - *newp = make_llnd(cur_file, SUBT_OP, lp, - rp->entry.Template.ll_ptr1, NULL); - return (lf * rf); - } - if (lp->variant == MINUS_OP) { - *newp = make_llnd(cur_file, SUBT_OP, rp, - lp->entry.Template.ll_ptr1, NULL); - return (lf * rf); - } - } - *newp = make_llnd(cur_file, p->variant,lp,rp,p->entry.Template.symbol); - if (lf == 0 || rf == 0) { - *newp = p; - return (0); - } - if (lf == 1 || rf == 1) { - lf = 1; - rf = 1; - } - return (lf * rf); - } - } -} - - -/********************************************************************/ -/* comp_offset computes the constant term in a low level expression */ -/* the value is in coef and a 1 is returned. If a 0 is returned */ -/* this means that no integer order zero term was computable. */ -/* if a 2 is returned then a ddot was found ".." coef contains the */ -/* lower value and extra_coef contains the upper value. Note: we */ -/* assume that the .. is at the root of the tree. */ -/* if a 3 is returned then this is not a normal algebraic expression*/ -/* if a 4 is returned then this is an algebraic expression using */ -/* procedure parameters and vexp points to a ll tree representing */ -/* the symbolic part of the constant. */ -/* if a 5 is returned then it is a ddot with parameters. */ -/* chkdflts = 1 means that the user should be prompted for defautls */ -/* if a variable with no default value is found then a 3 will be */ -/* returned. note: this needs more thought! */ -/********************************************************************/ -int extra_coef = 0; -int comp_offset(plist, induct_list, chkdflts, ll, coef, vexp) -PTR_REFL plist; /* list of parameters and commons in - * enclosing scope */ -PTR_SYMB induct_list[]; /* induction variable list for current scope */ -int chkdflts; -PTR_LLND ll; -int *coef; -PTR_LLND *vexp; -{ - int i, lf, rf, lcoef, rcoef, tmp; - PTR_LLND lltmp, lexp, rexp; - PTR_LLND make_llnd(), copy_llnd(); - - tmp = 0; - *coef = 0; - *vexp = NULL; - if (ll == NULL) - return (0); - else if (ll->variant == VAR_REF) { - /* first check to see if this an induction variable */ - for (i = 0; i < MAX_NEST_DEPTH; i++) { - if (ll->entry.Template.symbol == induct_list[i]) - return (0); - } - /* second check for scalar propogation possibility */ - if (ll->entry.Template.ll_ptr1 != NULL) { - return (comp_offset(plist, induct_list, chkdflts, - ll->entry.Template.ll_ptr1, coef, vexp) - ); - } - /* third check to see if this is a scalar parameter */ - /* in this modified version the induction test was */ - /* put at the top and all unknown expressions are */ - /* returned as type 4. */ - else { - *vexp = copy_llnd(ll); - return (4); - } - } - else if (ll->variant == CONST_REF) { - lltmp = ll->entry.Template.symbol->entry.const_value; - if (lltmp->variant == INT_VAL) { - *coef = lltmp->entry.ival; - *vexp = copy_llnd(ll); - return (1); - } - else - return (0); - } - else if (ll->variant == INT_VAL) { - *coef = ll->entry.ival; - *vexp = copy_llnd(ll); - return (1); - } - else { - lf = comp_offset(plist, induct_list, chkdflts, - ll->entry.Template.ll_ptr1, &lcoef, &lexp); - rf = comp_offset(plist, induct_list, chkdflts, - ll->entry.Template.ll_ptr2, &rcoef, &rexp); - if (lf == 3 || rf == 3) - return (3); - if (lf == 5 || rf == 5) - return (5); - switch (ll->variant) { - case DDOT: - if (lf == 1) - *coef = lcoef; - else - *coef = 0; - if (rf == 1) - extra_coef = rcoef; - else - extra_coef = 0; - if ((lf == 1) || (rf == 1)) - return (2); - if (lf == 4 || rf == 4) - return (5); - else - return (0); - case ADD_OP: - tmp = 0; - if (lf == 4 && rf == 0) { - *vexp = lexp; - return (4); - } - if (rf == 4 && lf == 0) { - *vexp = rexp; - return (4); - } - if (lf == 4 || rf == 4) { - if (rexp->variant == MINUS_OP) - *vexp = make_llnd(cur_file, SUBT_OP, lexp, - rexp->entry.Template.ll_ptr1, NULL); - else - *vexp = make_llnd(cur_file, ADD_OP, lexp, rexp, NULL); - return (4); - } - if (lf == 1) - tmp = lcoef; - if (rf == 1) - tmp = tmp + rcoef; - if ((lf == 1) || (rf == 1)) { - *coef = tmp; - *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*vexp)->entry.ival = tmp; - return (1); - } - else - return (0); - case SUBT_OP: - tmp = 0; - if (lf == 4 && rf == 0) { - *vexp = lexp; - return (4); - } - if (rf == 4 && lf == 0) { - if (rexp->variant == INT_VAL) { - rexp->entry.ival = -(rexp->entry.ival); - *vexp = rexp; - return (4); - } - if (rexp->variant != MINUS_OP) - *vexp = make_llnd(cur_file, MINUS_OP, rexp, NULL, NULL); - else - *vexp = rexp->entry.Template.ll_ptr1; - return (4); - } - if (lf == 4 || rf == 4) { - if (rexp->variant == MINUS_OP) - *vexp = make_llnd(cur_file, ADD_OP, lexp, - rexp->entry.Template.ll_ptr1, NULL); - else - *vexp = make_llnd(cur_file, SUBT_OP, lexp, rexp, NULL); - return (4); - } - if (lf == 1) - tmp = lcoef; - if (rf == 1) - tmp = tmp - rcoef; - if ((lf == 1) || (rf == 1)) { - *coef = tmp; - *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*vexp)->entry.ival = tmp; - return (1); - } - else - return (0); - case MULT_OP: - if (lf == 4 && rf == 0) - return (0); - if (rf == 4 && lf == 0) - return (0); - if (lf == 4 || rf == 4) { - if (rexp->variant == MULT_OP) { /* left associate terms */ - lltmp = rexp->entry.Template.ll_ptr1; - lltmp = make_llnd(cur_file, MULT_OP, lexp, lltmp, NULL); - *vexp = make_llnd(cur_file, MULT_OP, lltmp, - rexp->entry.Template.ll_ptr2, NULL); - return (4); - } - if (rf == 1) { - *vexp = make_llnd(cur_file, MULT_OP, rexp, lexp, NULL); - } - else { - *vexp = make_llnd(cur_file, MULT_OP, lexp, rexp, NULL); - } - return (4); - } - if ((lf == 1) && (rf == 1)) { - *coef = lcoef * rcoef; - *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*vexp)->entry.ival = *coef; - return (1); - } - else - return (0); - case MINUS_OP: - if (lf == 4) { - if (lexp->variant == MINUS_OP) - *vexp = lexp->entry.Template.ll_ptr1; - else - *vexp = make_llnd(cur_file, MINUS_OP, lexp, NULL, NULL); - } - else if (lf == 1) { - *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - *coef = -lcoef; - (*vexp)->entry.ival = *coef; - } - return (lf); - case DIV_OP: - if (lf == 4 && rf == 0) - return (0); - if (rf == 4 && lf == 0) - return (0); - if (lf == 4 || rf == 4) { - *vexp = make_llnd(cur_file, DIV_OP, lexp, rexp, NULL); - return (4); - } - if ((rcoef != 0) && (lf == 1) && (rf == 1)) { - *coef = lcoef / rcoef; - *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - (*vexp)->entry.ival = *coef; - return (1); - } - else - return (0); - case EXPR_LIST: - if (ll->entry.Template.ll_ptr2 == NULL) { - *vexp = lexp; - *coef = lcoef; - return (lf); - } - default: - *coef = 0; - return (3); /* not normal */ - } - } -} - -/*****************************************************************/ -/* search symb searches a ll tree returns 0 if a const. is found */ -/* a -2 if another symbol is found as a multiplicative factor */ -/* for example, searching for i in 2*i*(5+j) returns -2 */ -/* a -1 if it is found but not in a linear combination. */ -/* and a 1 if it is and coef has the value of the coefecient */ -/* In the case that a ddot ".." is found a 2 is returned and */ -/* coef has the value of the low bound term and extra_coef has */ -/* the high value. Note this implies that .. is at the root of */ -/* the tree. */ -/* chkdflts=1 means that the usr should be prompted for defautls */ -/*****************************************************************/ - -/* returns 1 if constant coef and *coef is set. */ -/* returns -2 if non-constant coef and *exp is set */ -/* returns 0 if constant but not coef and *coef is set */ -/* returns 2 if non-constant non-coef is found. *exp set*/ -/* returns -1 for non-linear expressions in s */ - -int new_search_symb(s, induct_list, ll, coef, exp) -PTR_SYMB s; -PTR_SYMB induct_list[]; -PTR_LLND ll, *exp; -int *coef; -{ - int lval, rval; - PTR_LLND lexp, rexp, nll, make_llnd(), copy_llnd(); - int lcoef, rcoef; - - if (ll == NULL) { - *coef = 0; - return (0); - } - lexp = NULL; - rexp = NULL; - if (ll->variant == VAR_REF) { - if (ll->entry.Template.symbol == s) { - *coef = 1; - *exp = NULL; - return (1); - } - if (ll->entry.Template.ll_ptr1 != NULL) { - return ( - new_search_symb(s, induct_list, ll->entry.Template.ll_ptr1, coef, exp) - ); - } - else { - *exp = ll; - return (2); - } - } - else if (ll->variant == INT_VAL) { - *coef = ll->entry.ival; - *exp = NULL; - return (0); - } - else { - lval=new_search_symb(s,induct_list,ll->entry.Template.ll_ptr1,&lcoef,&lexp); - rval=new_search_symb(s,induct_list,ll->entry.Template.ll_ptr2,&rcoef,&rexp); - switch (ll->variant) { - case MINUS_OP: - if (lval == 1 || lval == 0) { - *coef = -lcoef; - return (lval); - } - else if (lval == -2 || lval == 2) { - if (lexp->variant == MINUS_OP) - *exp = lexp->entry.Template.ll_ptr1; - else - *exp = make_llnd(cur_file, MINUS_OP, lexp, NULL, NULL); - return (lval); - } - else - return (-1); - case MULT_OP: - case DIV_OP: - if (rval == 1) { /* right side is const coef of s */ - switch (lval) { - case 0: - if (ll->variant == MULT_OP) { - *coef = lcoef * rcoef; - return (1); - } - else if (rcoef != 0) { - *coef = lcoef / rcoef; - return (1); - } - else - return (-1); - case -2: - case -1: - case 1: - return (-1); - case 2: - if (rcoef == 1) - *exp = lexp; - else { - if (ll->variant == DIV_OP && rcoef == 0) - return (-1); - nll = make_llnd(cur_file, INT_VAL, NULL, NULL, rcoef); - nll = make_llnd(cur_file, ll->variant, lexp, nll, NULL); - *exp = nll; - } - return (-2); - } - } - else if (rval == 0) { /* right side is just a constant */ - switch (lval) { - case 0: - if (ll->variant == MULT_OP) { - *coef = lcoef * rcoef; - return (0); - } - else if (rcoef != 0) { - *coef = lcoef / rcoef; - return (0); - } - else - return (-1); - case -2: /* left side is non-const coef of s */ - case 2: /* or non-const non-coef */ - if (rcoef == 1) - *exp = lexp; - else { - nll = make_llnd(cur_file, INT_VAL, NULL, NULL, rcoef); - nll = make_llnd(cur_file, ll->variant, lexp, nll, NULL); - *exp = nll; - } - return (lval); - case 1: - if (ll->variant == MULT_OP) { - *coef = lcoef * rcoef; - return (1); - } - else if (rcoef != 0) { - *coef = lcoef / rcoef; - return (1); - } - else - return (-1); - case -1: - return (-1); - } - } - else if (rval == 2) { /* right side is a non-constant non coef */ - switch (lval) { - case 1: - case 0: - if (lcoef == 1) - *exp = rexp; - else { - nll = make_llnd(cur_file, INT_VAL, NULL, NULL, lcoef); - nll = make_llnd(cur_file, MULT_OP, nll, rexp, NULL); - *exp = nll; - } - if (lval == 0) - return (2); - else - return (-2); - case 2: - *exp = ll; - return (2); - case -2: - *exp = make_llnd(cur_file, MULT_OP, lexp, rexp, NULL); - return (-2); - case -1: - return (-1); - } - } - else if (rval == -2) { /* right side is a coef of s but not const */ - switch (lval) { - case 1: - case -2: - case -1: - return (-1); - case 0: - if (lcoef == 1) - *exp = rexp; - else { - nll = make_llnd(cur_file, INT_VAL, NULL, NULL, lcoef); - nll = make_llnd(cur_file, MULT_OP, nll, rexp, NULL); - *exp = nll; - } - return (-2); - case 2: - *exp = make_llnd(cur_file, MULT_OP, lexp, rexp, NULL); - return (-2); - } - } - else /* rval == -1 */ - return (-1); - case ADD_OP: - case SUBT_OP: - if (rval == 1) { /* right side is const times s */ - switch (lval) { - case 1: /* lhs is const coef */ - if (ll->variant == ADD_OP) - *coef = lcoef + rcoef; - else - *coef = lcoef - rcoef; - return (1); - case -2: /* lhs is non-const coef */ - nll = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - if (ll->variant == ADD_OP) - nll->entry.ival = rcoef; - else - nll->entry.ival = -rcoef; - if (lexp->variant == MINUS_OP) { - lexp = lexp->entry.Template.ll_ptr1; - *exp = make_llnd(cur_file, SUBT_OP, nll, lexp, NULL); - } - else - *exp = make_llnd(cur_file, ADD_OP, lexp, nll, NULL); - return (-2); - case -1: - return (-1); - case 0: /* lhs is const */ - case 2: /* lhs is non const */ - if (ll->variant == ADD_OP) - *coef = rcoef; - else - *coef = -rcoef; - return (1); - } - } - else if (rval == -2) { /* right side is non-const times s */ - switch (lval) { - case 1: /* lhs is const coef */ - lexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - if (lexp->variant == ADD_OP) - lexp->entry.ival = lcoef; - else - lexp->entry.ival = -lcoef; - case -2: /* lhs is non-const coef */ - *exp = make_llnd(cur_file, ll->variant, lexp, rexp, NULL); - return (-2); - case -1: - return (-1); - case 0: /* lhs is const */ - case 2: /* lhs is non const */ - if (ll->variant == SUBT_OP) { - rexp = make_llnd(cur_file, MINUS_OP, rexp, NULL, NULL); - } - *exp = rexp; - return (-2); - } - } - else if (rval == 0) { /* right side is just constant */ - switch (lval) { - case 1: /* lhs is const coef */ - *coef = lcoef; - return (1); - case -2: /* lhs is non-const coef */ - *exp = lexp; - return (-2); - case -1: - return (-1); - case 0: /* lhs is const */ - if (ll->variant == ADD_OP) - *coef = lcoef + rcoef; - else - *coef = lcoef - rcoef; - return (0); - case 2: /* lhs is non const */ - nll = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - nll->entry.ival = rcoef; - *exp = make_llnd(cur_file, ll->variant, lexp, nll, NULL); - return (2); - } - } - else if (rval == 2) { /* right side in non-const non coef */ - switch (lval) { - case 1: /* lhs is const coef */ - *coef = lcoef; - return (1); - case -2: /* lhs is non-const coef */ - *exp = lexp; - return (-2); - case -1: - return (-1); - case 0: /* lhs is const */ - lexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - lexp->entry.ival = lcoef; - case 2: /* lhs is non const */ - *exp = make_llnd(cur_file, ll->variant, lexp, rexp, NULL); - return (2); - } - } - else /* if(rval == -1) */ - return (-1); - case DDOT: - case ARRAY_REF: - case FUNC_CALL: - return (-1); - default: - return (-1); - } - } -} - -int search_symb(chkdflts, s, ll, coef) -int chkdflts; -PTR_SYMB s; -PTR_LLND ll; -int *coef; -{ - int i, lf, rf, lcoef, rcoef, tmp; - PTR_LLND lltmp; - - tmp = 0; - *coef = 0; - if (ll == NULL) - return (0); - else if (ll->variant == VAR_REF) { - if (ll->entry.Template.symbol == s) { - *coef = 1; - return (1); - } - else { - /* first try a variable propogation to find s */ - if (ll->entry.Template.ll_ptr1 != NULL) { - return ( - search_symb(chkdflts, s, ll->entry.Template.ll_ptr1, coef) - ); - } - else if (chkdflts) { - for (i = 0; i < MAX_NEST_DEPTH; i++) { - if (ll->entry.Template.symbol == induct_list[i]) - return (-3); - } - return (0); - } - else - return (-3); - } - } - else if (ll->variant == CONST_REF) { - lltmp = ll->entry.Template.symbol->entry.const_value; - if (lltmp->variant == INT_VAL) { - *coef = lltmp->entry.ival; - return (0); - } - else - return (-3); - } - else if (ll->variant == INT_VAL) { - *coef = ll->entry.ival; - return (0); - } - else { - lf = search_symb(chkdflts, s, ll->entry.Template.ll_ptr1, &lcoef); - rf = search_symb(chkdflts, s, ll->entry.Template.ll_ptr2, &rcoef); - switch (ll->variant) { - case DDOT: - if (lf == 1) - *coef = lcoef; - else - *coef = 0; - if (rf == 1) - extra_coef = rcoef; - else - extra_coef = 0; - if ((lf == 1) || (rf == 1)) - return (2); - else { - if (lf * rf == 0) - return (0); - else - return ((lf <= rf) ? rf : lf); - } - case ADD_OP: - if (lf == 1) - tmp = lcoef; - if (rf == 1) - tmp = tmp + rcoef; - if ((lf == 1) || (rf == 1)) { - *coef = tmp; - return (1); - } - else { - *coef = rcoef + lcoef; - if (lf * rf == 0) - return (0); - else - return ((lf <= rf) ? rf : lf); - } - case SUBT_OP: - if (lf == 1) - tmp = lcoef; - if (rf == 1) - tmp = tmp - rcoef; - if ((lf == 1) || (rf == 1)) { - *coef = tmp; - return (1); - } - else { - *coef = lcoef - rcoef; - if (lf * rf == 0) - return (0); - else - return ((lf <= rf) ? rf : lf); - } - case MULT_OP: - tmp = 1; - if ((lf == 1) || (lf == 0)) - tmp = lcoef; - if ((rf == 1) || (rf == 0)) - tmp = tmp * rcoef; - if ((lf * rf) == 0) { - *coef = tmp; - return (lf + rf); - } - else if ((lf == 1) && (rf == 1)) { - *coef = 1; - return (-1); - } - else { - *coef = 1; - return (-2); - } - case MINUS_OP: - *coef = -lcoef; - return (lf); - default: - *coef = 999; - return (-2); - } - } -} - -void print_subscr(r, arr, induct_list) -PTR_SYMB induct_list[]; -struct ref *r; -struct subscript arr[]; -{ - int i, j; - PTR_LLND ll; - char *s; - - ll = r->refer; - if (induct_list[0] == NULL) - return; - for (j = 0; j < 2; j++) { - fprintf(stderr, "______________________________________________________\n"); - fprintf(stderr, "| ID | decidable | offset | %s | %s | %s | parm_exp \n", - induct_list[0]->ident, - (induct_list[1] == NULL) ? "-" : induct_list[1]->ident, - (induct_list[2] == NULL) ? "-" : induct_list[2]->ident); - fprintf(stderr, "|-----------------------------------------------------|\n"); - if (arr[j].parm_exp != NULL) - s = (UnparseLlnd[cur_file->lang])(arr[j].parm_exp); - else - s = ""; - fprintf(stderr, "| %s | %d | %d | %d | %d | %d |%s\n", - ll->entry.array_ref.symbol->ident, - arr[j].decidable, arr[j].offset, - arr[j].coefs[0], arr[j].coefs[1], arr[j].coefs[2], s - ); - fprintf(stderr, "|-----------------------------------------------------|\n"); - for (i = 0; i < 2; i++) { - if (arr[j].coefs_symb[i] != NULL) - fprintf(stderr, " arr[%d].coefs_symb[%d] = %s\n", j, i, - (UnparseLlnd[cur_file->lang])(arr[j].coefs_symb[i])); - } - fprintf(stderr, "|-----------------------------------------------------|\n"); - } -} - -/* structure equiv. takes two low level pointers to expressions and test */ -/* them for equivalence as expressions. if equif returns 1 else 0 */ -/* this version checks only syntatic equiv. algebraic equiv will be needed */ -int sequiv(sub1, sub2) -PTR_LLND sub1, sub2; -{ - if ((sub1 == NULL) && (sub2 == NULL)) - return (1); - if (((sub1 == NULL) && (sub2 != NULL)) || - ((sub1 != NULL) && (sub2 == NULL))) - return (0); - /* both not null */ - if (sub1->variant != sub2->variant) - return (0); - else { - if (sub1->variant == VAR_REF) { - if (sub1->entry.Template.symbol == - sub2->entry.Template.symbol) - return (1); - else - return (0); - } - else { - if (sequiv(sub1->entry.Template.ll_ptr1, - sub2->entry.Template.ll_ptr1) && - sequiv(sub1->entry.Template.ll_ptr2, - sub2->entry.Template.ll_ptr2) - ) - return (1); - else - return (0); - } - } -} - -/* make_subscr(r,arr) creates the subscript array for the reference r */ -void make_subscr(r, arr) -struct ref *r; -struct subscript arr[]; -{ - int i, j; - PTR_BFND b, fun; - PTR_REFL plist; - PTR_LLND ll, tl, index_exper, parexp, exp; - struct subscript il_lo[MAX_NEST_DEPTH]; - struct subscript il_hi[MAX_NEST_DEPTH]; - int depth, found, coef; - - b = r->stmt; - ll = r->refer; - for (j = 0; j < AR_DIM_MAX; j++) { - arr[j].decidable = -1; - arr[j].parm_exp = NULL; - arr[j].offset = 0; - arr[j].vector = NULL; - for (i = 0; i < MAX_NEST_DEPTH; i++) { - arr[j].coefs[i] = 0; - arr[j].coefs_symb[i] = NULL; - } - } - - /* now make build the set of valid induction variables */ - depth = make_induct_list(b, induct_list, il_lo, il_hi); - /* now find the parameters and common vars for this scope */ - fun = b; - while (fun != NULL && (fun->variant != PROG_HEDR) && - (fun->variant != FUNC_HEDR) && - (fun->variant != PROC_HEDR)) - fun = fun->control_parent; - if (fun == NULL) - return; - if(fun->entry.Template.sets == NULL) plist = NULL; - else plist = fun->entry.Template.sets->in_def; - - /* now for each array index position build the vector of coefs. */ - /* start with the left most position numbered by i */ - i = 0; - if (ll->variant == ARRAY_REF) { - tl = ll->entry.array_ref.index; - while (tl != NULL) { - if ((tl->variant == VAR_LIST) || - (tl->variant == EXPR_LIST) || - (tl->variant == RANGE_LIST)) { - index_exper = tl->entry.Template.ll_ptr1; - if (index_exper == NULL || - index_exper->variant == STAR_RANGE) { - arr[i].vector = index_exper; - arr[i].decidable = 0; - arr[i].coefs[depth] = 0; - } - else if (index_exper->variant == DDOT) { - /* we have a vector */ - /* set the decidable flag to 2 */ - /* and save a pointr to the vector */ - /* bounds for later use */ - /* we set the coef in position */ - /* depth to be 1 so this is */ - /* a pseudo loop. the bounds of the */ - /* loops will be set */ - /* as inequalities. NOTE: for stride */ - /* vectors we will */ - /* set the coef to be equal to thestride */ - arr[i].vector = index_exper; - arr[i].decidable = 2; - arr[i].coefs[depth] = 1; - } - else { - /* this is just a standard scalar expression */ - arr[i].decidable = 1; - parexp = NULL; - found = comp_offset(plist, induct_list, 1, - index_exper, &coef, &parexp); - if (found == 1) - arr[i].offset = coef; - if (found == 4) { - arr[i].offset = 0; - arr[i].parm_exp = parexp; - } - for (j = 0; j < depth; j++) { - found=new_search_symb(induct_list[j], - induct_list,index_exper, &coef, &exp); - switch (found) { - case 1: /* constant coef */ - arr[i].coefs[j] = coef; - break; - case -2: /* variable coef */ - arr[i].coefs_symb[j] = exp; - break; - case -1: - arr[i].decidable = 0; - case 0: - case 2: - arr[i].coefs[j] = 0; - break; - } - } - for (j = depth; j < MAX_NEST_DEPTH; j++) - arr[i].coefs[j] = 0; - if (arr[i].decidable == -1) - arr[i].decidable = 3; - } - tl = tl->entry.Template.ll_ptr2; - i++; - } - else { /* must be a simple 1 Dim. subscript */ - arr[i].decidable = 1; - parexp = NULL; - found = comp_offset(plist, induct_list, 1, tl, &coef, &parexp); - if (found != 0) - arr[i].offset = coef; - if (found == 4) { - arr[i].offset = 0; - arr[i].parm_exp = parexp; - } - for (j = 0; j < depth; j++) { - found = new_search_symb(induct_list[j], induct_list, tl,&coef,&exp); - switch (found) { - case 1: /* constant coef */ - arr[i].coefs[j] = coef; - break; - case -2: /* variable coef */ - arr[i].coefs_symb[j] = exp; - break; - case -1: - arr[i].decidable = 0; - case 0: - case 2: - arr[i].coefs[j] = 0; - break; - } - } - for (j = depth; j < MAX_NEST_DEPTH; j++) - arr[i].coefs[j] = 0; - tl = NULL; - } - } /* end while */ - } /* end if array_ref */ -} - -/********************************************************************/ -/* search_inc_scalar(b) looks for a scalar variable in the condition*/ -/* that is modified in the body of the loop. */ -/* this is returned and used as an induction varialble in the */ -/* routine below. There are two utility routines which recursively*/ -/* search the condition tree and the body of the loop */ -/********************************************************************/ -int ll_search(ll, s) -PTR_LLND ll; -PTR_SYMB s; -{ - if (ll == NULL) - return (0); - else { - switch (ll->variant) { - case VAR_REF: - if (ll->entry.var_ref.symbol == s) - return (1); - else - return (0); - case ARRAY_REF: - return (ll_search(ll->entry.array_ref.index, s)); - case CONST_REF: - return (0); - default: - if (ll_search(ll->entry.Template.ll_ptr1, s)) - return (1); - else - return (ll_search(ll->entry.Template.ll_ptr2, s)); - } - } -} - -int body_search(b, s) -PTR_BFND b; -PTR_SYMB s; -{ - PTR_BLOB x; - - if (b == NULL) - return (0); - else { - switch (b->variant) { - case ASSIGN_STAT: - case M_ASSIGN_STAT: - case SUM_ACC: - case MULT_ACC: - case MAX_ACC: - case MIN_ACC: - case CAT_ACC: - case OR_ACC: - case AND_ACC: - return (ll_search(b->entry.Template.ll_ptr1, s)); - case FOR_NODE: - case FORALL_NODE: - case WHILE_NODE: - x = b->entry.Template.bl_ptr1; - while (x != NULL && x->ref != b) { - if (body_search(x->ref, s)) - return (1); - x = x->next; - } - return (0); - case IF_NODE: - x = b->entry.if_node.control_true; - while (x != NULL) { - if (body_search(x->ref, s)) - return (1); - x = x->next; - } - x = b->entry.if_node.control_false;; - while (x != NULL) { - if (body_search(x->ref, s)) - return (1); - x = x->next; - } - return (0); - default: - return (0); - } - } -} - -PTR_SYMB induc_search(b, ll) -PTR_BFND b; -PTR_LLND ll; -{ - PTR_SYMB s; - - if (ll == NULL) - return (NULL); - else { - switch (ll->variant) { - case VAR_REF: - if (body_search(b, ll->entry.var_ref.symbol)) - return (ll->entry.var_ref.symbol); - else - return (NULL); - case ARRAY_REF: - return (induc_search(b, ll->entry.array_ref.index)); - case CONST_REF: - return (NULL); - default: - if ((s = induc_search(b, ll->entry.Template.ll_ptr1)) - != NULL) - return (s); - else - return (induc_search(b, ll->entry.Template.ll_ptr2)); - } - } -} - - -PTR_SYMB search_inc_scalar(b) -PTR_BFND b; -{ - PTR_LLND v; - - v = b->entry.while_node.condition; - return (induc_search(b, v)); -} - - -/********************************************************************/ -/* Make_induct_list(b,induct_list ) creates the induction list as */ -/* seen from this point in the graph. the function returns the nest*/ -/* level and it also side effects four other arrays: il_lo, il_hi */ -/* which describe the low and hi bounds for the list and the vectors*/ -/* stride and is_forall. In the case of a stride component that is */ -/* not one, we normalize the induction list arrays as follows. */ -/* if the stride is not a constant il_lo and il_hi is set undecidble*/ -/* otherwise il_lo is set to 0 and il_hi becomes (il_hi-il_lo)/str */ -/* The way this works: it goes up the tree and fills in the loop */ -/* index variables from the top down to this point. */ -/* In the case of WHILE loops and C for loops as well as while loops*/ -/* we must try to identify an induction */ -/* variable. We will do this by searching the test condition for */ -/* first scalar variable. This is not accurate. What we should do */ -/* is search for a scalar variable that changes value in the body of*/ -/* the iteration, but that is not done yet. I will do it later. */ -/********************************************************************/ -int make_induct_list(b, induct_list, il_lo, il_hi) -PTR_BFND b; -PTR_SYMB induct_list[]; -struct subscript il_lo[]; -struct subscript il_hi[]; -{ - int i, j, found, coef; - PTR_LLND p, lv, rv, q, pexp; - PTR_REFL plist; - PTR_BFND proc; - - if ((b == NULL) || (b->variant == GLOBAL)) { - return (0); - } - else { - for (j = 0; j < MAX_NEST_DEPTH; j++) { - il_lo[j].decidable = -1; - il_lo[j].parm_exp = NULL; - il_lo[j].offset = 0; - il_lo[j].vector = NULL; - for (i = 0; i < MAX_NEST_DEPTH; i++) { - il_lo[j].coefs[i] = 0; - il_lo[j].coefs_symb[i] = NULL; - } - il_hi[j].decidable = -1; - il_hi[j].parm_exp = NULL; - il_hi[j].offset = 0; - il_hi[j].vector = NULL; - for (i = 0; i < MAX_NEST_DEPTH; i++) { - il_hi[j].coefs[i] = 0; - il_hi[j].coefs_symb[i] = NULL; - } - } - /* first generate the list of parameters of the function */ - proc = b; - while (proc != NULL && (proc->variant != PROC_HEDR) && - (proc->variant != FUNC_HEDR) && - (proc->variant != PROG_HEDR)) - proc = proc->control_parent; - if (proc == NULL) - return 0; - if (proc->entry.Template.sets == NULL) - plist = NULL; - else - plist = proc->entry.Template.sets->out_use; - - /* now recursive apply procedure */ - i = make_induct_list(b->control_parent, induct_list, il_lo, il_hi); - if ((b->variant == FOR_NODE) || - (b->variant == FORALL_NODE)) { - if (i > MAX_NEST_DEPTH) { - fprintf(stderr, " nest too deep ! \n"); - return (0); - } - if (b->entry.for_node.control_var == NULL) { - /* must be a C for loop */ - lv = b->entry.Template.ll_ptr1; /* exp list */ - if (lv == NULL) { - /* try to go for the increment exp */ - lv = b->entry.Template.ll_ptr3; - rv = lv->entry.Template.ll_ptr1; /* op */ - lv = rv->entry.Template.ll_ptr1; - induct_list[i] = - lv->entry.Template.symbol; - lv = NULL; - il_lo[i].decidable = 0; - } - else { - rv = lv->entry.Template.ll_ptr1; /* asign op */ - lv = rv->entry.Template.ll_ptr1; /* var ref */ - il_lo[i].decidable = 1; - induct_list[i] = lv->entry.Template.symbol; - lv = rv->entry.Template.ll_ptr2; /* start val */ - } - is_forall[i] = 0; - /* now do hi bound for C case */ - rv = b->entry.Template.ll_ptr2; /* 2nd expr */ - rv = rv->entry.Template.ll_ptr1; - rv = rv->entry.Template.ll_ptr2; - stride[i] = 1; /* these two lines are bogus */ - il_hi[i].decidable = 1; - } - else { /* fortran case */ - induct_list[i] = b->entry.for_node.control_var; - if (b->variant == FORALL_NODE) - is_forall[i] = 1; - else - is_forall[i] = 0; - /* now create low and hi bounds */ - p = b->entry.for_node.range; - if (p->variant != DDOT) - fprintf(stderr, "bad range node\n"); - lv = p->entry.Template.ll_ptr1; - rv = p->entry.Template.ll_ptr2; - il_lo[i].decidable = 1; - il_hi[i].decidable = 1; - stride[i] = 1; - if ((lv->variant == DDOT) || - (b->entry.for_node.increment != NULL)) { - /* we have a stride term! */ - if (b->entry.for_node.increment != NULL) - q = b->entry.for_node.increment; - else { - q = rv; - rv = lv->entry.Template.ll_ptr2; - lv = lv->entry.Template.ll_ptr1; - } - /* we currently only support constant strides */ - /* this can be improved to general expressions */ - found = comp_offset(plist, induct_list, 1, q, &coef, &pexp); - if (found != 3) - stride[i] = coef; - if ((found == 4) || (found == 3) || (stride[i] == 0)) { - il_lo[i].decidable = 0; - il_hi[i].decidable = 0; - stride[i] = 1; - } - } - } /* end fortran case */ - pexp = NULL; - found = comp_offset(plist, induct_list, 1, lv, &coef, &pexp); - if (found >= 3) - il_lo[i].decidable = 0; - if (found == 4) - il_lo[i].parm_exp = pexp; - else - il_lo[i].parm_exp = NULL; - if (found != 0) - il_lo[i].offset = coef; - pexp = NULL; - found = comp_offset(plist, induct_list, 1, rv, &coef, &pexp); - if (found >= 3) - il_hi[i].decidable = 0; - if (found == 4) - il_hi[i].parm_exp = pexp; - else - il_hi[i].parm_exp = NULL; - if (found != 0) - il_hi[i].offset = coef; - for (j = 0; j < i; j++) { - found = search_symb(0, induct_list[j], lv, &coef); - if (found >= 1) - il_lo[i].coefs[j] = coef; - else if (found == 0) - il_lo[i].coefs[j] = 0; - else if ((found == -1) || - (found == -2)) - il_lo[i].decidable = 0; - - found = search_symb(0, induct_list[j], rv, &coef); - if (found >= 1) - il_hi[i].coefs[j] = coef; - else if (found == 0) - il_hi[i].coefs[j] = 0; - else if ((found == -1) || - (found == -2)) - il_hi[i].decidable = 0; - } - /* now normalize for stride */ - if (stride[i] != 1) { - il_hi[i].offset = - (il_hi[i].offset - il_lo[i].offset) / stride[i]; - il_lo[i].offset = 0; - for (j = 0; j < i; j++) { - il_hi[i].coefs[j] = - (il_hi[i].coefs[j] - il_lo[i].coefs[j]) / stride[i]; - il_lo[i].coefs[j] = 0; - } - } - return (i + 1); - } - else if (b->variant == WHILE_NODE) { - if (i > MAX_NEST_DEPTH) { - fprintf(stderr, " nest too deep ! \n"); - return (0); - } - induct_list[i] = search_inc_scalar(b);; - /* now create low and hi bounds */ - il_lo[i].decidable = 0; - il_hi[i].decidable = 0; - for (j = 0; j < i; j++) { - il_lo[i].coefs[j] = 0; - il_hi[i].coefs[j] = 0; - } - - return (i + 1); - } - else - return (i); - } -} -/* make_vect_range takes a pointer to a .. node */ -/* for a vector reference and builds two */ -/* subscript records. One for the lo end the */ -/* other for the hi end. induct_list is */ -/* the current active induction list. */ -void make_vect_range(depth, p, induct_list, lo, hi) -PTR_LLND p; -PTR_SYMB induct_list[]; -struct subscript *lo; -struct subscript *hi; -int depth; -{ - int i, j, found, coef; - PTR_LLND lv, rv, plv, prv; - PTR_REFL plist; /* this is a dummy. need to add this as - * parameter */ - if (p->variant != DDOT) - fprintf(stderr, "bad range node in vector\n"); - for (i = 0; i < MAX_NEST_DEPTH; i++) { - lo->coefs[i] = 0; - hi->coefs[i] = 0; - } - lo->offset = 0; - hi->offset = 0; - lv = p->entry.Template.ll_ptr1; - rv = p->entry.Template.ll_ptr2; - lo->decidable = 1; - plist = NULL; /* ignore parametes in vector range for now */ - found = comp_offset(plist, induct_list, 1, lv, &coef, &plv); - if (found >= 3) - lo->decidable = 0; - if (found != 0) - lo->offset = coef; - hi->decidable = 1; - found = comp_offset(plist, induct_list, 1, rv, &coef, &prv); - if (found >= 3) - hi->decidable = 0; - if (found != 0) - hi->offset = coef; - for (j = 0; j < i; j++) { - found = search_symb(0, induct_list[j], lv, &coef); - if (found >= 1) - lo->coefs[j] = coef; - else if (found == 0) - lo->coefs[j] = 0; - else if ((found == -1) || - (found == -2)) - lo->decidable = 0; - - found = search_symb(0, induct_list[j], rv, &coef); - if (found >= 1) - hi->coefs[j] = coef; - else if (found == 0) - hi->coefs[j] = 0; - else if ((found == -1) || - (found == -2)) - hi->decidable = 0; - } - lo->offset = -lo->offset; - for (i = 0; i < MAX_NEST_DEPTH; i++) { - lo->coefs[i] = -lo->coefs[i]; - } - lo->coefs[depth] = 1; /* perhaps repalce by stride ? */ - hi->coefs[depth] = -1; -} - -/************************************************/ -/* standard gcd routines: gcd of two vectors. */ -/* zeros are not counted. */ -/************************************************/ -int sgcd(a, b) -int a, b; -{ - int tmp; - - if (a < 0) - a = -a; - if (b < 0) - b = -b; - if (a > b) { - tmp = b; - b = a; - a = tmp; - } - if (a == 0) - return (b); - else - return (sgcd(a, b % a)); -} - -int gcd(d, x) -int d; -int x[]; -{ - int i, g; - g = 0; - for (i = 0; i < d; i++) { - g = sgcd(g, x[i]); - } - return (g); -} - - -void clean_loops(b) -PTR_BFND b; -{ - PTR_BLOB x; - - if (b == NULL) - return ; - else { - switch (b->variant) { - case GLOBAL: - case PROG_HEDR: - case PROC_HEDR: - case FUNC_HEDR: - case FOR_NODE: - case FORALL_NODE: - case WHILE_NODE: - x = b->entry.Template.bl_ptr1; - while (x != NULL && x->ref != b) { - clean_loops(x->ref); - if (x->next != NULL && - x->next->ref == b) - x->next = NULL; - x = x->next; - } - break; - case IF_NODE: - x = b->entry.if_node.control_true; - while (x != NULL) { - clean_loops(x->ref); - if (x->next != NULL && - x->next->ref == b) - x->next = NULL; - x = x->next; - } - x = b->entry.if_node.control_false;; - while (x != NULL) { - clean_loops(x->ref); - if (x->next != NULL && - x->next->ref == b) - x->next = NULL; - x = x->next; - } - break; - default: - break; - } - } -} - - - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c deleted file mode 100644 index 31babb0..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c +++ /dev/null @@ -1,1050 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/* file: symb_alg.c */ - -#include "db.h" - -extern PTR_LLND make_llnd(); -extern PTR_FILE cur_file; - -/* - * The following routines are used to evaluate low level expressions - */ - -int get_symbs(n, p, s) -PTR_LLND p; -PTR_SYMB s[]; -int n; -{ - int i; - - if (p == NULL) - return (n); - if (p->variant == VAR_REF) { - for (i = 0; i < n; i++) - if (s[i] == p->entry.Template.symbol) - break; - if (i == n) { - s[n++] = p->entry.Template.symbol; - } - } - n = get_symbs(n, p->entry.Template.ll_ptr1, s); - n = get_symbs(n, p->entry.Template.ll_ptr2, s); - return (n); -} - -int eval_exp(p, s, vals, n, valu) /* returns 0 on failure */ -int n; -PTR_LLND p; -PTR_SYMB s[]; -int vals[]; -int *valu; -{ - int i, lv, rv, rs, ls; - - if (p == NULL) - return (0); - if (p->variant == INT_VAL) { - *valu = p->entry.ival; - return (1); - } - if (p->variant == VAR_REF) { - for (i = 0; i < n; i++) - if (s[i] == p->entry.Template.symbol) { - *valu = vals[i]; - return (1); - } - return (0); - } - lv = 0; - rv = 0; - rs = 0; - ls = 0; - rs = eval_exp(p->entry.Template.ll_ptr2, s, vals, n, &rv); - ls = eval_exp(p->entry.Template.ll_ptr1, s, vals, n, &lv); - - switch (p->variant) { - case MINUS_OP: - *valu = -lv; - break; - case ADD_OP: - *valu = lv + rv; - break; - case MULT_OP: - *valu = lv * rv; - break; - case DIV_OP: - *valu = (rv != 0) ? lv / rv : 0; - break; - case SUBT_OP: - *valu = lv - rv; - break; - default: - fprintf(stderr, "bad op: %d\n", p->variant); - return (0); - - } - if (p->variant != MINUS_OP) - return (rs * ls); - else - return (ls); -} - -/* returns 1 if p and q are constant or linear in the same var */ -/* and 0 otherwise. result = 1 if p is less than q for a large value */ -/* and result = 0 otherwise */ -int numerical_less(p, q, result) -PTR_LLND p, q; -int *result; -{ - PTR_SYMB psyms[20], qsyms[20]; - int pvals[20], qvals[20]; - int pn, qn, pv, qv, ps, qs; - - pn = 0; - qn = 0; - pv = 0; - qv = 0; - qs = 0; - ps = 0; - pn = get_symbs(pn, p, psyms); - qn = get_symbs(qn, q, qsyms); - if (pn > 1 || qn > 1) - return (0); - if (pn == 1 && qn == 1 && psyms[0] != qsyms[0]) - return (0); - pvals[0] = 512; - qvals[0] = 512; - ps = eval_exp(p, psyms, pvals, pn, &pv); - qs = eval_exp(q, qsyms, qvals, qn, &qv); - if (ps * qs == 0) - return (0); - *result = (pv < qv) ? 1 : 0; - return (1); -} - - -int less(p, q) -PTR_LLND p, q; -{ - char *name1, *name2; - int i; - - if (p->variant == MINUS_OP) - p = p->entry.Template.ll_ptr1; - if (q->variant == MINUS_OP) - q = q->entry.Template.ll_ptr1; - if (q->variant == INT_VAL) { - if (p->variant == INT_VAL) { - if (p->entry.ival < q->entry.ival) - return (1); - else - return (0); - } - else - return (1); - } - if (p->variant == INT_VAL) - return (0); - if (p->variant == VAR_REF && q->variant == VAR_REF) { - name1 = p->entry.Template.symbol->ident; - name2 = q->entry.Template.symbol->ident; - i = 0; - while (name1[i] != '\0' && name2[i] != '\0') { - if (name1[i] > name2[i]) - return (0); - if (name1[i] < name2[i]) - return (1); - i++; - } - if (name1[i] == '\0' && name2[i] != '\0') - return (1); - else - return (0); - } - if (p->variant == VAR_REF) - return (1); - if (q->variant == VAR_REF) - return (0); - return (0); -} - -int rest_constant(p) -PTR_LLND p; -{ - if (p == NULL) - return (1); - if (p->variant == INT_VAL) - return (1); - if (p->variant == MINUS_OP) - return (rest_constant(p->entry.Template.ll_ptr1)); - if (p->variant == MULT_OP) - return (rest_constant(p->entry.Template.ll_ptr1) * - rest_constant(p->entry.Template.ll_ptr2)); - if (p->variant == DIV_OP) - return (rest_constant(p->entry.Template.ll_ptr1) * - rest_constant(p->entry.Template.ll_ptr2)); - return (0); -} - - -int term_less(p, q) -PTR_LLND p, q; -{ - PTR_LLND p_rchld, q_rchld; - - /* assume in normal form */ - if (p == NULL && q == NULL) - return (0); - if (p == NULL) - return (1); - if (q == NULL) - return (0); - if (p->variant == MINUS_OP) - p = p->entry.Template.ll_ptr1; - if (q->variant == MINUS_OP) - q = q->entry.Template.ll_ptr1; - if (p->variant == DIV_OP && q->variant == DIV_OP) { - p_rchld = p->entry.Template.ll_ptr2; - q_rchld = q->entry.Template.ll_ptr2; - if (less(p_rchld, q_rchld)) - return (1); - if (less(q_rchld, p_rchld)) - return (0); - /* must be equal */ - return (term_less(p->entry.Template.ll_ptr1, - q->entry.Template.ll_ptr1)); - } - if (p->variant == DIV_OP && q->variant != DIV_OP) { - if (rest_constant(p->entry.Template.ll_ptr1)) - return (term_less(p->entry.Template.ll_ptr2, q)); - } - if (p->variant == MULT_OP && q->variant != MULT_OP) { - if (rest_constant(p->entry.Template.ll_ptr1)) - return (term_less(p->entry.Template.ll_ptr2, q)); - } - if (p->variant != DIV_OP && q->variant == DIV_OP) { - if (rest_constant(q->entry.Template.ll_ptr1)) - return (term_less(p, q->entry.Template.ll_ptr2)); - } - if (p->variant != MULT_OP && q->variant == MULT_OP) { - if (rest_constant(q->entry.Template.ll_ptr1)) - return (term_less(p, q->entry.Template.ll_ptr2)); - } - if (p->variant == MULT_OP && q->variant == MULT_OP) { - p_rchld = p->entry.Template.ll_ptr2; - q_rchld = q->entry.Template.ll_ptr2; - if (less(p_rchld, q_rchld)) - return (1); - if (less(q_rchld, p_rchld)) - return (0); - /* must be equal */ - return (term_less(p->entry.Template.ll_ptr1, q->entry.Template.ll_ptr1)); - } - /* both not mult */ - return (less(p, q)); -} - -void sort_term(p) -PTR_LLND p; -{ - int notdone; - PTR_LLND q; - PTR_LLND lchild, rchild, gchild; - - if(p == NULL) return; - if (p->variant == MINUS_OP) - p = p->entry.Template.ll_ptr1; - if (p->variant != MULT_OP && p->variant != DIV_OP) - return; - notdone = 1; - while (notdone) { - q = p; - notdone = 0; - while (q != NULL && q->entry.Template.ll_ptr1 != NULL) { - lchild = q->entry.Template.ll_ptr1; - rchild = q->entry.Template.ll_ptr2; - if(lchild == NULL || rchild == NULL) return; - if (lchild->variant == INT_VAL && rchild->variant == INT_VAL) { - notdone = 1; - if (q->variant == SUBT_OP) - q->entry.ival = lchild->entry.ival - rchild->entry.ival; - else if (q->variant == ADD_OP) - q->entry.ival = rchild->entry.ival + lchild->entry.ival; - else if (q->variant == MULT_OP) - q->entry.ival = rchild->entry.ival * lchild->entry.ival; - else if (q->variant == DIV_OP && - rchild->entry.ival != 0) - q->entry.ival = lchild->entry.ival / rchild->entry.ival; - else - q->entry.ival = 888888; - q->variant = INT_VAL; - /* better dispose of lchild and rchild later */ - q->entry.Template.ll_ptr1 = NULL; - q->entry.Template.ll_ptr2 = NULL; - } - else if ((q->variant == MULT_OP && - lchild->variant != MULT_OP && lchild->variant != DIV_OP) - && less(lchild, rchild)) { - notdone = 1; - q->entry.Template.ll_ptr1 = rchild; - q->entry.Template.ll_ptr2 = lchild; - } - else if (q->variant == MULT_OP && lchild->variant == MULT_OP) { - gchild = lchild->entry.Template.ll_ptr2; - if (rchild->variant == INT_VAL && gchild->variant == INT_VAL) { - notdone = 1; - rchild->entry.ival = rchild->entry.ival * gchild->entry.ival; - q->entry.Template.ll_ptr1 = lchild->entry.Template.ll_ptr1; - } - else if (less(gchild, rchild)) { - notdone = 1; - q->entry.Template.ll_ptr2 = gchild; - lchild->entry.Template.ll_ptr2 = rchild; - } - } - q = q->entry.Template.ll_ptr1; - } - } -} - -void sort_exp(p) -PTR_LLND p; -{ - int notdone, var; - PTR_LLND q, q1; - PTR_LLND lchild, rchild, gchild; - - q = p; - while (q != NULL && (q->variant != ADD_OP && q->variant != SUBT_OP)) { - if (q != NULL && (q->variant == MULT_OP || q->variant == DIV_OP)) - sort_term(q); - if (q->variant == DIV_OP) { - if (q->entry.Template.ll_ptr1->variant == ADD_OP || - q->entry.Template.ll_ptr1->variant == SUBT_OP) - sort_exp(q->entry.Template.ll_ptr1); - if (q->entry.Template.ll_ptr2->variant == ADD_OP || - q->entry.Template.ll_ptr2->variant == SUBT_OP) - sort_exp(q->entry.Template.ll_ptr2); - } - q = q->entry.Template.ll_ptr1; - } - q1 = q; - if (q1 == NULL) - return; - - while (q != NULL) { - if (q->variant == ADD_OP || q->variant == SUBT_OP) - sort_term(q->entry.Template.ll_ptr2); - else if (q->variant == MULT_OP || q->variant == DIV_OP) - sort_term(q); - if (q->variant == ADD_OP || q->variant == SUBT_OP) - q = q->entry.Template.ll_ptr1; - else - q = NULL; - } - - notdone = 1; - q = q1; - while (notdone) { - q = p; - notdone = 0; - while (q != NULL && q->variant != MULT_OP && q->variant != DIV_OP && - q->entry.Template.ll_ptr1 != NULL) { - lchild = q->entry.Template.ll_ptr1; - rchild = q->entry.Template.ll_ptr2; - if(lchild == NULL || rchild == NULL) return; /* should never happen! */ - if (lchild->variant == INT_VAL && rchild->variant == INT_VAL) { - var = q->variant; - q->variant = INT_VAL; - if (var == ADD_OP) - q->entry.ival = lchild->entry.ival + rchild->entry.ival; - else - q->entry.ival = lchild->entry.ival - rchild->entry.ival; - - q->entry.Template.ll_ptr1 = NULL; - q->entry.Template.ll_ptr2 = NULL; - notdone = 1; - } - else if ((lchild->variant != ADD_OP && lchild->variant != SUBT_OP) - && term_less(lchild, rchild)) { - notdone = 1; - q->entry.Template.ll_ptr1 = rchild; - q->entry.Template.ll_ptr2 = lchild; - if (q->variant == SUBT_OP) { - q->variant = ADD_OP; - lchild = make_llnd(cur_file, INT_VAL, NULL, NULL, 0); - q->entry.Template.ll_ptr1=make_llnd(cur_file,SUBT_OP,lchild,rchild, - NULL); - } - } - else if (lchild->variant == ADD_OP || lchild->variant == SUBT_OP) { - gchild = lchild->entry.Template.ll_ptr2; - if (term_less(gchild, rchild)) { - notdone = 1; - q->entry.Template.ll_ptr2 = gchild; - lchild->entry.Template.ll_ptr2 = rchild; - var = q->variant; - q->variant = lchild->variant; - lchild->variant = var; - } - } - q = q->entry.Template.ll_ptr1; - } - } -} - -PTR_LLND copy_llnd(p) -PTR_LLND p; -{ - PTR_LLND newp; - - if (p == NULL) - return (NULL); - newp = make_llnd(cur_file, p->variant, NULL, NULL, p->entry.Template.symbol); - newp->entry.Template.ll_ptr1 = copy_llnd(p->entry.Template.ll_ptr1); - newp->entry.Template.ll_ptr2 = copy_llnd(p->entry.Template.ll_ptr2); - return (newp); -} - -int integer_difference(p,q, value, dif) -PTR_LLND p,q, *dif; -int *value; -{ - PTR_LLND s; - void simplify(), normal_form(); - - s = make_llnd(cur_file, SUBT_OP, copy_llnd(p),copy_llnd(q), NULL); - normal_form(&s); - *dif = s; - if(s->variant == INT_VAL){ - *value = s->entry.ival; - return 1; - } - else if (s->variant == MINUS_OP){ - s = s->entry.Template.ll_ptr1; - *value = -s->entry.ival; - return 1; - } - return 0; -} - -int no_division(p) -PTR_LLND p; -{ - return (1); -#if 0 - while (p != NULL && p->variant == MULT_OP) - p = p->entry.Template.ll_ptr1; - if (p == NULL) - return (1); - if (p->variant == DIV_OP) - return (0); - return (1); -#endif -} - - -void expand(p) -PTR_LLND p; -{ - PTR_LLND lson, rson, lgchld, rgchld, cpy, new; - if (p == NULL) - return; - - if (p->variant == MULT_OP) { - lson = p->entry.Template.ll_ptr1; - rson = p->entry.Template.ll_ptr2; - if (lson->variant == MULT_OP) { - expand(p->entry.Template.ll_ptr1); - lson = p->entry.Template.ll_ptr1; - } - if (rson->variant == MULT_OP) { - expand(p->entry.Template.ll_ptr2); - rson = p->entry.Template.ll_ptr2; - } - if ((lson->variant == ADD_OP || lson->variant == SUBT_OP)) { - lgchld = lson->entry.Template.ll_ptr1; - rgchld = lson->entry.Template.ll_ptr2; - cpy = copy_llnd(rson); - new = make_llnd(cur_file, MULT_OP, rgchld, rson, NULL); - lson->entry.Template.ll_ptr1 = lgchld; - lson->entry.Template.ll_ptr2 = cpy; - p->entry.Template.ll_ptr2 = new; - p->variant = lson->variant; - lson->variant = MULT_OP; - } - else if ((rson->variant == ADD_OP || rson->variant == SUBT_OP) && - no_division(rson->entry.Template.ll_ptr2) && - no_division(rson->entry.Template.ll_ptr1)) { - lgchld = rson->entry.Template.ll_ptr1; - rgchld = rson->entry.Template.ll_ptr2; - cpy = copy_llnd(lson); - new = make_llnd(cur_file, MULT_OP, lson, lgchld, NULL); - rson->entry.Template.ll_ptr1 = cpy; - rson->entry.Template.ll_ptr2 = rgchld; - - p->entry.Template.ll_ptr1 = new; - p->variant = rson->variant; - rson->variant = MULT_OP; - } - } - expand(p->entry.Template.ll_ptr2); - expand(p->entry.Template.ll_ptr1); -} - -void left_allign_term(p) /* need fix for divide, similar to - fix - * below */ -PTR_LLND *p; -{ - PTR_LLND root_rc, tail_r_chain, last_r_chain, q; - if (*p == NULL) - return; - if ((*p)->variant == MULT_OP) { - if ((*p)->entry.Template.ll_ptr2->variant != DIV_OP) - left_allign_term(&((*p)->entry.Template.ll_ptr2)); - left_allign_term(&((*p)->entry.Template.ll_ptr1)); - - /* now link these together */ - - root_rc = (*p)->entry.Template.ll_ptr2; - q = root_rc; - last_r_chain = NULL; - while (q->variant == MULT_OP /* || q->variant == DIV_OP */ ) { - last_r_chain = q; - q = q->entry.Template.ll_ptr1; - } - tail_r_chain = q; - if (root_rc == tail_r_chain) - return; - last_r_chain->entry.Template.ll_ptr1 = *p; - (*p)->entry.Template.ll_ptr2 = tail_r_chain; - *p = root_rc; - } - if ((*p)->variant == DIV_OP) { - left_allign_term(&((*p)->entry.Template.ll_ptr1)); - left_allign_term(&((*p)->entry.Template.ll_ptr2)); - } - return; -} - - -void left_allign_exp(p) -PTR_LLND *p; -{ - PTR_LLND root_rc, tail_r_chain, last_r_chain, q; - - if (*p == NULL) - return; - if ((*p)->variant == ADD_OP || (*p)->variant == SUBT_OP) { - left_allign_exp(&((*p)->entry.Template.ll_ptr1)); - left_allign_exp(&((*p)->entry.Template.ll_ptr2)); - - /* now link these together */ - - root_rc = (*p)->entry.Template.ll_ptr2; - if(root_rc == NULL) return; - if ((*p)->variant == SUBT_OP) { - for (q = root_rc; q != NULL && - (q->variant == ADD_OP || q->variant == SUBT_OP); - q = q->entry.Template.ll_ptr1) - if (q->variant == SUBT_OP) - q->variant = ADD_OP; - else if (q->variant == ADD_OP) - q->variant = SUBT_OP; - } - q = root_rc; - last_r_chain = NULL; - while (q->variant == ADD_OP || q->variant == SUBT_OP) { - last_r_chain = q; - q = q->entry.Template.ll_ptr1; - } - tail_r_chain = q; - if (root_rc == tail_r_chain) - return; - last_r_chain->entry.Template.ll_ptr1 = *p; - (*p)->entry.Template.ll_ptr2 = tail_r_chain; - *p = root_rc; - } - else if ((*p)->variant == MULT_OP || (*p)->variant == DIV_OP) { - left_allign_term(p); - } - else { - left_allign_exp(&((*p)->entry.Template.ll_ptr1)); - left_allign_exp(&((*p)->entry.Template.ll_ptr2)); - } - return; -} - - -void clear_unary_minus(p) -PTR_LLND p; -{ - PTR_LLND after_minus; - - while (p != NULL && - p->variant != ADD_OP && p->variant != SUBT_OP) - p = p->entry.Template.ll_ptr1; - if (p == NULL) - return; - if (p->variant == ADD_OP || p->variant == SUBT_OP) { - if (p->entry.Template.ll_ptr2->variant == MINUS_OP) { - after_minus = - p->entry.Template.ll_ptr2->entry.Template.ll_ptr1; - p->entry.Template.ll_ptr2 = after_minus; - if (p->variant == ADD_OP) - p->variant = SUBT_OP; - else - p->variant = ADD_OP; - } - clear_unary_minus(p->entry.Template.ll_ptr1); - } -} - -int get_term_coef(p) -PTR_LLND p; -{ - int sign, lval; - - sign = 1; - while (p != NULL && p->variant == MINUS_OP) { - p = p->entry.Template.ll_ptr1; - sign = -sign; - } - if (p == NULL) - return (sign); - if (p->variant == ADD_OP || p->variant == SUBT_OP) - /* should only happen with division as parent */ - return (1); - if (p->variant == VAR_REF) - return (sign); - if (p->variant == INT_VAL) - return (sign * p->entry.ival); - if (p->variant == MULT_OP) { - lval = sign * get_term_coef(p->entry.Template.ll_ptr1); - if (p->entry.Template.ll_ptr2->variant == INT_VAL) - return (lval * p->entry.Template.ll_ptr2->entry.ival); - else - return (lval); - } - if (p->variant == DIV_OP) { - return (sign); - } - else { - fprintf(stderr, "bad coeficient extraction in get_term_coef\n"); - return (1); - } -} - - -void replace_coef(p, v) -PTR_LLND p; -int v; -{ - PTR_LLND new_int, new_var, q; - if (p == NULL) { - fprintf(stderr, "replace_coef failed\n"); - return; - } - if (p->variant == INT_VAL) { - p->entry.ival = v; - return; - } - if (p->variant == ADD_OP || p->variant == SUBT_OP) { - if (v == 1) - return; - replace_coef(p->entry.Template.ll_ptr1, v); - replace_coef(p->entry.Template.ll_ptr2, v); - return; - } - if (p->variant == VAR_REF) { - if (v == 1) - return; - p->variant = MULT_OP; - new_int = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - new_int->entry.ival = v; - new_var = make_llnd(cur_file, VAR_REF,NULL,NULL,p->entry.Template.symbol); - p->entry.Template.ll_ptr1 = new_int; - p->entry.Template.ll_ptr2 = new_var; - p->entry.Template.symbol = NULL; - return; - } - else if (v == 1 && p->variant == MULT_OP && - rest_constant(p->entry.Template.ll_ptr1)) { - new_var = p->entry.Template.ll_ptr2; - p->variant = new_var->variant; - p->entry.Template.symbol = new_var->entry.Template.symbol; - p->entry.Template.ll_ptr1 = new_var->entry.Template.ll_ptr1; - p->entry.Template.ll_ptr2 = new_var->entry.Template.ll_ptr2; - } - else if (p->variant == MULT_OP && - p->entry.Template.ll_ptr1->variant == DIV_OP) - replace_coef(p->entry.Template.ll_ptr2, v); - else if (p->variant == DIV_OP) { - if (v == 1) - return; - q = make_llnd(cur_file, DIV_OP, p->entry.Template.ll_ptr1, - p->entry.Template.ll_ptr2, NULL); - p->entry.Template.ll_ptr1 = q; - p->variant = MULT_OP; - new_int = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); - new_int->entry.ival = v; - p->entry.Template.ll_ptr2 = new_int; - } - else - replace_coef(p->entry.Template.ll_ptr1, v); -} - - -int identical(p, q) -PTR_LLND p, q; -{ - if (q == NULL && p == NULL) - return (1); - if (q == NULL && p != NULL) - return (0); - if (q != NULL && p == NULL) - return (0); - - /* now p and q not null */ - if (p->variant != q->variant) - return (0); - switch (p->variant) { - case VAR_REF: - return (p->entry.Template.symbol == q->entry.Template.symbol); - - case ARRAY_REF: - if (p->entry.Template.symbol != q->entry.Template.symbol) - return (0); - else - return (identical(q->entry.Template.ll_ptr1, - p->entry.Template.ll_ptr1) * - identical(q->entry.Template.ll_ptr2, - p->entry.Template.ll_ptr2)); - - case INT_VAL: - return (p->entry.ival == q->entry.ival); - - default: - return (identical(q->entry.Template.ll_ptr1, - p->entry.Template.ll_ptr1) * - identical(q->entry.Template.ll_ptr2, - p->entry.Template.ll_ptr2)); - - } -} - - -int same_upto_coef(p, q) -PTR_LLND p, q; -{ - PTR_LLND plc, prc, qlc, qrc; - if (p == NULL && q == NULL) - return (1); - if (p == NULL) - return (0); - if (q == NULL) - return (0); - if (p->variant == MINUS_OP) - p = p->entry.Template.ll_ptr1; - if (q->variant == MINUS_OP) - q = q->entry.Template.ll_ptr1; - if (rest_constant(p) && rest_constant(q)) - return (1); - plc = p->entry.Template.ll_ptr1; - prc = p->entry.Template.ll_ptr2; - qlc = q->entry.Template.ll_ptr1; - qrc = q->entry.Template.ll_ptr2; - if (p->variant == VAR_REF) { - if (q->variant == VAR_REF) { - if (p->entry.Template.symbol == q->entry.Template.symbol) - return (1); - else - return (0); - } - else if (q->variant == MULT_OP || q->variant == DIV_OP) { - if (rest_constant(qlc) && - qrc->variant == VAR_REF && - qrc->entry.Template.symbol == p->entry.Template.symbol - ) - return (1); - else - return (0); - } - else - return (0); - } - else if (q->variant == VAR_REF) { - if (p->variant == MULT_OP || p->variant == DIV_OP) { - if (rest_constant(plc) && - prc->variant == VAR_REF && - prc->entry.Template.symbol == q->entry.Template.symbol - ) - return (1); - else - return (0); - } - else - return (0); - } - else if ((p->variant == ADD_OP && q->variant == ADD_OP) || - (p->variant == SUBT_OP && q->variant == SUBT_OP) || - (p->variant == DIV_OP && q->variant == DIV_OP)) - return (identical(p, q)); - else if (p->variant == MULT_OP && q->variant == DIV_OP) { - if ( (rest_constant(prc) && same_upto_coef(plc, q)) - || - (rest_constant(plc) && same_upto_coef(prc, q)) ) - return (1); - else - return (0); - } - else if (q->variant == MULT_OP && p->variant == DIV_OP) { - if ( (rest_constant(qrc) && same_upto_coef(qlc, p)) - || - (rest_constant(qlc) && same_upto_coef(qrc, p)) ) - return (1); - else - return (0); - } - else if (p->variant == q->variant) { - if (same_upto_coef(plc, qlc) && same_upto_coef(prc, qrc)) - return (1); - else - return (0); - } - else - return (0); -} - - -void simplify(p) -PTR_LLND *p; -{ - PTR_LLND q, left, lower, right, qlast, qnext; - PTR_LLND rec_nrm_frm(); - int not_done, val, var, vl, vr, lvar; - - /* clear_unary_minus(*p); */ - not_done = 1; - - if ((*p)->variant == MULT_OP || (*p)->variant == DIV_OP || - (*p)->variant == ADD_OP || (*p)->variant == SUBT_OP) { - if((*p)->entry.Template.ll_ptr1 == NULL) return; - if ((*p)->entry.Template.ll_ptr1->variant != VAR_REF && - (*p)->entry.Template.ll_ptr1->variant != INT_VAL) - (*p)->entry.Template.ll_ptr1 = - rec_nrm_frm((*p)->entry.Template.ll_ptr1); - if((*p)->entry.Template.ll_ptr2 == NULL) return; - if ((*p)->entry.Template.ll_ptr2->variant != VAR_REF && - (*p)->entry.Template.ll_ptr2->variant != INT_VAL) - (*p)->entry.Template.ll_ptr2 = - rec_nrm_frm((*p)->entry.Template.ll_ptr2); - } - - while (not_done) { - not_done = 0; - q = *p; - qlast = NULL; - while (q != NULL && q->variant != MULT_OP && q->variant != DIV_OP && - q->entry.Template.ll_ptr1 != NULL) { - var = q->variant; - if (var == ADD_OP || var == SUBT_OP) { - right = q->entry.Template.ll_ptr2; - left = q->entry.Template.ll_ptr1; - if (left->variant != ADD_OP && left->variant != SUBT_OP) { - if (same_upto_coef(left, right)) { - not_done = 1; - vl = get_term_coef(left); - vr = get_term_coef(right); - if (var == ADD_OP) - val = vl + vr; - else - val = vl - vr; - if (val == 0) { - if (qlast != NULL) { - qlast->entry.Template.ll_ptr1 = - make_llnd(cur_file, INT_VAL, NULL, NULL, 0); - } - else - *p = make_llnd(cur_file, INT_VAL, NULL, NULL, 0); - } - else { - if (val < 0) { - if (var == ADD_OP) - q->variant = SUBT_OP; - else - q->variant = ADD_OP; - val = -val; - } - replace_coef(right, val); - q->variant = right->variant; - if (right->variant != VAR_REF) - q->entry.Template.symbol = NULL; - else - q->entry.Template.symbol = - right->entry.Template.symbol; - q->entry.Template.ll_ptr1 - = right->entry.Template.ll_ptr1; - q->entry.Template.ll_ptr2 - = right->entry.Template.ll_ptr2; - } - } - } - else { - lvar = left->variant; - lower = left->entry.Template.ll_ptr2; - if (same_upto_coef(lower, right)) { - not_done = 1; - vl = get_term_coef(lower); - vr = get_term_coef(right); - if (var == ADD_OP) - val = vr; - else - val = -vr; - if (lvar == ADD_OP) - val = val + vl; - else - val = val - vl; - if (val == 0) { - if (qlast != NULL) { - qlast->entry.Template.ll_ptr1 = - left->entry.Template.ll_ptr1; - } - else - *p = left->entry.Template.ll_ptr1; - } - else { - q->variant = ADD_OP; - if (val >= 0) - replace_coef(right, val); - else { - replace_coef(right, -val); - q->variant = SUBT_OP; - } - q->entry.Template.ll_ptr1 = - left->entry.Template.ll_ptr1; - } - } - } - } - qlast = q; - q = q->entry.Template.ll_ptr1; - } - } /* end of outer while */ - /* now eliminate left over 0 terms. */ - q = *p; - qlast = NULL; - qnext = NULL; - while (q != NULL && ((qnext = q->entry.Template.ll_ptr1) != NULL) - && (q->variant == ADD_OP || q->variant == SUBT_OP) - && (qnext->variant == ADD_OP || qnext->variant == SUBT_OP)) { - qlast = q; - q = q->entry.Template.ll_ptr1; - } - if (qnext == NULL) - return; - if (qnext->variant == INT_VAL && qnext->entry.ival == 0) { - if (q->variant == ADD_OP) { - if (qlast != NULL) { - qlast->entry.Template.ll_ptr1 = - q->entry.Template.ll_ptr2; - /* dispose of q and qnext */ - } - else { - *p = q->entry.Template.ll_ptr2; - /* dispose of q and qnext */ - } - } - else if (q->variant == SUBT_OP) { - q->variant = MINUS_OP; - q->entry.Template.ll_ptr1 = - q->entry.Template.ll_ptr2; - q->entry.Template.ll_ptr2 = NULL; - /* dispose of qnext */ - } - } - -} - - -PTR_LLND -rec_nrm_frm(cp) -PTR_LLND cp; -{ - expand(cp); - left_allign_exp(&cp); - sort_exp(cp); - simplify(&cp); - return (cp); -} - - -void elim_stupid_expr_list(p) -PTR_LLND *p; -{ - if (*p == NULL) - return; - if ((*p)->variant == INT_VAL || (*p)->variant == VAR_REF) - return; - if ((*p)->variant == EXPR_LIST) { - if ((*p)->entry.Template.ll_ptr2 == NULL) - p = &((*p)->entry.Template.ll_ptr1); - else - return; - } - elim_stupid_expr_list(&((*p)->entry.Template.ll_ptr1)); - elim_stupid_expr_list(&((*p)->entry.Template.ll_ptr2)); -} - -PTR_LLND norm_frm_exp(p) -PTR_LLND p; -{ - PTR_LLND cp; - - cp = copy_llnd(p); - elim_stupid_expr_list(&cp); - return (rec_nrm_frm(cp)); -} - - -void normal_form(p) -PTR_LLND *p; -{ - if (p == NULL) - return; - if (*p == NULL) - return; - switch ((*p)->variant) { - case STAR_RANGE: - break; - case ARRAY_REF: - normal_form(&((*p)->entry.Template.ll_ptr1)); - break; - case RANGE_LIST: - case EXPR_LIST: - normal_form(&((*p)->entry.Template.ll_ptr1)); - normal_form(&((*p)->entry.Template.ll_ptr2)); - break; - case DDOT: - normal_form(&((*p)->entry.Template.ll_ptr1)); - normal_form(&((*p)->entry.Template.ll_ptr2)); - break; - case ADD_OP: - case SUBT_OP: - case MULT_OP: - case DIV_OP: - case MINUS_OP: - case VAR_REF: - case INT_VAL: - *p = norm_frm_exp(*p); - break; - default: - fprintf(stderr, "bad case in normal_form %d\n", (*p)->variant); - break; - } -} diff --git a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/writenodes.c b/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/writenodes.c deleted file mode 100644 index e50edff..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/lib/oldsrc/writenodes.c +++ /dev/null @@ -1,1018 +0,0 @@ -/*********************************************************************/ -/* pC++/Sage++ Copyright (C) 1993 */ -/* Indiana University University of Oregon University of Rennes */ -/*********************************************************************/ - - -/*------------------------------------------------------* - * * - * Routines to write BIF graph out * - * * - *------------------------------------------------------*/ - -#include -#include - -#include "compatible.h" -#ifdef SYS5 -#include -#else -#include -#endif - -#ifdef __SPF -extern void addToCollection(const int line, const char *file, void *pointer, int type); -extern void removeFromCollection(void *pointer); -#endif - -/*typedef unsigned int u_short;*/ -#include "db.h" -#include "dep_str.h" -/*extern char* strncpy(); */ - -#define FOLLOW_BIF_POINTER_TO_ID(VAR) \ - (bf_ptr->entry.Template.VAR? bf_ptr-> entry.Template.VAR->id: 0) - -#define FOLLOW_LL_POINTER_TO_ID(VAR) \ - (ll_ptr-> entry.Template.VAR? ll_ptr-> entry.Template.VAR->id: 0) - -#define FOLLOW_SYMB_POINTER_1_TO_ID(VAR) \ - (sy_ptr->VAR? sy_ptr->VAR->id: 0) - -#define FOLLOW_SYMB_POINTER_2_TO_ID(VAR) \ - (sy_ptr->entry.VAR? sy_ptr->entry.VAR->id: 0) - -#define FOLLOW_TYPE_POINTER_TO_ID(VAR) \ - (ty_ptr->entry.VAR? ty_ptr->entry.VAR->id: 0) - -#define FOLLOW_DEP_TO_ID(VAR) \ - (dep->VAR? dep->VAR->id: 0) - -/* - * External variables/functions referenced - */ - -static PTR_BFND head_bfnd, cur_bfnd; -static PTR_LLND head_llnd, cur_llnd; -static PTR_SYMB head_symb, cur_symb; -static PTR_TYPE head_type, cur_type; -static PTR_DEP head_dep, cur_dep; -static PTR_LABEL head_label, cur_label; -static PTR_CMNT head_cmnt, cur_cmnt; -static PTR_FNAME head_file; -static PTR_BFND global_bfnd; - -static int num_blobs; -static int num_bfnds; -static int num_llnds; -static int num_symbs; -static int num_types; -static int num_label; -static int num_cmnt; -static int num_files; -static int num_dep; - -extern int language; -extern int debug; - -/* - * Local variables - */ -static struct preamble head; -static struct bf_nd bf; -static struct ll_nd ll; -static struct sym_nd sym; -static struct typ_nd typ; -static struct lab_nd lab; -static struct fil_nd fil; -static struct cmt_nd cmt; -static struct dep_nd dpd; -static struct locs loc; - -static FILE *fd; /* file pointer of the dep file */ -static char **strtbl, /* start of string table */ - **endtbl, /* end of string table */ - **cp; /* current pointer */ -static int nstr = 0; /* no of string stored so far */ -static int tblsz = 2000; /* initial string table size */ - -static u_shrt tmp[100000]; /* some work space */ - -/*------------------------------------------------------* - * store_str * - * * - * put the given string into string table * - *------------------------------------------------------*/ -static u_shrt -store_str(str) - char *str; -{ - if (nstr >= tblsz) { - tblsz += 1000; -#ifdef __SPF - removeFromCollection(strtbl); -#endif - if (!(strtbl = (char **)realloc(strtbl, tblsz * sizeof(char **)))) - { - fprintf(stderr, "store_str: No more space\n"); - exit(1); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,strtbl, 0); -#endif - endtbl = strtbl + tblsz; - cp = strtbl + nstr; - } - *cp++ = str; - return (u_shrt)nstr++; -} - - -/*------------------------------------------------------* - * find_global_bif_node * - * * - * Find the global bif node (there is only one) * - *------------------------------------------------------*/ -PTR_BFND -find_global_bif_node() -{ - register PTR_BFND bf_node; - - bf_node = head_bfnd; - while (bf_node->variant != GLOBAL) - bf_node = bf_node->thread; - - return (bf_node); -} - - -/*------------------------------------------------------* - * write_preamble * - * * - * Write the preamble of the dep file * - *------------------------------------------------------*/ -static int -write_preamble() -{ - u_shrt magic_no = D_MAGIC; - char filemagic[10]; - - strncpy(filemagic,"sage.dep",8); - /* The first 8 bytes is the file magic (see /etc/magic) PHB */ - if ((int)fwrite(filemagic, sizeof(char), 8, fd) < 0) - return -1; - - if ((int)fwrite( (char *) &magic_no, sizeof(u_shrt), 1, fd) < 0) - return -1; - - if ((int)fwrite( (char *) &loc, sizeof(struct locs), 1, fd) < 0) - return -1; - - head.ptrsize = (u_shrt) ( sizeof(void *) * 8 ); - head.language = (u_shrt) language; - head.num_blobs = (u_shrt) num_blobs; - head.num_bfnds = (u_shrt) num_bfnds; - head.num_llnds = (u_shrt) num_llnds; - head.num_symbs = (u_shrt) num_symbs; - head.num_types = (u_shrt) num_types; - head.num_label = (u_shrt) num_label; - head.global_bfnd= (u_shrt) global_bfnd->id; - head.num_dep = (u_shrt) num_dep; - head.num_cmnts = (u_shrt) num_cmnt; - head.num_files = (u_shrt) num_files; - - return (int)fwrite( (char *) &head, sizeof(struct preamble), 1, fd); -} - - -/*------------------------------------------------------* - * write_blob_list * - * * - * dump the blob list with the given head * - *------------------------------------------------------*/ -static int -write_blob_list(head) - PTR_BLOB head; -{ - register PTR_BLOB bl_ptr; - u_shrt *p; - int n; - - for (bl_ptr = head, p = tmp+1; bl_ptr; bl_ptr = bl_ptr->next) - if( bl_ptr->ref) - *p++ = (u_shrt) bl_ptr->ref->id; - - n = p - tmp; /* calculate the no of blob nodes in the list */ - tmp[0] = (u_shrt) n - 1; - return (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd); -} - - -/*------------------------------------------------------* - * write_bif_node * - * * - * routines to write out one bif node * - *------------------------------------------------------*/ -static int -write_bif_node(bf_ptr) - PTR_BFND bf_ptr; -{ - bf.id = (u_shrt) bf_ptr->id; - bf.variant = (u_shrt) bf_ptr->variant; - bf.cp = (u_shrt) (bf_ptr->control_parent? bf_ptr->control_parent->id :0); - bf.bf_ptr1 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(bf_ptr1); - bf.cmnt_ptr= (u_shrt) FOLLOW_BIF_POINTER_TO_ID(cmnt_ptr); - bf.symbol = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(symbol); - bf.ll_ptr1 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(ll_ptr1); - bf.ll_ptr2 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(ll_ptr2); - bf.ll_ptr3 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(ll_ptr3); - bf.dep_ptr1= (u_shrt) FOLLOW_BIF_POINTER_TO_ID(dep_ptr1); - bf.dep_ptr2= (u_shrt) FOLLOW_BIF_POINTER_TO_ID(dep_ptr2); - bf.label = (u_shrt) (bf_ptr->label? bf_ptr->label->id: 0); - bf.lbl_ptr = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(lbl_ptr); - bf.g_line = (u_shrt) bf_ptr->g_line; - bf.l_line = (u_shrt) bf_ptr->l_line; - bf.decl_specs = (u_shrt) bf_ptr->decl_specs; - bf.filename= (u_shrt) (bf_ptr->filename? bf_ptr->filename->id: 0); - - if ((int)fwrite( (char *) &bf, sizeof(struct bf_nd), 1, fd) < 0) - return -1; - if (write_blob_list(bf_ptr->entry.Template.bl_ptr1) < 0) - return -1; - return write_blob_list(bf_ptr->entry.Template.bl_ptr2); -} - - -/*------------------------------------------------------* - * write_bif_nodes * - * * - * routines to print bif nodes * - *------------------------------------------------------*/ -static int -write_bif_nodes() -{ - register PTR_BFND bf_ptr; - - for (bf_ptr = head_bfnd; bf_ptr; bf_ptr = bf_ptr->thread) - if (write_bif_node(bf_ptr) < 0) { - perror("write_bif_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_ll_node * - * * - * print out one low level node * - *------------------------------------------------------*/ -static int -write_ll_node(ll_ptr) - PTR_LLND ll_ptr; -{ - int n = 0; - - ll.id = (u_shrt) ll_ptr->id; - ll.variant = (u_shrt) ll_ptr->variant; - ll.type = (u_shrt) (ll_ptr->type ? ll_ptr->type->id : 0); - if ((int)fwrite( (char *) &ll, sizeof(struct ll_nd), 1, fd) < 0) - return -1; - - switch (ll_ptr->variant) { - case INT_VAL: - return (int)fwrite( (char *) &ll_ptr->entry.ival, sizeof(int), 1, fd); - case BOOL_VAL: - tmp[0] = (u_shrt) ll_ptr->entry.bval; - n = 1; - break; - case CHAR_VAL: - tmp[0] = (u_shrt) ll_ptr->entry.cval; - n = 1; - break; - case DOUBLE_VAL: - case FLOAT_VAL: - case STMT_STR: - case STRING_VAL: - case KEYWORD_VAL: - tmp[0] = store_str(ll_ptr->entry.string_val); - n = 1; - break; - case RANGE_OP: - case UPPER_OP: - case LOWER_OP: - tmp[0] = (u_shrt) (ll_ptr->entry.array_op.symbol ? - ll_ptr->entry.array_op.symbol->id : - 0); - tmp[1] = (u_shrt) ll_ptr->entry.array_op.dim; - n = 2; - break; - case LABEL_REF: - tmp[0] = (u_shrt) ll_ptr->entry.label_list.lab_ptr->id; - n = 1; - break; -/* case ARITH_ASSGN_OP: */ /* New added for VPC++ */ -/* The next line is a _REAL_ hack, I added the cast (PHB) */ -/* tmp[0] = (u_shrt) ((int) ll_ptr->entry.Template.symbol); - tmp[1] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr1); - tmp[2] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr2); - n = 3; - break; -*/ - default: - tmp[0] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(symbol); - tmp[1] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr1); - tmp[2] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr2); - n = 3; - break; - } - return (n? (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd): 0); -} - - -/*------------------------------------------------------* - * write_ll_nodes * - * * - * dump low level nodes * - *------------------------------------------------------*/ -static int -write_ll_nodes() -{ - register PTR_LLND ll_ptr; - - for (ll_ptr = head_llnd; ll_ptr; ll_ptr = ll_ptr->thread) - if (write_ll_node(ll_ptr) < 0) { - perror("write_ll_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_symb_node * - * * - * print out one symbol node * - *------------------------------------------------------*/ -static int -write_symb_node(sy_ptr) - PTR_SYMB sy_ptr; -{ - int n = 0; - - sym.id = (u_shrt) sy_ptr->id; - sym.variant = (u_shrt) sy_ptr->variant; - sym.type = (u_shrt) FOLLOW_SYMB_POINTER_1_TO_ID(type); - sym.attr = (u_shrt) sy_ptr->attr; - sym.next = (u_shrt) FOLLOW_SYMB_POINTER_1_TO_ID(next_symb); - sym.scope = (u_shrt) (sy_ptr->scope? sy_ptr->scope->id: 0); - sym.ident = store_str(sy_ptr->ident); - - if ((int)fwrite( (char *) &sym, sizeof(struct sym_nd), 1, fd) < 0) - return -1; - - switch (sy_ptr->variant) { - case CONST_NAME: - tmp[0] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(const_value); - tmp[1] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); - n = 2; - break; - case ENUM_NAME: - case FIELD_NAME: - tmp[0] = (u_shrt)sy_ptr->entry.field.tag; - tmp[1] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.next); - tmp[2] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.base_name); - tmp[3] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.declared_name); /* VPC++ */ - tmp[4] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.restricted_bit); /* VPC++ */ - n = 5; - break; - case VARIABLE_NAME: - tmp[0] = (u_shrt)sy_ptr->entry.var_decl.local; - tmp[1] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(var_decl.next_in); - tmp[2] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(var_decl.next_out); - n = 3; - tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); - n++; - break; - case PROGRAM_NAME: - tmp[0] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(prog_decl.symb_list); - tmp[1] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(prog_decl.prog_hedr); - n = 2; - tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); - n++; - break; - case PROCEDURE_NAME: - case PROCESS_NAME: - case FUNCTION_NAME: - case INTERFACE_NAME: - tmp[0] = (u_shrt) sy_ptr->entry.proc_decl.num_input; - tmp[1] = (u_shrt) sy_ptr->entry.proc_decl.num_output; - tmp[2] = (u_shrt) sy_ptr->entry.proc_decl.num_io; - tmp[3] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.in_list); - tmp[4] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.out_list); - tmp[5] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.symb_list); - tmp[6] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.proc_hedr); - tmp[7] = (u_shrt) sy_ptr->entry.func_decl.local_size; - n = 8; - tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); - n++; - break; - case MODULE_NAME: - tmp[0] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.symb_list); - tmp[1] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.func_hedr); - tmp[2] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); - n = 3; - break; - case MEMBER_FUNC: /* NEW ADDED FOR VPC */ - tmp[0] = (u_shrt) sy_ptr->entry.member_func.num_input; - tmp[1] = (u_shrt) sy_ptr->entry.member_func.num_output; - tmp[2] = (u_shrt) sy_ptr->entry.member_func.num_io; - tmp[3] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.in_list); - tmp[4] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.out_list); - tmp[5] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.symb_list); - tmp[6] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.func_hedr); - tmp[7] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.next); - tmp[8] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.base_name); - tmp[9] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.declared_name); - tmp[10] = (u_shrt) sy_ptr->entry.member_func.local_size; - n = 11; - break; - default: - tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); - n++; - break; - } - - return (n? (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd): 0); -} - - -/*------------------------------------------------------* - * write_symb_nodes * - * * - * dump symbol table * - *------------------------------------------------------*/ -static int -write_symb_nodes() -{ - register PTR_SYMB sy_ptr; - - for (sy_ptr = head_symb; sy_ptr; sy_ptr = sy_ptr->thread) - if (write_symb_node(sy_ptr) < 0) { - perror("write_symb_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_type_node * - * * - * print out one type node * - *------------------------------------------------------*/ -static int -write_type_node(ty_ptr) - PTR_TYPE ty_ptr; -{ - int n = 0; - int uss1; - typ.id = (u_shrt) ty_ptr->id; - typ.variant = (u_shrt) ty_ptr->variant; - typ.name = (u_shrt) (ty_ptr->name ? ty_ptr->name->id : 0); - - if ((int)fwrite( (char *) &typ, sizeof(struct typ_nd), 1, fd) < 0) - return -1; - - switch (ty_ptr->variant) { - case T_INT: - case T_FLOAT: - case T_DOUBLE: - case T_CHAR: - case T_BOOL: - case T_COMPLEX: - case T_DCOMPLEX: - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.ranges); - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.kind_len); - n = 2; - break; - case T_STRING: - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.ranges); - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.kind_len); - tmp[2] = (u_shrt) ty_ptr->entry.Template.dummy1; - n = 3; - break; - case T_SUBRANGE: - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(subrange.base_type); - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(subrange.lower); - tmp[2] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(subrange.upper); - n = 3; - break; - case T_ARRAY: - tmp[0] = (u_shrt) ty_ptr->entry.ar_decl.num_dimensions; - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(ar_decl.base_type); - tmp[2] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(ar_decl.ranges); - n = 3; - break; - case T_LIST: - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(base_type); - n = 1; - break; - case T_RECORD: - tmp[0] = (u_shrt) ty_ptr->entry.re_decl.num_fields; - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(re_decl.first); - n = 2; - break; - case T_DESCRIPT: /* NEW ADDED FOR VPC */ - tmp[0] = (u_shrt) ty_ptr->entry.descriptive.signed_flag ; - uss1 = ty_ptr->entry.descriptive.long_short_flag; - tmp[2] = (u_shrt) uss1; - tmp[1] = (u_shrt) (uss1 >> 16); - tmp[3] = (u_shrt) ty_ptr->entry.descriptive.mod_flag ; - tmp[4] = (u_shrt) ty_ptr->entry.descriptive.storage_flag ; - tmp[5] = (u_shrt) ty_ptr->entry.descriptive.access_flag ; - tmp[6] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(descriptive.base_type); - n = 7; - break; - case T_POINTER: /* NEW ADDED FOR VPC */ - case T_REFERENCE: /* NEW ADDED FOR VPC */ - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.base_type); - tmp[1] = (u_shrt) ty_ptr->entry.Template.dummy1 ; /* indirect level */ - uss1 = ty_ptr->entry.Template.dummy5 ; /* for const etc. */ - tmp[3] = (u_shrt) uss1; - tmp[2] = (u_shrt) (uss1 >> 16); - n = 4; - break; - - case T_FUNCTION: /* NEW ADDED FOR VPC */ - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.base_type); - n = 1; - break; - - case T_DERIVED_TYPE : /* NEW ADDED FOR VPC */ - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_type.symbol); - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_type.scope_symbol); - n = 2; - break; - case T_MEMBER_POINTER: - case T_DERIVED_COLLECTION : /* NEW ADDED FOR PC++ */ - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(col_decl.collection_name); - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(col_decl.base_type); - n = 2; - break; - case T_DERIVED_TEMPLATE : /* NEW ADDED FOR PC++ */ - tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(templ_decl.templ_name); - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(templ_decl.args); - n = 2; - break; - case T_ENUM: - case T_UNION: /* NEW ADDED FOR VPC */ - case T_STRUCT: /* NEW ADDED FOR VPC */ - case T_CLASS : /* NEW ADDED FOR VPC */ - case T_DERIVED_CLASS : /* NEW ADDED FOR VPC */ - case T_COLLECTION: /* NEW ADDED FOR PC++ */ - tmp[0] = (u_shrt) ty_ptr->entry.derived_class.num_fields; - tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_class.first); - tmp[2] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_class.original_class); - tmp[3] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_class.base_type); - n = 4; - break; - - default: - break; - } - return (n? (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd): 0); -} - - -/*------------------------------------------------------* - * write_type_nodes * - *------------------------------------------------------*/ -static int -write_type_nodes() -{ - register PTR_TYPE ty_ptr; - - for (ty_ptr = head_type; ty_ptr; ty_ptr = ty_ptr->thread) - if (write_type_node(ty_ptr) < 0) { - perror("write_type_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_label_node * - *------------------------------------------------------*/ -static int -write_label_node(lb_ptr) - register PTR_LABEL lb_ptr; -{ - lab.id = (u_shrt) lb_ptr->id; - lab.labtype = (u_shrt) lb_ptr->labtype; - lab.body = (u_shrt) (lb_ptr->statbody ? lb_ptr->statbody->id : 0); - lab.name = (u_shrt) (lb_ptr->label_name ? lb_ptr->label_name->id: 0); - lab.stat_no = lb_ptr->stateno; - return (int)fwrite( (char *) &lab, sizeof(struct lab_nd), 1, fd); -} - - -/*------------------------------------------------------* - * write_label_nodes * - *------------------------------------------------------*/ -static int -write_label_nodes() -{ - register PTR_LABEL lb_ptr; - - for (lb_ptr = head_label; lb_ptr; lb_ptr = lb_ptr->next) - if (write_label_node(lb_ptr) < 0) { - perror("write_label_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_filename_nodes * - *------------------------------------------------------*/ -static int -write_filename_nodes() -{ - register PTR_FNAME filep; - - for (filep = head_file; filep; filep = filep->next) { - fil.id = (u_shrt) filep->id; - fil.name = store_str(filep->name); - if ((int)fwrite( (char *) &fil, sizeof(struct fil_nd), 1, fd) < 0) { - perror("write_filename_nodes:"); - return -1; - } - } - return 0; -} - - -/*------------------------------------------------------* - * write_comment_node * - * * - * print out one comment node * - *------------------------------------------------------*/ -static int -write_comment_node(cm_ptr) - PTR_CMNT cm_ptr; -{ - cmt.id = (u_shrt) cm_ptr->id; - cmt.type = (u_shrt) cm_ptr->type; - cmt.next = (u_shrt) (cm_ptr->next ? cm_ptr->next->id : 0); - cmt.str = store_str(cm_ptr->string); - return (int)fwrite( (char *) &cmt, sizeof(struct cmt_nd), 1, fd); -} - - -/*------------------------------------------------------* - * write_comment_nodes * - *------------------------------------------------------*/ -static int -write_comment_nodes() -{ - register PTR_CMNT cm_ptr; - - for (cm_ptr = head_cmnt; cm_ptr; cm_ptr = cm_ptr->thread) - if (write_comment_node(cm_ptr) < 0) { - perror("write_comment_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_dep_node * - * * - * print out one dependence node * - *------------------------------------------------------*/ -static int -write_dep_node(dep) - PTR_DEP dep; -{ - register int j; - - dpd.id = (u_shrt) dep->id; - dpd.type = (u_shrt) dep->type; - dpd.sym = (u_shrt) FOLLOW_DEP_TO_ID(symbol); - dpd.from_stmt = (u_shrt) FOLLOW_DEP_TO_ID(from.stmt); - dpd.from_ref = (u_shrt) FOLLOW_DEP_TO_ID(from.refer); - dpd.to_stmt = (u_shrt) FOLLOW_DEP_TO_ID(to.stmt); - dpd.to_ref = (u_shrt) FOLLOW_DEP_TO_ID(to.refer); - dpd.from_hook = (u_shrt) 0; /* FOLLOW_DEP_TO_ID(from_hook); */ - dpd.to_hook = (u_shrt) 0; /* FOLLOW_DEP_TO_ID(to_hook); */ - dpd.from_fwd = (u_shrt) FOLLOW_DEP_TO_ID(from_fwd); - dpd.from_back = (u_shrt) FOLLOW_DEP_TO_ID(from_back); - dpd.to_fwd = (u_shrt) FOLLOW_DEP_TO_ID(to_fwd); - dpd.to_back = (u_shrt) FOLLOW_DEP_TO_ID(to_back); - - for (j = 0; j < MAX_DEP; j++) - dpd.dire[j] = (u_shrt) dep->direct[j]; - - return (int)fwrite( (char *) &dpd, sizeof(struct dep_nd), 1, fd); -} - - - -/*------------------------------------------------------* - * write_dep_nodes * - *------------------------------------------------------*/ -static int -write_dep_nodes() -{ - register PTR_DEP dep; - - if (!num_dep) - return 0; - for (dep = head_dep; dep && dep->id != -1; dep = dep->thread) - if (write_dep_node(dep) < 0) { - perror("write_dep_nodes:"); - return -1; - } - return 0; -} - - -/*------------------------------------------------------* - * write_string * - *------------------------------------------------------*/ -static int -write_string(str) - char *str; -{ - int l1; - - if(!str) l1 = 0; - else l1 = strlen(str); - tmp[0] = (u_shrt) l1; - if ((int)fwrite( (char *) tmp, sizeof(u_shrt), 1, fd) >= 0) - if ((int)fwrite( (char *) str, sizeof(char), l1, fd) >= 0) - return 0; - return -1; -} - - -/*------------------------------------------------------* - * write_str_tbl * - *------------------------------------------------------*/ -static int -write_str_tbl(str, n) - char **str; - int n; -{ - register char **p = str; - register int i; - u_shrt u; - - u = (u_shrt) n; - if ((int)fwrite( (char *) &u, sizeof(u_shrt), 1, fd) < 0) /* output no of strings */ - return -1; - for (i = 0; i < n; i++) - if (write_string(*p++) < 0) { - perror("write_str_tbl:"); - return -1; - } - return 0; -} - - -/**************************************************************** - * * - * fix_next_symb -- Try to fix the "next_symb" field in the * - * symbol table field so that they point to * - * the next symbol declared in the same scope * - ****************************************************************/ -static void - fix_next_symb() -{ - register int no = 0, i, max=0; - register PTR_SYMB s; - int *id; /* table to store ids of difference scope */ - PTR_SYMB *pt; /* point to the last symbol in that scope */ - - /* This is a hack to find out how much memory we need to malloc (PHB) */ - for (s = head_symb; s; s = s->thread) max++; - - /* malloc the memory (PHB) */ - id = (int *) malloc(sizeof( int) * (max+100)); - pt = (PTR_SYMB *) malloc(sizeof(PTR_SYMB) * (max+100)); - if ((pt == 0) || (id == 0)) - { fprintf(stderr,"Out of memory in fix_next_symb\n"); exit(1); } - - for (s = head_symb; s; s = s->thread) { - for (i = no - 1 ; i >= 0; --i) - if ((s->scope != NULL) && (id[i] == s->scope->id)) - /* found one on the table */ - break; - if (i >= 0) { /* if already in table */ - if (i > max) - { fprintf(stderr,"index out of range in fix_next_symb\n"); exit(1);} - pt[i]->next_symb = s; /* add to the end in this scope */ - pt[i] = s; /* this one becomes the tail */ - } else - if (s->scope) { /* A new one -- add to the table */ - if (no > max) - { fprintf(stderr,"index out of range in fix_next_symb\n"); exit(1);} - id[no] = s->scope->id; /* id of new scope */ - pt[no++] = s; /* tail pointer */ - } - } - free(id); - free(pt); -} - - -/*------------------------------------------------------* - * * - * driver routines to print nodes * - * * - *------------------------------------------------------*/ -int -write_nodes(fi, name) - PTR_FILE fi; - char *name; -{ - if ((fd = fopen (name, "wb")) == NULL) { - fprintf(stderr, "Could not open %s for write\n", name); - return (-1); - } - - head_bfnd = fi->head_bfnd; - cur_bfnd = fi->cur_bfnd; - head_llnd = fi->head_llnd; - cur_llnd = fi->cur_llnd; - head_symb = fi->head_symb; - cur_symb = fi->cur_symb; - head_type = fi->head_type; - cur_type = fi->cur_type; - head_dep = fi->head_dep; - cur_dep = fi->cur_dep; - head_label = fi->head_lab; - cur_label = fi->cur_lab; - head_cmnt = fi->head_cmnt; - cur_cmnt = fi->cur_cmnt; - head_file = fi->head_file; - global_bfnd = fi->global_bfnd; - - num_blobs = fi->num_blobs; - num_bfnds = fi->num_bfnds; - num_llnds = fi->num_llnds; - num_symbs = fi->num_symbs; - num_types = fi->num_types; - num_label = fi->num_label; - num_cmnt = fi->num_cmnt; - num_files = fi->num_files; - num_dep = fi->num_dep; - - nstr = 0; - if (strtbl == NULL) - { - if (!(strtbl = (char **)calloc(tblsz, sizeof(char *)))) - { - perror("write_nodes(): calloc() error"); - return (-1); - } -#ifdef __SPF - addToCollection(__LINE__, __FILE__,strtbl, 0); -#endif - } - cp = strtbl; - endtbl = strtbl + tblsz; - - if (!global_bfnd) - global_bfnd = find_global_bif_node(); - - fix_next_symb(); - if (write_preamble() < 0) { - perror("write_nodes(): write_preamble() failed"); - return (-1); - } - - if (write_bif_nodes() < 0) { - perror("write_nodes(): write_bif_nodes() failed"); - return (-1); - } - - if ((loc.llnd = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (0)"); - return (-1); - } - - if (write_ll_nodes() < 0) { - perror("write_nodes(): write_ll_nodes() failed"); - return (-1); - } - - if ((loc.symb = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (1)"); - return (-1); - } - - if (write_symb_nodes() < 0) { - perror("write_nodes(): write_symb_nodes() failed"); - return (-1); - } - - if ((loc.type = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (2)"); - return (-1); - } - - if (write_type_nodes() < 0) { - perror("write_nodes(): write_type_nodes() failed"); - return (-1); - } - - if ((loc.labs = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (3)"); - return (-1); - } - - if (write_label_nodes() < 0) { - perror("write_nodes(): write_label_nodes() failed"); - return (-1); - } - - if ((loc.cmnt = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (4)"); - return (-1); - } - - if (write_comment_nodes() < 0) { - perror("write_nodes(): write_comment_nodes() failed"); - return (-1); - } - - if ((loc.file = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (5)"); - return (-1); - } - - if (write_filename_nodes() < 0) { - perror("write_nodes(): write_filename_nodes() failed"); - return (-1); - } - - if ((loc.deps = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (6)"); - return (-1); - } - - if (write_dep_nodes() < 0) { - perror("write_nodes(): write_dep_nodes() failed"); - return (-1); - } - - if ((loc.strs = ftell(fd)) < 0) { - perror("write_nodes(): ftell() failed (7)"); - return (-1); - } - - if (write_str_tbl(strtbl, nstr) < 0) { - perror("write_nodes(): write_str_tbl() failed"); - return (-1); - } - - /* Rewind to beginning of data segment (Magic + sage.dep) PHB */ - if (fseek(fd, (long)sizeof(u_shrt)+(long)8, 0) < 0) { - perror("write_nodes(): fseek"); - return -1; - } - /* write out the offsets */ - if ((int)fwrite( (char *) &loc, sizeof(struct locs), 1, fd) < 0) { - perror("write_nodes(): Could not write out offsets"); - return -1; - } - - if (fclose(fd) < 0) { - perror("write_nodes(): Could not close dep file"); - return -1; - } - - return 0; -} - - -int -rewrite_depfile (fi, name) - PTR_FILE fi; - char *name; -{ - int i; - PTR_BFND tmp; - - tmp = fi->global_bfnd->control_parent; - fi->global_bfnd->control_parent = NULL; - i = write_nodes (fi, name); - fi->global_bfnd->control_parent = tmp; - return i; -} - diff --git a/projects/dvm_svn/fdvm/trunk/Sage/makefile.uni b/projects/dvm_svn/fdvm/trunk/Sage/makefile.uni deleted file mode 100644 index 520704e..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/makefile.uni +++ /dev/null @@ -1,35 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# dvm/fdvm/Sage/makefile.uni (phb) -# -# This makefile recursively calls MAKE in each subdirectory -# - -# What to compile -SUBDIR=lib Sage++ - -lib: - cd lib; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -Sage++: - cd Sage++; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - -all: lib Sage++ - @echo "****** DONE MAKING SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - -clean: - @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - cd lib; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - cd Sage++; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @echo "****** DONE CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - -cleanall: - @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - cd lib; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall - cd Sage++; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall - @echo "****** DONE CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - -.PHONY: all clean cleanall lib Sage++ diff --git a/projects/dvm_svn/fdvm/trunk/Sage/makefile.win b/projects/dvm_svn/fdvm/trunk/Sage/makefile.win deleted file mode 100644 index 6ce06c7..0000000 --- a/projects/dvm_svn/fdvm/trunk/Sage/makefile.win +++ /dev/null @@ -1,46 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - - -# dvm/fdvm/Sage/makefile.win (phb) - -# Valentin Emelianov (4/01/99) - -# -# This makefile recursively calls MAKE in each subdirectory -# - -# What to compile -SUBDIR=lib Sage++ - -all: - @echo "****** RECURSIVELY MAKING SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - @cd lib - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - @cd .. - @cd Sage++ - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all - @cd .. - @echo "****** DONE MAKING SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - -clean: - @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - @cd lib - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @cd .. - @cd Sage++ - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean - @cd .. - @echo "****** DONE CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - -cleanall: - @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" - @cd lib - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall - @cd .. - @cd Sage++ - @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall - @cd .. - @echo "****** DONE CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj deleted file mode 100644 index e7dd78d..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj +++ /dev/null @@ -1,123 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - {2069BEB4-7CBF-421E-BAFF-AABDF23442C5} - Win32Proj - CodeTransformer - 10.0.10586.0 - - - - Application - true - v140 - Unicode - false - false - false - No - - - Application - false - v140 - true - Unicode - false - false - false - No - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VC_IncludePath);$(WindowsSDK_IncludePath);$(IncludePath) - ..\Debug\ - - - false - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VC_IncludePath);$(WindowsSDK_IncludePath);$(IncludePath) - ..\Release\ - - - - - - Level3 - Disabled - WIN32;_DEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions) - true - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - - - Console - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions) - true - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - - - Console - true - true - true - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters deleted file mode 100644 index 38275eb..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters +++ /dev/null @@ -1,74 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hh;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln deleted file mode 100644 index 02f4c9f..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln +++ /dev/null @@ -1,65 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 14 -VisualStudioVersion = 14.0.25123.0 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FDVM", "FDVM\FDVM.vcxproj", "{FF6D569D-DBD5-47C7-8149-71E401B0D2E4}" - ProjectSection(ProjectDependencies) = postProject - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} = {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} - {0F9AF026-C750-4245-A5A5-6A58CF3F930A} = {0F9AF026-C750-4245-A5A5-6A58CF3F930A} - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} = {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "inlineExp", "inlineExp\inlineExp.vcxproj", "{5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}" - ProjectSection(ProjectDependencies) = postProject - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} = {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} - {0F9AF026-C750-4245-A5A5-6A58CF3F930A} = {0F9AF026-C750-4245-A5A5-6A58CF3F930A} - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} = {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "SageLib++", "SageLib++\SageLib++.vcxproj", "{DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}" -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Parser", "Parser\Parser.vcxproj", "{23A23D24-2079-462A-A273-AB28271D68E6}" - ProjectSection(ProjectDependencies) = postProject - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} = {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "OLDsrc", "OLDsrc\OLDsrc.vcxproj", "{F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}" -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "NEWsrc", "NEWsrc\NEWsrc.vcxproj", "{0F9AF026-C750-4245-A5A5-6A58CF3F930A}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Release|Win32 = Release|Win32 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Debug|Win32.ActiveCfg = Debug|Win32 - {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Debug|Win32.Build.0 = Debug|Win32 - {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Release|Win32.ActiveCfg = Release|Win32 - {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Release|Win32.Build.0 = Release|Win32 - {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Debug|Win32.ActiveCfg = Debug|Win32 - {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Debug|Win32.Build.0 = Debug|Win32 - {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Release|Win32.ActiveCfg = Release|Win32 - {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Release|Win32.Build.0 = Release|Win32 - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Debug|Win32.ActiveCfg = Debug|Win32 - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Debug|Win32.Build.0 = Debug|Win32 - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Release|Win32.ActiveCfg = Release|Win32 - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Release|Win32.Build.0 = Release|Win32 - {23A23D24-2079-462A-A273-AB28271D68E6}.Debug|Win32.ActiveCfg = Debug|Win32 - {23A23D24-2079-462A-A273-AB28271D68E6}.Debug|Win32.Build.0 = Debug|Win32 - {23A23D24-2079-462A-A273-AB28271D68E6}.Release|Win32.ActiveCfg = Release|Win32 - {23A23D24-2079-462A-A273-AB28271D68E6}.Release|Win32.Build.0 = Release|Win32 - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Debug|Win32.ActiveCfg = Debug|Win32 - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Debug|Win32.Build.0 = Debug|Win32 - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Release|Win32.ActiveCfg = Release|Win32 - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Release|Win32.Build.0 = Release|Win32 - {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Debug|Win32.ActiveCfg = Debug|Win32 - {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Debug|Win32.Build.0 = Debug|Win32 - {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Release|Win32.ActiveCfg = Release|Win32 - {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Release|Win32.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj deleted file mode 100644 index 6807066..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj +++ /dev/null @@ -1,131 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - {FF6D569D-DBD5-47C7-8149-71E401B0D2E4} - Win32Proj - FDVM - 10.0 - - - - Application - true - v142 - Unicode - false - false - false - No - - - Application - false - v141 - true - Unicode - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);$(IncludePath) - ..\Debug\ - *.cdf;*.cache;*.obj;*.ilk;*.resources;*.tlb;*.tli;*.tlh;*.tmp;*.rsp;*.pgc;*.pgd;*.meta;*.tlog;*.manifest;*.res;*.pch;*.exp;*.idb;*.rep;*.xdc;*.pdb;*_manifest.rc;*.bsc;*.sbr;*.xml;*.metagen;*.bi - - - false - ..\Release\ - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);$(IncludePath) - - - - - - Level4 - Disabled - WIN32;DEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - true - true - - - Console - true - true - - - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - true - - - Console - true - true - true - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters deleted file mode 100644 index 2c84816..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters +++ /dev/null @@ -1,96 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj deleted file mode 100644 index a470125..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj +++ /dev/null @@ -1,98 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - - - - - {0F9AF026-C750-4245-A5A5-6A58CF3F930A} - Win32Proj - NEWsrc - 10.0 - - - - StaticLibrary - true - v142 - Unicode - false - false - false - No - - - StaticLibrary - false - v141 - true - Unicode - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - false - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - - - - Level3 - Disabled - WIN32;_DEBUG;_LIB;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - true - - - Console - true - - - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - - - Console - true - true - true - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters deleted file mode 100644 index b6e769d..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters +++ /dev/null @@ -1,25 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Файлы исходного кода - - - Файлы исходного кода - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj deleted file mode 100644 index e8cb7a6..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj +++ /dev/null @@ -1,114 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - - - - - - - - - - - - - - - - - - - - - {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} - Win32Proj - OLDsrc - 10.0 - - - - StaticLibrary - true - v142 - Unicode - false - false - false - No - - - StaticLibrary - false - v141 - true - Unicode - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - false - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - - - - Level3 - Disabled - WIN32;_DEBUG;_LIB;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - true - - - Console - true - - - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - - - Console - true - true - true - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters deleted file mode 100644 index 957c584..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters +++ /dev/null @@ -1,73 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj deleted file mode 100644 index 88efe75..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj +++ /dev/null @@ -1,120 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - {23A23D24-2079-462A-A273-AB28271D68E6} - Win32Proj - Parser - 10.0 - - - - Application - true - v142 - Unicode - false - false - false - No - - - Application - false - v141 - true - Unicode - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - ..\Debug\ - - - false - ..\Release\ - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(ICIncludeDir);$(IncludePath);$(IncludePath) - - - - - - Level3 - Disabled - WIN32;_DEBUG;_CONSOLE;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - true - - - Console - true - true - - - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - - - Console - true - true - true - - - - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters deleted file mode 100644 index 81d5de6..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters +++ /dev/null @@ -1,72 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Заголовочные файлы - - - Заголовочные файлы - - - Заголовочные файлы - - - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj deleted file mode 100644 index 73893d0..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj +++ /dev/null @@ -1,97 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - - - - {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} - Win32Proj - SageLib - 10.0 - - - - StaticLibrary - true - v142 - Unicode - false - false - false - No - - - StaticLibrary - false - v141 - true - Unicode - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - false - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - - - - Level3 - Disabled - WIN32;_DEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - true - - - Console - true - - - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS - -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) - - - Console - true - true - true - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters deleted file mode 100644 index 8d88c25..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters +++ /dev/null @@ -1,22 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Файлы исходного кода - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj deleted file mode 100644 index 2e12180..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj +++ /dev/null @@ -1,104 +0,0 @@ - - - - - Debug - Win32 - - - Release - Win32 - - - - {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79} - Win32Proj - inlineExp - 10.0 - - - - Application - true - v142 - Unicode - false - false - false - No - - - Application - false - v141 - true - Unicode - false - false - false - No - - - - - - - - - - - - - true - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) - - - false - ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VC_IncludePath);$(WindowsSDK_IncludePath);;$(IncludePath) - - - - - - Level3 - Disabled - WIN32;_DEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS - true - - - Console - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS - true - - - Console - true - true - true - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters b/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters deleted file mode 100644 index c00843e..0000000 --- a/projects/dvm_svn/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters +++ /dev/null @@ -1,33 +0,0 @@ - - - - - {4FC737F1-C7A5-4376-A066-2A32D752A2FF} - cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx - - - {93995380-89BD-4b04-88EB-625FBE52EBFB} - h;hh;hpp;hxx;hm;inl;inc;xsd - - - {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} - rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms - - - - - Файлы исходного кода - - - Файлы исходного кода - - - Файлы исходного кода - - - - - - - - \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/acrossDebugging/across.cpp b/projects/dvm_svn/fdvm/trunk/acrossDebugging/across.cpp deleted file mode 100644 index ba2b6d7..0000000 --- a/projects/dvm_svn/fdvm/trunk/acrossDebugging/across.cpp +++ /dev/null @@ -1,494 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include - -using namespace std; - -struct dim3 -{ - dim3(int _x) { x = _x; y = z = 1; } - dim3(int _x, int _y) { x = _x; y = _y; z = 1; } - dim3(int _x, int _y, int _z) { x = _x; y = _y; z = _z; } - dim3() { x = y = z = 1; } - int x, y, z; -}; - -//ii j i -int lowI[3] = { 3, 6, 3 }; -int highI[3] = { 5, 3, 7 }; - -int idxI[3] = { 1, -1, 1 }; - -set> elems; - -static void kernel(int id_x, int id_y, - int base_i, int base_j, int base_ii, - int step_i, int step_j, int step_ii, - int max_z, int SE, int var1, int var2, int var3, - int Emax, int Emin, int min_ij, int swap_ij, - int type_of_run, int idxs_0, int idxs_1, int idxs_2) -{ - int coords[3]; - - // Local needs - int ii, j, i; - //id_x = x;// blockIdx.x* blockDim.x + threadIdx.x; - //id_y = y;// blockIdx.y* blockDim.y + threadIdx.y; - if (id_y < max_z) - { - if (id_y + SE < Emin) - i = id_y + SE; - else - { - if (id_y + SE < Emax) - i = min_ij; - else - i = 2 * min_ij - SE - id_y + Emax - Emin - 1; - } - - if (id_x < i) - { - if (var3 == 1 && Emin < id_y + SE) - { - base_i = base_i - step_i * (SE + id_y - Emin); - base_j = base_j + step_j * (SE + id_y - Emin); - } - - coords[idxs_0] = base_i + (id_y * (var1 + var3) - id_x) * step_i; - coords[idxs_1] = base_j + (id_y * var2 + id_x) * step_j; - coords[idxs_2] = base_ii - id_y * step_ii; - - if (swap_ij * var3) - coords[idxs_0] ^= coords[idxs_1] ^= coords[idxs_0] ^= coords[idxs_1]; - - i = coords[0]; - j = coords[1]; - ii = coords[2]; - - if ((i < lowI[2] || i > highI[2]) && idxI[2] > 0 || - (i > lowI[2] || i < highI[2]) && idxI[2] < 0) - { - printf("error on I\n"); - exit(-1); - } - if ((j < lowI[1] || j > highI[1]) && idxI[1] > 0 || - (j > lowI[1] || j < highI[1]) && idxI[1] < 0) - { - printf("error on J\n"); - exit(-1); - } - if ((ii < lowI[0] || ii > highI[0]) && idxI[0] > 0 || - (ii > lowI[0] || ii < highI[0]) && idxI[0] < 0) - { - printf("error on II\n"); - exit(-1); - } - // Loop body - /*printf("[%d %d %d] | %d %d %d %d %d %d | %d %d | %d %d %d | %d %d %d %d| %d %d %d %d|\n", i, j, ii, - base_i, base_j, base_ii, step_i, step_j, step_ii, - max_z, SE, var1, var2, var3, Emax, Emin, min_ij, swap_ij, - type_of_run, idxs_0, idxs_1, idxs_2);*/ - - array next = { i, j, ii }; - if (elems.find(next) != elems.end()) - { - printf("error on elems\n"); - exit(-1); - } - else - elems.insert(next); - } - } -} - -static void loop_kernel(const dim3& blocks, const dim3& threads, - int base_i, int base_j, int base_ii, - int step_i, int step_j, int step_ii, - int max_z, int SE, int var1, int var2, int var3, - int Emax, int Emin, int min_ij, int swap_ij, - int type_of_run, int idxs_0, int idxs_1, int idxs_2) -{ - for (int y = 0; y < blocks.y * threads.y; ++y) - for (int x = 0; x < blocks.x * threads.x; ++x) - kernel(x, y, base_i, base_j, base_ii, step_i, step_j, step_ii, - max_z, SE, var1, var2, var3, Emax, Emin, min_ij, swap_ij, - type_of_run, idxs_0, idxs_1, idxs_2); -} - -void testAcross_7case() -{ - dim3 blocks, threads; - int base_i, base_j, base_ii; - int var3 = 0; - int var2 = 0; - int var1 = 1; - int diag = 1; - int SE = 1; - int Emax, Emin, Allmin; - - int num_y; - int num_x; - - int idxs[5] = { 0, 1, 2 }; - - int lowI[3]; - int highI[3]; - int idxI[3]; - for (int k = 0; k < 3; ++k) - { - lowI[k] = ::lowI[k]; - highI[k] = ::highI[k]; - idxI[k] = ::idxI[k]; - } - - threads = dim3(8, 4, 1); - num_x = threads.x; - num_y = threads.y; - - const int Mi = (abs(lowI[2] - highI[2]) + 1) / abs(idxI[2]) + ((abs(lowI[2] - highI[2]) + 1) % abs(idxI[2]) != 0); - const int Mj = (abs(lowI[1] - highI[1]) + 1) / abs(idxI[1]) + ((abs(lowI[1] - highI[1]) + 1) % abs(idxI[1]) != 0); - const int Mk = (abs(lowI[0] - highI[0]) + 1) / abs(idxI[0]) + ((abs(lowI[0] - highI[0]) + 1) % abs(idxI[0]) != 0); - Allmin = std::min(std::min(Mi, Mj), Mk); - Emin = std::min(Mi, Mj); - Emax = std::min(Mi, Mj) + abs(Mi - Mj) + 1; - blocks = dim3(num_x, num_y); - - // Start method - base_i = lowI[2]; - base_j = lowI[1]; - base_ii = lowI[0]; - int type_of_run = 7; - while (diag <= Allmin) - { - blocks.x = diag / num_x + (diag % num_x != 0); - blocks.y = diag / num_y + (diag % num_y != 0); - loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, - std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); - - //printf("1===========\n"); - base_ii = base_ii + idxI[0]; - diag = diag + 1; - } - var1 = 0; - var2 = 0; - var3 = 1; - - if (Mk > Emin) - { - base_i = lowI[2] * (Mi <= Mj) + lowI[1] * (Mi > Mj); - base_j = lowI[1] * (Mi <= Mj) + lowI[2] * (Mi > Mj); - diag = Allmin + 1; - - while (diag - 1 != Mk) - { - blocks.x = Emin / num_x + (Emin % num_x != 0); - blocks.y = diag / num_y + (diag % num_y != 0); - if (Mi > Mj) - idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; - loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, - std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); - if (Mi > Mj) - idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; - //printf("2===========\n"); - base_ii = base_ii + idxI[0]; - diag = diag + 1; - } - } - diag = Mk; - blocks.y = diag / num_y + (diag % num_y != 0); - blocks.x = Emin / num_x + (Emin % num_x != 0); - SE = 2; - base_i = (lowI[2] + idxI[2]) * (Mi <= Mj) + (lowI[1] + idxI[1]) * (Mi > Mj); - base_j = lowI[1] * (Mi <= Mj) + lowI[2] * (Mi > Mj); - base_ii = lowI[0] + idxI[0] * (Mk - 1); - - while (Mi + Mj - Allmin != SE - 1) - { - if (Mi > Mj) - idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; - loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, - std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); - if (Mi > Mj) - idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; - - //printf("3===========\n"); - base_i = base_i + idxI[2] * (Mi <= Mj) + idxI[1] * (Mi > Mj); - SE = SE + 1; - } - - var1 = 0; - var2 = 1; - var3 = 0; - diag = Allmin - 1; - base_i = lowI[2] + idxI[2] * (Mi - 1); - base_j = lowI[1] * (Mi > Mj) + base_j * (Mi <= Mj); - if (Mi > Mj && Mk <= Emin) - { - base_j = base_j + idxI[1] + abs(Emin - Mk) * (idxI[1] > 0 ? 1 : -1); - } - else - { - if (Mi <= Mj && Mk <= Emin) - { - if (idxI[1] > 0) - { - base_j = base_j + idxI[1] + Emax - Emin - 1 + abs(Emin - Mk); - } - else - { - base_j = base_j + idxI[1] - Emax + Emin + 1 + Mk - Emin; - } - } - else - { - if (Mi > Mj && Mk > Emin) - { - base_j = base_j + idxI[1]; - } - else - { - if (Mi <= Mj && Mk > Emin) - { - if (idxI[1] > 0) - { - base_j = base_j + idxI[1] + Emax - Emin - 1; - } - else - { - base_j = base_j + idxI[1] - Emax + Emin + 1; - } - } - } - } - } - - while (diag != 0) - { - blocks.x = diag / num_x + (diag % num_x != 0); - blocks.y = diag / num_y + (diag % num_y != 0); - loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, - std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); - - //printf("4===========\n"); - SE = SE + 1; - base_j = base_j + idxI[1]; - diag = diag - 1; - } - - if ((int)elems.size() != (abs(highI[2] - lowI[2]) + 1) * (abs(highI[1] - lowI[1]) + 1) * (abs(highI[0] - lowI[0]) + 1)) - { - printf(" elems count = %d, total %d\n", (int)elems.size(), (abs(highI[2] - lowI[2]) + 1) * (abs(highI[1] - lowI[1]) + 1) * (abs(highI[0] - lowI[0]) + 1)); - exit(-2); - } -} - -int main() -{ - testAcross_7case(); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = 1; - lowI[1] = 1; - lowI[2] = 1; - - highI[0] = j + 1; - highI[1] = k + 1; - highI[2] = z + 1; - - idxI[0] = 1; - idxI[1] = 1; - idxI[2] = 1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done full +\n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = 1; - lowI[1] = 1; - lowI[2] = z + 1; - - highI[0] = j + 1; - highI[1] = k + 1; - highI[2] = 1; - - idxI[0] = 1; - idxI[1] = 1; - idxI[2] = -1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done - last\n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = 1; - lowI[1] = k + 1; - lowI[2] = 1; - - highI[0] = j + 1; - highI[1] = 1; - highI[2] = z + 1; - - idxI[0] = 1; - idxI[1] = -1; - idxI[2] = 1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done - mid\n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = j + 1; - lowI[1] = 1; - lowI[2] = 1; - - highI[0] = 1; - highI[1] = k + 1; - highI[2] = z + 1; - - idxI[0] = -1; - idxI[1] = 1; - idxI[2] = 1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done - first\n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = 1; - lowI[1] = k + 1; - lowI[2] = z + 1; - - highI[0] = j + 1; - highI[1] = 1; - highI[2] = 1; - - idxI[0] = 1; - idxI[1] = -1; - idxI[2] = -1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done - mid last\n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = j + 1; - lowI[1] = k + 1; - lowI[2] = 1; - - highI[0] = 1; - highI[1] = 1; - highI[2] = z + 1; - - idxI[0] = -1; - idxI[1] = -1; - idxI[2] = 1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done - first mid\n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = j + 1; - lowI[1] = 1; - lowI[2] = z + 1; - - highI[0] = 1; - highI[1] = k + 1; - highI[2] = 1; - - idxI[0] = -1; - idxI[1] = 1; - idxI[2] = -1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done - first last \n"); - - for (int z = 1; z < 10; ++z) - { - for (int k = 1; k < 10; ++k) - { - for (int j = 1; j < 10; ++j) - { - lowI[0] = j + 1; - lowI[1] = k + 1; - lowI[2] = z + 1; - - highI[0] = 1; - highI[1] = 1; - highI[2] = 1; - - idxI[0] = -1; - idxI[1] = -1; - idxI[2] = -1; - - elems.clear(); - testAcross_7case(); - } - } - } - printf("done full -\n"); - return 0; -} diff --git a/projects/dvm_svn/fdvm/trunk/examples/gausf.fdv b/projects/dvm_svn/fdvm/trunk/examples/gausf.fdv deleted file mode 100644 index 6d1e752..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/gausf.fdv +++ /dev/null @@ -1,60 +0,0 @@ - PROGRAM GAUSF - PARAMETER ( N = 10 ) - REAL A( N, N+1 ),X( N ) -C section A(1:N,1:N) - matrix of coefficients "A" -C section A(1:N,N+1) - vector of free members "b" -CDVM$ DISTRIBUTE A ( BLOCK, *) -CDVM$ ALIGN X(I) WITH A(I,N+1) - PRINT *, '********** TEST_GAUSS **********' -CDVM$ PARALLEL (I) ON A(I,*) - DO 100 I=1,N - DO 100 J=1,N+1 - IF (I .EQ. J) THEN - A(I,J)=2.0 - ELSE - IF (J .EQ. N+1) THEN - A(I,J)=1.0 - ELSE - A(I,J)=0.0 - ENDIF - ENDIF - 100 CONTINUE -C -C ELIMINATION -C - DO 1 I = 1, N-1 - -C the i-th row of array A will be buffered before -C execution of i-th iteration, and reference A(I,K) -C will be replaced with corresponding reference to buffer -CDVM$ PARALLEL ( J ) ON A( J, * ), REMOTE_ACCESS (A( I, :)) - DO 5 J = I+1, N - DO 5 K = I+1, N+1 - A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) - 5 CONTINUE - 1 CONTINUE - X( N ) = A( N, N+1 ) / A( N, N ) -C BACK SUBSTITUTION -C - DO 6 J = N-1, 1, -1 -C the (j+1)-th elements of array X will be buffered before -C execution of j-th iteration, and reference X(J+1) -C will be replaced with reference to temporal variable -CDVM$ PARALLEL ( I ) ON A( I , * ), REMOTE_ACCESS ( X( J+1 )) - DO 7 I = 1, J - A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) - 7 CONTINUE - X( J ) = A( J, N+1 ) / A( J, J) - 6 CONTINUE - PRINT *, X - END - - - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/examples/gausgb.fdv b/projects/dvm_svn/fdvm/trunk/examples/gausgb.fdv deleted file mode 100644 index 3482718..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/gausgb.fdv +++ /dev/null @@ -1,57 +0,0 @@ - PROGRAM GAUSGB - PARAMETER ( N = 10 ,N1 = N-3) - REAL A( N, N+1 ),X( N ) - INTEGER GB(2) -C section A(1:N,1:N) - matrix of coefficients "A" -C section A(1:N,N+1) - vector of free members "b" -CDVM$ DISTRIBUTE A ( GEN_BLOCK(GB), *) -CDVM$ ALIGN X(I) WITH A(I,N+1) - DATA GB(1)/3/, GB(2)/N1/ - PRINT *, '********** TEST_GAUSGB **********' -CDVM$ PARALLEL (I) ON A(I,*) - DO 100 I=1,N - DO 100 J=1,N+1 - IF (I .EQ. J) THEN - A(I,J)=2.0 - ELSE - IF (J .EQ. N+1) THEN - A(I,J)=1.0 - ELSE - A(I,J)=0.0 - ENDIF - ENDIF - 100 CONTINUE -C -C ELIMINATION -C - DO 1 I = 1, N - -C the i-th row of array A will be buffered before -C execution of i-th iteration, and reference A(I,K) -C will be replaced with corresponding reference to buffer -CDVM$ PARALLEL ( J ) ON A( J, * ), REMOTE_ACCESS (A( I, :)) - DO 5 J = I+1, N - DO 5 K = I+1, N+1 - A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) - 5 CONTINUE - 1 CONTINUE - X( N ) = A( N, N+1 ) / A( N, N ) -C BACK SUBSTITUTION -C - DO 6 J = N-1, 1, -1 -C the (j+1)-th elements of array X will be buffered before -C execution of j-th iteration, and reference X(J+1) -C will be replaced with reference to temporal variable -CDVM$ PARALLEL ( I ) ON A( I , * ), REMOTE_ACCESS ( X( J+1 )) - DO 7 I = 1, J - A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) - 7 CONTINUE - X( J ) = A( J, N+1 ) / A( J, J) - 6 CONTINUE - PRINT *, X - END - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/examples/gaush.hpf b/projects/dvm_svn/fdvm/trunk/examples/gaush.hpf deleted file mode 100644 index 0a337cb..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/gaush.hpf +++ /dev/null @@ -1,45 +0,0 @@ - PROGRAM GAUSH - PARAMETER ( N = 10 ) - REAL A( N, N+1 ),X( N ) -C section A(1:N,1:N) - matrix of coefficients "A" -C section A(1:N,N+1) - vector of free members "b" -CHPF$ DISTRIBUTE A ( BLOCK, *) -CHPF$ ALIGN X(I) WITH A(I,N+1) - PRINT *, '********** TEST_GAUSSHPF *********' -CHPF$ INDEPENDENT - DO 100 I=1,N - DO 100 J=1,N+1 - IF (I .EQ. J) THEN - A(I,J)=2.0 - ELSE - IF (J .EQ. N+1) THEN - A(I,J)=1.0 - ELSE - A(I,J)=0.0 - ENDIF - ENDIF - 100 CONTINUE -C -C ELIMINATION -C - DO 1 I = 1, N-1 - -CHPF$ INDEPENDENT - DO 5 J = I+1, N - DO 5 K = I+1, N+1 - A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) - 5 CONTINUE - 1 CONTINUE - X( N ) = A( N, N+1 ) / A( N, N ) -C BACK SUBSTITUTION -C - DO 6 J = N-1, 1, -1 -CHPF$ INDEPENDENT - DO 7 I = 1, J - A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) - 7 CONTINUE - X( J ) = A( J, N+1 ) / A( J, J) - 6 CONTINUE - PRINT *, X - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/gauswh.fdv b/projects/dvm_svn/fdvm/trunk/examples/gauswh.fdv deleted file mode 100644 index 94fcafd..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/gauswh.fdv +++ /dev/null @@ -1,53 +0,0 @@ - PROGRAM GAUSWH - PARAMETER ( N = 10 ) - REAL A( N, N+1 ),X( N ) - DOUBLE PRECISION WB(10) -C section A(1:N,1:N) - matrix of coefficients "A" -C section A(1:N,N+1) - vector of free members "b" -CDVM$ DISTRIBUTE A ( WGT_BLOCK(WB,10), *) -CDVM$ ALIGN X(I) WITH A(I,N+1) - DATA WB/10.,9.,8.,7.,6.,5.,4.,3.,2.,1./ - -CDVM$ PARALLEL (I) ON A(I,*) - DO 100 I=1,N - DO 100 J=1,N+1 - IF (I .EQ. J) THEN - A(I,J)=2.0 - ELSE - IF (J .EQ. N+1) THEN - A(I,J)=1.0 - ELSE - A(I,J)=0.0 - ENDIF - ENDIF - 100 CONTINUE -C -C ELIMINATION -C - DO 1 I = 1, N-1 - -C the i-th row of array A will be buffered before -C execution of i-th iteration, and reference A(I,K) -C will be replaced with corresponding reference to buffer -CDVM$ PARALLEL ( J ) ON A( J, * ), REMOTE_ACCESS (A( I, :)) - DO 5 J = I+1, N - DO 5 K = I+1, N+1 - A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) - 5 CONTINUE - 1 CONTINUE - X( N ) = A( N, N+1 ) / A( N, N ) -C BACK SUBSTITUTION -C - DO 6 J = N-1, 1, -1 -C the (j+1)-th elements of array X will be buffered before -C execution of j-th iteration, and reference X(J+1) -C will be replaced with reference to temporal variable -CDVM$ PARALLEL ( I ) ON A( I , * ), REMOTE_ACCESS ( X( J+1 )) - DO 7 I = 1, J - A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) - 7 CONTINUE - X( J ) = A( J, N+1 ) / A( J, J) - 6 CONTINUE - PRINT *, X - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/jac.fdv b/projects/dvm_svn/fdvm/trunk/examples/jac.fdv deleted file mode 100644 index e82ece9..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/jac.fdv +++ /dev/null @@ -1,47 +0,0 @@ - PROGRAM JAC - PARAMETER (L=8, ITMAX=20) - REAL A(L,L), EPS, MAXEPS, B(L,L) -CDVM$ DISTRIBUTE ( BLOCK, BLOCK) :: A -CDVM$ ALIGN B(I,J) WITH A(I,J) -C arrays A and B with block distribution - - PRINT *, '********** TEST_JACOBI **********' - MAXEPS = 0.5E - 7 -CDVM$ PARALLEL (J,I) ON A(I, J) -C nest of two parallel loops, iteration (i,j) will be executed on -C processor, which is owner of element A(i,j) - DO 1 J = 1, L - DO 1 I = 1, L - A(I, J) = 0. - IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN - B(I, J) = 0. - ELSE - B(I, J) = ( 1. + I + J ) - ENDIF - 1 CONTINUE - DO 2 IT = 1, ITMAX - EPS = 0. -CDVM$ PARALLEL (J, I) ON A(I, J), REDUCTION ( MAX( EPS )) -C variable EPS is used for calculation of maximum value - DO 21 J = 2, L-1 - DO 21 I = 2, L-1 - EPS = MAX ( EPS, ABS( B( I, J) - A( I, J))) - A(I, J) = B(I, J) - 21 CONTINUE -CDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A) -C Copying shadow elements of array A from -C neighbouring processors before loop execution - DO 22 J = 2, L-1 - DO 22 I = 2, L-1 - B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ - * A( I, J+1 )) / 4 - 22 CONTINUE - PRINT 200, IT, EPS -200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) - IF ( EPS . LT . MAXEPS ) GO TO 3 - 2 CONTINUE - 3 OPEN (3, FILE='JAC.DAT', FORM='FORMATTED', STATUS='UNKNOWN') - WRITE (3,*) B - CLOSE (3) - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/jacas.fdv b/projects/dvm_svn/fdvm/trunk/examples/jacas.fdv deleted file mode 100644 index c3dd6bb..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/jacas.fdv +++ /dev/null @@ -1,62 +0,0 @@ - PROGRAM JACAS - PARAMETER (K=8, ITMAX=20) - REAL A(K,K), EPS, MAXEPS, B(K,K) -CDVM$ DISTRIBUTE ( BLOCK, BLOCK) :: A -CDVM$ ALIGN B(I,J) WITH A(I,J) -CDVM$ REDUCTION_GROUP REPS -C arrays A and B with block distribution - - PRINT *, '********** TEST_JACOBI_AS **********' -CDVM$ SHADOW_GROUP SA ( A ) -C creation of descriptor for operations with imported/exported -C elements of array A - MAXEPS = 0.5E - 7 -CDVM$ PARALLEL ( J, I) ON A( I, J) -C nest of parallel loops for initialization of arrays - DO 1 J = 1, K - DO 1 I = 1, K - A( I, J) = 0. - IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.K .OR. J.EQ.K) THEN - B(I, J) = 0. - ELSE - B(I, J) = ( 1. + I + J ) - ENDIF - 1 CONTINUE - DO 2 IT = 1, ITMAX - EPS = 0. -C descriptor of reduction operations is created -C and initial values of reduction variables are stored -CDVM$ PARALLEL ( J, I) ON A( I, J) , SHADOW_START SA, -CDVM$* REDUCTION(REPS:MAX(EPS)) -C the loops iteration order is changed: at first -C exported (boundary) elements of A are calculated and sent -C then internal elements of array A are calculated - DO 21 J = 2, K-1 - DO 21 I = 2, K-1 - EPS = MAX ( EPS, ABS( B( I, J) - A( I, J))) - A( I, J) = B( I, J) - 21 CONTINUE -CDVM$ REDUCTION_START REPS -C start of reduction operation to accumulate the partial results -C calculated in copies of variable EPS on every processor -CDVM$ PARALLEL ( J, I) ON B( I, J) , SHADOW_WAIT SA -C the loops iteration order is changed: at first -C internal elements of B are calculated, then imported elements -C of array A from neighboring processors are received, -C then boundary elements of array B are calculated - DO 22 J = 2, K-1 - DO 22 I = 2, K-1 - B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J ) + - * A( I, J+1 ))/4 - 22 CONTINUE -CDVM$ REDUCTION_WAIT REPS -C awaiting completion of reduction operation - PRINT 200, IT, EPS -200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) - IF ( EPS .LT. MAXEPS ) GO TO 3 - 2 CONTINUE - 3 OPEN (3, FILE='JACAS.DAT', FORM='FORMATTED',STATUS='UNKNOWN') - WRITE (3,*) B - CLOSE (3) - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/jach.hpf b/projects/dvm_svn/fdvm/trunk/examples/jach.hpf deleted file mode 100644 index 5a1974d..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/jach.hpf +++ /dev/null @@ -1,44 +0,0 @@ - PROGRAM JACH - PARAMETER (L=8, ITMAX=20) - REAL A(L,L), B(L,L) -CHPF$ DISTRIBUTE ( BLOCK, BLOCK) :: A -CHPF$ ALIGN B(I,J) WITH A(I,J) -C arrays A and B with block distribution - - PRINT *, '********** TEST_JACH **********' -C nest of two INDEPENDENT loops, iteration (i,j) will be executed on -C processor, which is owner of element A(i,j) -CHPF$ INDEPENDENT - DO 1 J = 1, L -CHPF$ INDEPENDENT - DO 1 I = 1, L - A(I, J) = 0. - IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN - B(I, J) = 0. - ELSE - B(I, J) = ( 1. + I + J ) - ENDIF - 1 CONTINUE - DO 2 IT = 1, ITMAX -CHPF$ INDEPENDENT - DO 21 J = 2, L-1 -CHPF$ INDEPENDENT - DO 21 I = 2, L-1 - A(I, J) = B(I, J) - 21 CONTINUE - -CHPF$ INDEPENDENT - DO 22 J = 2, L-1 -CHPF$ INDEPENDENT - DO 22 I = 2, L-1 - B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ - * A( I, J+1 )) / 4 - 22 CONTINUE - PRINT 300, IT - 300 FORMAT(' IT = ',I4) - 2 CONTINUE - 3 OPEN (3, FILE='JACH.DAT', FORM='FORMATTED', STATUS='UNKNOWN') - WRITE (3,*) B - CLOSE (3) - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/redbf.fdv b/projects/dvm_svn/fdvm/trunk/examples/redbf.fdv deleted file mode 100644 index 3db55db..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/redbf.fdv +++ /dev/null @@ -1,46 +0,0 @@ - PROGRAM REDBF - PARAMETER (N=10) - REAL A(N,N), EPS, MAXEXP, W - INTEGER ITMAX -CDVM$ DISTRIBUTE A(BLOCK, BLOCK) - PRINT *, '********** TEST_REDBLACK **********' - ITMAX = 20 - MAXEXP = 0.5E - 5 - W = 0.5 -CDVM$ PARALLEL (J,I) ON A(I, J) - DO 1 J = 1,N - DO 1 I = 1,N - IF (I.EQ.J) THEN - A(I,J) = N+2 - ELSE - A(I,J) = -1. - ENDIF -1 CONTINUE - DO 2 IT = 1, ITMAX - EPS = 0. -C loop for red and black variables - DO 3 IRB = 0,1 -CDVM$ PARALLEL (J,I) ON A(I, J), NEW (S), REDUCTION (MAX(EPS)), -CDVM$* SHADOW_RENEW (A) -C variable S - private variable in loop iterations -C variable EPS is used for calculation of maximum value - -C Exception : iteration space is not rectangular - - DO 21 J = 2,N-1 - DO 21 I = 2 + MOD(J+IRB,2), N-1, 2 - S = A(I,J) - A(I,J) = (W/4) * (A(I-1,J) + A(I+1,J) + A(I,J-1) + - * A(I,J+1)) + (1-W) * A(I,J) - EPS = MAX (EPS, ABS(S - A(I,J))) -21 CONTINUE -3 CONTINUE - PRINT 200, IT, EPS -200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) - IF (EPS.LT.MAXEXP) GO TO 4 -2 CONTINUE -4 OPEN (3, FILE='REDBF.DAT', FORM='FORMATTED',STATUS='UNKNOWN') - WRITE (3,*) A - CLOSE (3) - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/redbh.hpf b/projects/dvm_svn/fdvm/trunk/examples/redbh.hpf deleted file mode 100644 index 658fddb..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/redbh.hpf +++ /dev/null @@ -1,53 +0,0 @@ - PROGRAM REDBH - PARAMETER (N1 = 20,N2 = 10) - REAL A(N1,N2),W - INTEGER ITMAX -!HPF$ DISTRIBUTE (BLOCK,BLOCK) :: A - ITMAX = 20 - W = 0.5 -!HPF$ INDEPENDENT - DO 1 J = 1,N2 -!HPF$ INDEPENDENT - DO 1 I = 1,N1 - IF (I.EQ.J) THEN - A(I,J) = N1+2 - ELSE - A(I,J) = (-(1.)) - ENDIF -1 CONTINUE - DO 2 IT = 1,ITMAX -!HPF$ INDEPENDENT - DO 21 J = 1,N2/2-1 -!HPF$ INDEPENDENT - DO 21 I = 1,N1/2-1 - A(2*I+1,2*J+1) = W/4*(A(2*I,2*J+1)+A(2*I+2,2*J+1)+ - + A(2*I+1,2*J)+A(2*I+1,2*J+2))+(1-W)*A(2*I+1,2*J+1) -21 CONTINUE -!HPF$ INDEPENDENT - DO 22 J = 1, N2/2-1 -!HPF$ INDEPENDENT - DO 22 I = 1,N1/2-1 - A(2*I,2*J) = W/4*(A(2*I-1,2*J)+A(2*I+1,2*J)+A(2*I,2*J-1)+ - + A(2*I,2*J+1))+(1-W)*A(2*I,2*J) -22 CONTINUE -!HPF$ INDEPENDENT - DO 23 J = 1,N2/2-1 -!HPF$ INDEPENDENT - DO 23 I = 1,N1/2-1 - A(2*I,2*J+1) = W/4*(A(2*I-1,2*J+1)+A(2*I+1,2*J+1)+ - + A(2*I,2*J)+A(2*I,2*J+2))+(1-W)*A(2*I,2*J+1) -23 CONTINUE -!HPF$ INDEPENDENT - DO 24 J = 1,N2/2-1 -!HPF$ INDEPENDENT - DO 24 I = 1,N1/2-1 - A(2*I+1,2*J) = W/4*(A(2*I,2*J)+A(2*I+2,2*J)+A(2*I+1,2*J-1)+ - + A(2*I+1,2*J+1))+(1-W)*A(2*I+1,2*J) -24 CONTINUE - PRINT *,'IT= ',IT -2 CONTINUE - OPEN (3, FILE='REDBH.DAT', FORM='FORMATTED',STATUS='UNKNOWN') - WRITE (3,*) A - CLOSE (3) - END - diff --git a/projects/dvm_svn/fdvm/trunk/examples/sor.fdv b/projects/dvm_svn/fdvm/trunk/examples/sor.fdv deleted file mode 100644 index e48588b..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/sor.fdv +++ /dev/null @@ -1,38 +0,0 @@ - PROGRAM SOR - PARAMETER ( N = 10 ) - REAL A( N, N ), EPS, MAXEPS, W - INTEGER ITMAX -*DVM$ DISTRIBUTE A ( BLOCK, BLOCK ) - PRINT *, '********** TEST_SOR **********' - ITMAX=20 - MAXEPS = 0.5E - 5 - W = 0.5 -*DVM$ PARALLEL ( J, I ) ON A( I, J ) - DO 1 J = 1, N - DO 1 I = 1, N - IF ( I .EQ.J) THEN - A( I, J ) = N + 2 - ELSE - A( I, J ) = -1.0 - ENDIF -1 CONTINUE - DO 2 IT = 1, ITMAX - EPS = 0. -*DVM$ PARALLEL ( J, I) ON A( I, J), NEW (S), -*DVM$* REDUCTION ( MAX( EPS )), ACROSS (A(1:1,1:1)) - - DO 21 J = 2, N-1 - DO 21 I = 2, N-1 - S = A( I, J ) - A( I, J ) = (W / 4) * (A( I-1, J ) + A( I+1, J ) + A( I, J-1 ) + - * A( I, J+1 )) + ( 1-W ) * A( I, J) - EPS = MAX ( EPS, ABS( S - A( I, J ))) -21 CONTINUE - PRINT 200, IT, EPS -200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) - IF (EPS .LT. MAXEPS ) GO TO 4 -2 CONTINUE -4 OPEN (3, FILE='SOR.DAT', FORM='FORMATTED',STATUS='UNKNOWN') - WRITE (3,*) A - CLOSE (3) - END diff --git a/projects/dvm_svn/fdvm/trunk/examples/task2j.fdv b/projects/dvm_svn/fdvm/trunk/examples/task2j.fdv deleted file mode 100644 index 63ce6b5..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/task2j.fdv +++ /dev/null @@ -1,130 +0,0 @@ - PROGRAM TASK2J - PARAMETER (L=8, ITMAX=20) - REAL A(L,L), EPS,EPS1, MAXEPS, B(L,L),A1(L,L),B1(L,L) - INTEGER LP(2),HP(2) -CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS()) -CDVM$ TASK MB( 2 ) -CDVM$ ALIGN B1( I, J ) WITH A1( I, J ) -CDVM$ ALIGN B ( I, J ) WITH A ( I, J ) -CDVM$ DISTRIBUTE :: A, A1 - PRINT *, '********** TEST_TASK2J ***********' - CALL DPT(LP,HP,2) -CDVM$ MAP MB( 1 ) ONTO P( LP( 1) : HP(1)) -CDVM$ REDISTRIBUTE A ( *, BLOCK ) ONTO MB( 1 ) -CDVM$ MAP MB( 2 ) ONTO P( LP(2) : HP(2) ) -CDVM$ REDISTRIBUTE A1( *, BLOCK ) ONTO MB( 2 ) - MAXEPS = 0.5E - 7 -CDVM$ TASK_REGION MB -CDVM$ ON MB( 1 ) -CDVM$ PARALLEL (J,I) ON A(I, J) -C nest of two parallel loops, iteration (i,j) will be executed on -C processor, which is owner of element A(i,j) - DO 1 J = 1, L - DO 1 I = 1, L - A(I, J) = 0. - IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN - B(I, J) = 0. - ELSE - B(I, J) = ( 1. + I + J ) - ENDIF - 1 CONTINUE - DO 2 IT = 1, ITMAX - EPS = 0. -CDVM$ PARALLEL (J, I) ON A(I, J), REDUCTION ( MAX( EPS )) -C variable EPS is used for calculation of maximum value - DO 21 J = 2, L-1 - DO 21 I = 2, L-1 - EPS = MAX ( EPS, ABS( B( I, J) - A( I, J))) - A(I, J) = B(I, J) - 21 CONTINUE -CDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A) -C Copying shadow elements of array A from -C neighbouring processors before loop execution - DO 22 J = 2, L-1 - DO 22 I = 2, L-1 - B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ - * A( I, J+1 )) / 4 - 22 CONTINUE - IF ( EPS . LT . MAXEPS ) GO TO 3 - 2 CONTINUE - 3 OPEN (1, FILE='JACOBI1.DAT',FORM='FORMATTED',STATUS='UNKNOWN') - WRITE (1,200) IT, EPS -200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) - CLOSE (1) -CDVM$ END ON -CDVM$ ON MB( 2 ) -CDVM$ PARALLEL (J,I) ON A1(I, J) -C nest of two parallel loops, iteration (i,j) will be executed on -C processor, which is owner of element A1(i,j) - DO 19 J = 1, L - DO 19 I = 1, L - A1(I, J) = 0. - IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN - B1(I, J) = 0. - ELSE - B1(I, J) = ( 1. + I + J ) - ENDIF - 19 CONTINUE - DO 29 IT = 1, ITMAX - EPS1 = 0. -CDVM$ PARALLEL (J, I) ON A1(I, J), REDUCTION ( MAX( EPS1 )) -C variable EPS1 is used for calculation of maximum value - DO 219 J = 2, L-1 - DO 219 I = 2, L-1 - EPS1 = MAX ( EPS1, ABS( B1( I, J) - A1( I, J))) - A1(I, J) = B1(I, J) - 219 CONTINUE -CDVM$ PARALLEL (J, I) ON B1(I, J), SHADOW_RENEW (A1) -C Copying shadow elements of array A1 from -C neighbouring processors before loop execution - DO 229 J = 2, L-1 - DO 229 I = 2, L-1 - B1(I, J) = (A1( I-1, J ) + A1( I, J-1 ) + A1(I+1, J)+ - * A1( I, J+1 )) / 4 - 229 CONTINUE - IF ( EPS1 . LT . MAXEPS ) GO TO 39 - 29 CONTINUE - 39 OPEN (2, FILE='JACOBI2.DAT',FORM='FORMATTED',STATUS='UNKNOWN') - WRITE (2,200) IT, EPS1 - CLOSE (2) -CDVM$ END ON -CDVM$ END TASK_REGION - PRINT *, ' B' - PRINT *, B - PRINT *, ' ' - PRINT *, ' B1' - PRINT *, B1 - END - - SUBROUTINE DPT(LP,HP,NT) -C distributing processors for NT tasks (NT = 2) - INTEGER LP(2), HP(2) - NUMBER_OF_PROCESSORS() = 1 -CDVM$ DEBUG 1 (D = 0) - NP = NUMBER_OF_PROCESSORS() - NTP = NP/NT - IF(NP.EQ.1) THEN - LP(1) = 1 - HP(1) = 1 - LP(2) = 1 - HP(2) = 1 - ELSE - LP(1) = 1 - HP(1) = NTP - LP(2) = NTP+1 - HP(2) = NP - END IF -CDVM$ ENDDEBUG 1 - END - - - - - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/examples/tasks.fdv b/projects/dvm_svn/fdvm/trunk/examples/tasks.fdv deleted file mode 100644 index dbfe9eb..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/tasks.fdv +++ /dev/null @@ -1,126 +0,0 @@ - PROGRAM TASKS -C rectangular grid is distributed on two blocks -C -C - PARAMETER (K=8, N1 = 4, ITMAX=20, N2 = K - N1 ) -CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( )) - REAL A1(N1+1,K), A2(N2+1,K), B1(N1+1,K), B2(N2+1,K) - INTEGER LP(2),HP(2) -CDVM$ TASK MB( 2 ) -CDVM$ ALIGN B1( I, J ) WITH A1( I, J ) -CDVM$ ALIGN B2( I, J ) WITH A2( I, J ) -CDVM$ DISTRIBUTE :: A1, A2 -CDVM$ REMOTE_GROUP BOUND - PRINT *, '********** TEST_TASKS **********' - CALL DPT(LP,HP,2) -CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1)) -CDVM$ REDISTRIBUTE A1( *, BLOCK ) ONTO MB( 1 ) -CDVM$ MAP MB( 2 ) ONTO P( LP(2) : HP(2)) -CDVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 ) -C Initialization -CDVM$ PARALLEL ( J, I ) ON A1(I, J) - DO 10 J = 1, K - DO 10 I = 1, N1 - IF(I.EQ.1 .OR. J.EQ.1 .OR. J.EQ.K) THEN - A1(I, J) = 0. - B1(I, J) = 0. - ELSE - B1(I, J) = 1. + I + J - A1(I, J) = B1(I, J) - ENDIF -10 CONTINUE -CDVM$ PARALLEL ( J, I ) ON A2(I, J) - DO 20 J = 1, K - DO 20 I = 2, N2+1 - IF(I.EQ.N2+1 .OR. J.EQ.1 .OR. J.EQ.K) THEN - A2(I, J) = 0. - B2(I, J) = 0. - ELSE - B2(I, J) = 1. + (I+N1-1) + J - A2(I, J) = B2(I, J) - ENDIF -20 CONTINUE - DO 2 IT = 1, ITMAX -CDVM$ PREFETCH BOUND -C exchange bounds -CDVM$ PARALLEL ( J ) ON A1(N1+1, J), -CDVM$* REMOTE_ACCESS (BOUND : B2( 2, J ) ) - DO 30 J = 1, K -30 A1(N1+1, J) = B2(2, J) -CDVM$ PARALLEL ( J ) ON A2( 1, J), -CDVM$* REMOTE_ACCESS (BOUND : B1( N1, J ) ) - DO 40 J = 1, K -40 A2(1, J) = B1(N1, J) -CDVM$ TASK_REGION MB -CDVM$ ON MB( 1 ) -CDVM$ PARALLEL ( J, I ) ON B1(I, J), -CDVM$* SHADOW_RENEW ( A1 ) - DO 50 J = 2, K-1 - DO 50 I = 2, N1 -50 B1(I, J)=(A1(I-1, J) + A1(I,J-1) + A1(I+1,J) + A1(I,J+1))/4 -CDVM$ PARALLEL ( J, I ) ON A1(I, J) - DO 60 J = 2, K-1 - DO 60 I = 2, N1 -60 A1(I, J) = B1( I, J ) -CDVM$ END ON -CDVM$ ON MB( 2 ) -CDVM$ PARALLEL ( J, I ) ON B2(I, J), -CDVM$* SHADOW_RENEW ( A2 ) - DO 70 J = 2, K-1 - DO 70 I = 2, N2 -70 B2(I,J) = (A2(I-1,J) + A2(I,J-1) + A2(I+1,J) + A2(I,J+1))/4 -CDVM$ PARALLEL ( J, I ) ON A2(I, J) - DO 80 J = 2, K-1 - DO 80 I = 2, N2 -80 A2(I, J) = B2( I, J ) -CDVM$ END ON -CDVM$ END TASK_REGION -2 CONTINUE - PRINT *, 'A1' - PRINT *, A1 - PRINT *, ' ' - PRINT *, 'A2' - PRINT *, A2 - END - - SUBROUTINE DPT(LP,HP,NT) -C distributing processors for NT tasks (NT = 2) - INTEGER LP(2), HP(2) - NUMBER_OF_PROCESSORS() = 1 -CDVM$ DEBUG 1 (D = 0) - NP = NUMBER_OF_PROCESSORS() - NTP = NP/NT - IF(NP.EQ.1) THEN - LP(1) = 1 - HP(1) = 1 - LP(2) = 1 - HP(2) = 1 - ELSE - LP(1) = 1 - HP(1) = NTP - LP(2) = NTP+1 - HP(2) = NP - END IF -CDVM$ ENDDEBUG 1 - END - - - - - - - - - - - - - - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/examples/taskst.fdv b/projects/dvm_svn/fdvm/trunk/examples/taskst.fdv deleted file mode 100644 index 13adf47..0000000 --- a/projects/dvm_svn/fdvm/trunk/examples/taskst.fdv +++ /dev/null @@ -1,169 +0,0 @@ - PROGRAM TASKST -C rectangular grid is distributed on two blocks -C -C - PARAMETER (K=8, N1 = 4, ITMAX=20, N2 = K - N1 ) -CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( )) - REAL A1(N1+1,K), A2(N2+1,K), B1(N1+1,K), B2(N2+1,K) - REAL A(K,K), B(K,K) - INTEGER LP(2),HP(2) -CDVM$ TASK MB( 2 ) -CDVM$ DISTRIBUTE A(*,BLOCK) ONTO P -CDVM$ ALIGN B( I, J ) WITH A( I, J ) -CDVM$ ALIGN B1( I, J ) WITH A1( I, J ) -CDVM$ ALIGN B2( I, J ) WITH A2( I, J ) -CDVM$ DISTRIBUTE :: A1, A2 -CDVM$ REMOTE_GROUP BOUND - PRINT *, '********** TEST_TASKS_T **********' - CALL DPT(LP,HP,2) -CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) ) -CDVM$ REDISTRIBUTE A1( *, BLOCK ) ONTO MB( 1 ) -CDVM$ MAP MB( 2 ) ONTO P( LP(2) : HP(2) ) -CDVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 ) -C Initialization -CDVM$ PARALLEL ( J, I ) ON A1(I, J) - DO 10 J = 1, K - DO 10 I = 1, N1 - IF(I.EQ.1 .OR. J.EQ.1 .OR. J.EQ.K) THEN - A1(I, J) = 0. - B1(I, J) = 0. - ELSE - B1(I, J) = 1. + I + J - A1(I, J) = B1(I, J) - ENDIF -10 CONTINUE -CDVM$ PARALLEL ( J, I ) ON A2(I, J) - DO 20 J = 1, K - DO 20 I = 2, N2+1 - IF(I.EQ.N2+1 .OR. J.EQ.1 .OR. J.EQ.K) THEN - A2(I, J) = 0. - B2(I, J) = 0. - ELSE - B2(I, J) = 1. + (I+N1-1) + J - A2(I, J) = B2(I, J) - ENDIF -20 CONTINUE - - DO 2 IT = 1, ITMAX -CDVM$ PREFETCH BOUND -C exchange bounds -CDVM$ PARALLEL ( J ) ON A1(N1+1, J), -CDVM$* REMOTE_ACCESS (BOUND : B2( 2, J ) ) - DO 30 J = 1, K -30 A1(N1+1, J) = B2(2, J) -CDVM$ PARALLEL ( J ) ON A2( 1, J), -CDVM$* REMOTE_ACCESS (BOUND : B1( N1, J ) ) - DO 40 J = 1, K -40 A2(1, J) = B1(N1, J) -CDVM$ TASK_REGION MB -CDVM$ ON MB( 1 ) -CDVM$ PARALLEL ( J, I ) ON B1(I, J), -CDVM$* SHADOW_RENEW ( A1 ) - DO 50 J = 2, K-1 - DO 50 I = 2, N1 -50 B1(I, J)=(A1(I-1, J) + A1(I,J-1) + A1(I+1,J) + A1(I,J+1))/4 -CDVM$ PARALLEL ( J, I ) ON A1(I, J) - DO 60 J = 2, K-1 - DO 60 I = 2, N1 -60 A1(I, J) = B1( I, J ) -CDVM$ END ON -CDVM$ ON MB( 2 ) -CDVM$ PARALLEL ( J, I ) ON B2(I, J), -CDVM$* SHADOW_RENEW ( A2 ) - DO 70 J = 2, K-1 - DO 70 I = 2, N2 -70 B2(I,J) = (A2(I-1,J) + A2(I,J-1) + A2(I+1,J) + A2(I,J+1))/4 -CDVM$ PARALLEL ( J, I ) ON A2(I, J) - DO 80 J = 2, K-1 - DO 80 I = 2, N2 -80 A2(I, J) = B2( I, J ) -CDVM$ END ON -CDVM$ END TASK_REGION -2 CONTINUE - -C 1-task JACOBI -CDVM$ PARALLEL (J,I) ON A(I, J) -C nest of two parallel loops, iteration (i,j) will be executed on -C processor, which is owner of element A(i,j) - DO 1 J = 1, K - DO 1 I = 1, K - A(I, J) = 0. - IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.K .OR. J.EQ.K) THEN - B(I, J) = 0. - ELSE - B(I, J) = ( 1. + I + J ) - ENDIF - 1 CONTINUE - DO 3 IT = 1, ITMAX -CDVM$ PARALLEL (J, I) ON A(I, J) -C variable EPS is used for calculation of maximum value - DO 21 J = 2, K-1 - DO 21 I = 2, K-1 - A(I, J) = B(I, J) - 21 CONTINUE -CDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A) -C Copying shadow elements of array A from -C neighbouring processors before loop execution - DO 22 J = 2, K-1 - DO 22 I = 2, K-1 - B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ - * A( I, J+1 )) / 4 - 22 CONTINUE - - 3 CONTINUE -C compare 2-task JACOBI with 1-task JACOBI -CDVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J)) - DO 11 I = 2,N1 - DO 11 J = 2, K-1 - IF(B1(I,J).NE.B(I,J)) THEN - PRINT *, 'error B1(',I,',',J,')' - STOP - ENDIF - 11 CONTINUE -CDVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J)) - DO 12 I = 2,N2 - DO 12 J = 2, K-1 - IF(B2(I,J).NE.B(I+(N1-1),J)) THEN - PRINT *, 'error B2(',I,',',J,')','B(',I+N1-1,',',J,')' - STOP - ENDIF - 12 CONTINUE - PRINT *, '--- DONE ---' - END - - SUBROUTINE DPT(LP,HP,NT) -C distributing processors for NT tasks (NT = 2) - INTEGER LP(2), HP(2) - NUMBER_OF_PROCESSORS() = 1 -CDVM$ DEBUG 1 (D = 0) - NP = NUMBER_OF_PROCESSORS() - NTP = NP/NT - IF(NP.EQ.1) THEN - LP(1) = 1 - HP(1) = 1 - LP(2) = 1 - HP(2) = 1 - ELSE - LP(1) = 1 - HP(1) = NTP - LP(2) = NTP+1 - HP(2) = NP - END IF -CDVM$ ENDDEBUG 1 - END - - - - - - - - - - - - - - - - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/CMakeLists.txt b/projects/dvm_svn/fdvm/trunk/fdvm/CMakeLists.txt deleted file mode 100644 index 43e37a2..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/CMakeLists.txt +++ /dev/null @@ -1,27 +0,0 @@ -set(FDVM_SOURCES acc.cpp acc_across.cpp acc_across_analyzer.cpp acc_analyzer.cpp - acc_data.cpp acc_f2c.cpp acc_f2c_handlers.cpp acc_rtc.cpp acc_utilities.cpp - aks_analyzeLoops.cpp aks_structs.cpp calls.cpp checkpoint.cpp debug.cpp - dvm.cpp funcall.cpp help.cpp hpf.cpp io.cpp omp.cpp ompdebug.cpp parloop.cpp - stmt.cpp) - -if(MSVC_IDE) - file(GLOB_RECURSE FDVM_HEADERS RELATIVE - ${CMAKE_CURRENT_SOURCE_DIR} *.h) - foreach(DIR ${DVM_FORTRAN_INCLUDE_DIRS}) - file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} "${DIR}/*.h") - set(FDVM_HEADERS ${FDVM_HEADERS} ${FILES}) - endforeach() -endif() - -add_executable(f_dvm ${FDVM_SOURCES} ${FDVM_HEADERS}) - -add_dependencies(f_dvm db sage sage++) -target_link_libraries(f_dvm db sage sage++) -target_compile_definitions(f_dvm PRIVATE SYS5) -target_include_directories(f_dvm PRIVATE "${DVM_FORTRAN_INCLUDE_DIRS}") -set_target_properties(f_dvm PROPERTIES - FOLDER "${DVM_TOOL_FOLDER}" - RUNTIME_OUTPUT_DIRECTORY ${DVM_BIN_DIR} - COMPILE_PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ - PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ -) diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/Makefile b/projects/dvm_svn/fdvm/trunk/fdvm/Makefile deleted file mode 100644 index eb78df4..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/Makefile +++ /dev/null @@ -1,158 +0,0 @@ -#echo####################################################################### -# Makefile for Fortran DVM back-end -# -#echo####################################################################### -SAGEROOT =../Sage -CONFIG_ARCH=iris4d -LIBDIR = ../libsage -#LIBDIR = $(SAGEROOT)/lib/$(CONFIG_ARCH) -#LIBDIR1 =/usr/people/podd/oldsrc -LIBDIR1 = $(LIBDIR) -LIBINCLUDE = $(SAGEROOT)/lib/include -HINCLUDE = $(SAGEROOT)/h -DVMINCLUDE = ../include -INSTALLDEST = ../bin -INSTALL = /bin/cp - - -#HP-ALLOCA#LDLIBS = -lPW#ENDIF# -#HP_CFLAGS#CEXTRA = -Aa#ENDIF# - -CC = gcc -#USE_CC#CC=cc#ENDIF# - -#CXX = DCC -CXX = g++ -#USE_CFRONT#CXX=CC#ENDIF# - -LOADER = $(CXX) - -INCLUDE = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(DVMINCLUDE) - -#CFLAGS = $(INCLUDE) -Wall -c # $(CEXTRA) -CFLAGS = $(INCLUDE) -Wall -g -c # $(CEXTRA) -LDFLAGS = - -LIBS = $(LIBDIR)/libSage++.a $(LIBDIR)/libsage.a $(LIBDIR)/libdb.a -DVM = f_dvm -OBGS = dvm.o funcall.o stmt.o io.o help.o debug.o hpf.o omp.o ompdebug.o acc.o acc_analyzer.o acc_across_analyzer.o calls.o acc_f2c.o acc_f2c_handlers.o acc_across.o aks_structs.o aks_analyzeLoops.o acc_data.o acc_rtc.o acc_utilities.o parloop.o checkpoint.o -# *********************************************************** -f: DVM - -install: $(INSTALLDEST)/DVM - -DVM: $(OBGS) - $(LOADER) $(LDFLAGS) $(OBGS) $(LIBS) -o $(DVM) - -acc.o: acc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc.cpp - -acc_across.o: acc_across.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h - $(CXX) $(CFLAGS) acc_across.cpp - -acc_across_analyzer.o: acc_across_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_across_analyzer.h - $(CXX) $(CFLAGS) acc_across_analyzer.cpp - -acc_analyzer.o: acc_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_analyzer.h - $(CXX) $(CFLAGS) acc_analyzer.cpp - -acc_data.o: acc_data.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_data.cpp - -acc_f2c.o: acc_f2c.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_f2c.cpp - -acc_f2c_handlers.o: acc_f2c_handlers.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_f2c_handlers.cpp - -acc_rtc.o: acc_rtc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_rtc.cpp - -acc_utilities.o: acc_utilities.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_utilities.cpp - -aks_analyzeLoops.o: aks_analyzeLoops.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h - $(CXX) $(CFLAGS) aks_analyzeLoops.cpp - -aks_structs.o: aks_structs.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h - $(CXX) $(CFLAGS) aks_structs.cpp - -calls.o: calls.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) calls.cpp - -checkpoint.o: checkpoint.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) checkpoint.cpp - -debug.o: debug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) debug.cpp - -dvm.o: dvm.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) dvm.cpp - -funcall.o: funcall.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) funcall.cpp - -help.o: help.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) help.cpp - -hpf.o: hpf.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) hpf.cpp - -io.o: io.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) io.cpp - -omp.o: omp.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) omp.cpp - -ompdebug.o: ompdebug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) ompdebug.cpp - -parloop.o: parloop.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) parloop.cpp - -stmt.o: stmt.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) stmt.cpp - - - -$(INSTALLDEST)/DVM: DVM - @echo Installing $(DVM) in $(INSTALLDEST) - if [ -d $(INSTALLDEST) ] ; then true; \ - else mkdir $(INSTALLDEST) ;fi - $(INSTALL) $(DVM) $(INSTALLDEST) -test: tdvm.o - -tdvm.o: tdvm.cpp - $(CXX) -g -c tdvm.cpp - -clean: - /bin/rm -f *.o *.dep $(DVM) - -cleaninstall: - /bin/rm -f *.o $(DVM) - - - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc.cpp deleted file mode 100644 index 5762e0a..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc.cpp +++ /dev/null @@ -1,15256 +0,0 @@ -/*********************************************************************/ -/* Fortran DVM+OpenMP+ACC */ -/* */ -/* ACC Directive Processing */ -/*********************************************************************/ -#include "acc_data.h" - -#define Nintent 6 -#define DELTA 3 -#define Nhandler 3 -#define SAVE_LABEL_ID 1 - -extern int opt_base; -extern fragment_list *cur_fragment; -local_part_list *lpart_list; - -static int dvmh_targets, has_io_stmt; -static int targets[Ndev]; -static int has_region, in_arg_list, analyzing, has_max_minloc, for_shadow_compute, private_array_arg; -//static char *fname_gpu; - -static SgStatement *cur_in_block, *cur_in_source, *mod_gpu_end; -static SgStatement *call_kernel; -static SgExpression *dvm_array_list, *do_st_list, *indexing_info_list, *acc_declared_list; -static SgExpression *argument_list, *base_mem_list, *coeff_list, *gpu_coeff_list, *registered_uses_list; -static SgExpression *red_var_list, *formal_red_offset_list, *red_offset_list, *copy_uses_list; -static SgConstantSymb *device_const[Ndev], *const_LONG, *intent_const[Nintent], *handler_const[Nhandler]; -static SgSymbol *red_offset_symb, *sync_proc_symb, *mem_use_loc_array[8]; -static SgSymbol *adapter_symb, *hostproc_symb, *s_offset_type, *s_of_cudaindex_type; -static symb_list *acc_func_list, *acc_registered_list, *non_dvm_list, *parallel_on_list, *tie_list; -static symb_list *assigned_var_list, *range_index_list, *acc_array_list_whole; -static SgSymbol *Imem_k, *Rmem_k, *Dmem_k, *Cmem_k, *DCmem_k, *Lmem_k, *Chmem_k; -static SgSymbol *fdim3; -static SgSymbol *s_ibof, *s_CudaIndexType_k, *s_warpsize, *s_blockDims; -static SgSymbol *s_rest_blocks, *s_cur_blocks, *s_add_blocks, *s_begin[MAX_LOOP_LEVEL]; -static SgSymbol *s_end[MAX_LOOP_LEVEL], *s_blocksS_k[MAX_LOOP_LEVEL], *s_loopStep[MAX_LOOP_LEVEL]; -static SgType *type_DvmType, *type_CudaIndexType, *type_with_len_DvmType, *type_FortranDvmType, *CudaIndexType_k; -static int loopIndexCount; - - -//------ C ---------- -static const char *red_kernel_func_names[] = { - NULL, - "__dvmh_blockReduceSum", "__dvmh_blockReduceProd", - "__dvmh_blockReduceMax", "__dvmh_blockReduceMin", - "__dvmh_blockReduceAND", "__dvmh_blockReduceOR", - "__dvmh_blockReduceNEQ", "__dvmh_blockReduceEQ", - "__dvmh_blockReduceMaxLoc", "__dvmh_blockReduceMinLoc", - "__dvmh_blockReduceSumN", "__dvmh_blockReduceProdN", - "__dvmh_blockReduceMaxN", "__dvmh_blockReduceMinN", - "__dvmh_blockReduceANDN", "__dvmh_blockReduceORN", - "__dvmh_blockReduceNEQN", "__dvmh_blockReduceEQN" -}; -static const char *fermiPreprocDir = "CUDA_FERMI_ARCH"; -static SgSymbol *s_CudaIndexType, *s_CudaOffsetTypeRef, *s_DvmType; -static SgStatement *end_block, *end_info_block; - -reduction_operation_list *red_struct_list; -symb_list *shared_list, *acc_call_list, *by_value_list; - -void InitializeACC() -{ - mod_gpu_symb = NULL; - mod_gpu = NULL; - block_C = NULL; - info_block = NULL; - //fname_gpu = filenameACC(); - t_dim3 = Type_dim3(); - s_threadidx = s_blockidx = s_blockdim = s_griddim = s_warpsize = NULL; - s_ibof = NULL; - s_blockDims = NULL; - sync_proc_symb = NULL; - acc_array_list = NULL; - cur_in_source = NULL; - kernel_st = NULL; - in_arg_list = 0; - shared_list = NULL; - fdim3 = new SgSymbol(FUNCTION_NAME, "dim3", *(current_file->firstStatement())); - RGname_list = NULL; - type_DvmType = NULL; - type_FortranDvmType = NULL; - type_CudaIndexType = NULL; - type_with_len_DvmType = NULL; - declaration_cmnt = NULL; - indexType_int = indexType_long = indexType_llong = NULL; - dvmh_targets = options.isOn(NO_CUDA) ? HOST_DEVICE : HOST_DEVICE | CUDA_DEVICE; - private_array_class = new SgSymbol(TYPE_NAME, "PrivateArray", *(current_file->firstStatement())); - - SpecialSymbols.insert(std::pair('\n', "\\n\"\n\"")); - SpecialSymbols.insert(std::pair('"', "\\\"")); - SpecialSymbols.insert(std::pair('\\', "\\\\")); - - InitializeAcrossACC(); -} - -char *filenameACC() -{ - char *name; - int i; - name = (char *)malloc((unsigned)(strlen(fin_name) + 1)); - - strcpy(name, fin_name); - for (i = strlen(name) - 1; i >= 0; i--) - { - if (name[i] == '.') - { - name[i] = '\0'; - break; - } - } - return(name); -} - -char *filename_short(SgStatement *st) -{ - char *name; - int i; - name = (char *)malloc((unsigned)(strlen(st->fileName()) + 1)); - strcpy(name, st->fileName()); - - for (i = strlen(name) - 1; i >= 0; i--) - { - if (name[i] == '/' || name[i] == '\\') - { - name = &name[i + 1]; - break; - } - } - int l = strlen(name); - for (i = 0; i < l; i++) - { - if (name[i] == '.') - { - name[i] = '\0'; - break; - } - } - for (i = strlen(name) - 1; i >= 0; i--) - { - if (isupper(name[i])) - name[i] = tolower(name[i]); - } - - l = strlen(name); - for (int i = 0; i < l; i++) - { - char c = name[i]; - if (!( (c >= 'a' && c <= 'z') || c == '_' || ( c >= '0' && c <= '9') )) - name[i] = '_'; - } - - return(name); -} - -char *ChangeFtoCuf(const char *fout_name) -{ - char *name; - int i; - - name = (char *)malloc((unsigned)(strlen(fout_name) + 4 + 13 + 1)); - strcpy(name, fout_name); - for (i = strlen(name) - 1; i >= 0; i--) - { - /* if ( name[i] == '.' ) - { name[i+1] = 'c'; - name[i+2] = 'u'; - name[i+3] = 'f'; - name[i+4] = '\0'; - break; - } - */ - if (name[i] == '.') - break; - } - strcpy(name + i, "_cuda_kernels.cuf"); - return(name); -} - -char *ChangeFto_C_Cu(const char *fout_name) -{ - char *name; - int i; - - name = (char *)malloc((unsigned)(strlen(fout_name) + 3 + 14 + 1)); - strcpy(name, fout_name); - for (i = strlen(name) - 1; i >= 0; i--) - { /* - if ( name[i] == '.' ) - { name[i+1] = 'c'; - name[i+2] = 'u'; - name[i+3] = '\0'; - break; - } - */ - if (name[i] == '.') - { - name[i] = '\0'; - break; - } - } - //sprintf(name[i],"%s_cuda_handlers.cu",name); - if (options.isOn(C_CUDA)) - strcpy(name + i, "_cuda.cu"); - else - strcpy(name + i, "_cuda_handlers.cu"); - return(name); -} - -char *ChangeFto_cpp(const char *fout_name) -{ - char *name; - int i; - - name = (char *)malloc((unsigned)(strlen(fout_name) + 4 + 5 + 1)); - strcpy(name, fout_name); - for (i = strlen(name) - 1; i >= 0; i--) - { - if (name[i] == '.') - { - name[i] = '\0'; - break; - } - } - strcpy(name + i, "_cuda.cpp"); - return(name); -} - -char *ChangeFto_info_C(const char *fout_name) -{ - char *name; - int i; - - name = (char *)malloc((unsigned)(strlen(fout_name) + 2 + 10 + 1)); - strcpy(name, fout_name); - for (i = strlen(name) - 1; i >= 0; i--) - { - if (name[i] == '.') - break; - } - strcpy(name + i, "_cuda_info.c"); - return(name); -} - - -void InitializeInFuncACC() -{ - int i; - maxgpu = 0; /*ACC*/ - sym_gpu = NULL; /*ACC*/ - cur_region = NULL; /*ACC*/ - - for (i = 0; i < Ntp; i++) - { - gpu_mem_use[i] = 0; /*ACC*/ - } - for (i = 0; i < 8; i++) - { - mem_use_loc_array[i] = 0; /*ACC*/ - } - gpu_mem_use[Integer] = 1; - nred_gpu = 1; - maxred_gpu = 0; - red_offset_symb = NULL; - - acc_func_list = NULL; - has_region = 0; - for (i = 0; i < Ndev; i++) - { - device_const[i] = NULL; /*ACC*/ - } - - for (i = 0; i < Nintent; i++) - { - intent_const[i] = NULL; /*ACC*/ - } - - for (i = 0; i < Nhandler; i++) - { - handler_const[i] = NULL; /*ACC*/ - } - for (i = 0; i < Nregim; i++) - { - region_const[i] = NULL; /*ACC*/ - } - //if(region_compare) - //RegionRegimConst(REGION_COMPARE_DEBUG); //region_const[REGION_COMPARE_DEBUG] = < SgConstSymb *> - - acc_return_list = NULL; /*ACC*/ - acc_registered_list = NULL; /*ACC*/ - registered_uses_list = NULL; /*ACC*/ - acc_declared_list = NULL; /*ACC*/ - -} - -int GeneratedForCuda() -{ - return (kernel_st || cuda_functions ? 1 : 0); -} - - - -void TempVarACC(SgStatement * func) { - - SgValueExp M1(1), M0(0); - SgExpression *MN = new SgExpression( - DDOT, NULL, NULL, NULL); - SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), &M1.copy(), NULL); - SgArrayType *typearray; - SgExpression *MD; - - if (len_DvmType) - const_LONG = new SgConstantSymb("LDVMH", *func, *new SgValueExp(len_DvmType)); - - typearray = new SgArrayType(*SgTypeInt()); - gpubuf = new SgVariableSymb("gpu000", *typearray, *func); - - MD = (func->variant() == PROG_HEDR) ? MN : M01; - - typearray = new SgArrayType(*SgTypeInt()); - typearray->addRange(*MD); - Imem_gpu = new SgVariableSymb("i0000g", *typearray, *func); - - typearray = new SgArrayType(*SgTypeFloat()); - typearray->addRange(*MD); - Rmem_gpu = new SgVariableSymb("r0000g", *typearray, *func); - - typearray = new SgArrayType(*SgTypeDouble()); - typearray->addRange(*MD); - Dmem_gpu = new SgVariableSymb("d0000g", *typearray, *func); - - typearray = new SgArrayType(*SgTypeBool()); - typearray->addRange(*MD); - Lmem_gpu = new SgVariableSymb("l0000g", *typearray, *func); - - typearray = new SgArrayType(*SgTypeComplex(current_file)); - typearray->addRange(*MD); - Cmem_gpu = new SgVariableSymb("c0000g", *typearray, *func); - - typearray = new SgArrayType(*SgTypeDoubleComplex(current_file)); - typearray->addRange(*MD); - DCmem_gpu = new SgVariableSymb("dc000g", *typearray, *func); - - typearray = new SgArrayType(*SgTypeChar()); - typearray->addRange(*MD); - Chmem_gpu = new SgVariableSymb("ch000g", *typearray, *func); - // if(func->variant()==PROG_HEDR) - // { SYMB_ATTR(Imem_gpu->thesymb)= SYMB_ATTR(Imem_gpu->thesymb) | ALLOCATABLE_BIT; - // SYMB_ATTR(Dmem_gpu->thesymb)= SYMB_ATTR(Dmem_gpu->thesymb) | ALLOCATABLE_BIT; - // } - -} - -void AddExternStmtToBlock_C() -{ - SgStatement *stmt = NULL; - int ln; - symb_list *sl = NULL; - if (!RGname_list) - return; - for (sl = RGname_list, ln = 0; sl; sl = sl->next, ln++) - if (!ln) - stmt = makeExternSymbolDeclaration(&(sl->symb->copy())); - else - addDeclExpList(sl->symb, stmt->expr(0)); - - - cur_in_block->insertStmtBefore(*stmt, *block_C); //10.12.13 - //block_C->insertStmtAfter(*stmt,*block_C); -} - - -int isDestroyable(SgSymbol *s) -{ - if (!CURRENT_SCOPE(s)) - return(0); - if (s->attributes() & PARAMETER_BIT) - return(0); - if ((s->attributes() & SAVE_BIT) || saveall || IN_DATA(s)) - return(0); - if (IN_COMMON(s) || IS_DUMMY(s)) - return(0); - return(1); -} - - -int isLocal(SgSymbol *s) -{ - if (!CURRENT_SCOPE(s)) - return(0); - if ((s->attributes() & SAVE_BIT) || saveall || IN_DATA(s)) - return(0); - if (IN_COMMON(s) || IS_DUMMY(s)) - return(0); - - return(1); -} - -SgExpression *ACC_GroupRef(int ind) -{ - SgExpression *res; - res = DVM000(ind); - if (IN_COMPUTE_REGION || parloop_by_handler) //BY_HANDLER - { - int *id = new int; - *id = ind + 3; - res->addAttribute(ACROSS_GROUP_IND, (void *)id, sizeof(int)); - } - - return res; -} - -/* -SgSymbol*GpuBaseSymbolForLocArray(int n) -{ SgSymbol *base; -SgArrayType *typearray; -SgExpression *MD; -SgValueExp M1(1),M0(0); -SgExpression *MN = new SgExpression(DDOT,NULL,NULL,NULL); -SgExpression *M01 = new SgExpression(DDOT,&M0.copy(),&M1.copy(),NULL); -char *name; -name = new char[7]; -sprintf(name,"i%d000g", n); -typearray = new SgArrayType(*SgTypeInt()); -MD = (cur_func->variant()==PROG_HEDR) ? MN : new SgValueExp(n); -typearray-> addRange(*MD); -MD =(cur_func->variant()==PROG_HEDR) ? MN : M01; -typearray-> addRange(*MD); -base = new SgVariableSymb(name, *typearray, *cur_func); -return(base); -} -*/ -/* -SgSymbol*KernelBaseSymbolForLocArray(int n) -{ SgSymbol *base; -SgArrayType *typearray; -SgExpression *MD; -SgValueExp M1(1),M0(0); -SgExpression *M01 = new SgExpression(DDOT,&M0.copy(),&M1.copy(),NULL); -char *name; -name = new char[7]; -sprintf(name,"i%d000m", n); -typearray = new SgArrayType(*SgTypeInt()); -MD = new SgValueExp(n); -typearray-> addRange(*MD); -typearray-> addRange(*M01); -base = new SgVariableSymb(name, *typearray, *kernel_st); -return(base); -} -*/ -/* -SgSymbol* DerivedTypeGpuBaseSymbol(SgSymbol *stype,SgType *t) -{ -char *name; -SgSymbol *sn; -SgArrayType *typearray; -SgValueExp M0(0), M1(1); -SgExpression *MD; -SgExpression *MN = new SgExpression(DDOT,NULL,NULL,NULL); -SgExpression *M01 = new SgExpression(DDOT,&M0.copy(),&M1.copy(),NULL); -name = new char[80]; -sprintf(name,"%s0000g",stype->identifier()); -MD = (IN_MAIN_PROGRAM) ? MN : M01; -typearray = new SgArrayType(*t); -typearray-> addRange(*MD); -sn = new SgVariableSymb(name, *typearray, *cur_func); -return(sn); -} -*/ -/* -SgSymbol* GpuHeaderSymbol(SgSymbol *ar) -{ -char *name; -SgSymbol *sn; -SgArrayType *typearray; -SgValueExp M0(0); -SgExpression *rnk = new SgValueExp(Rank(ar)+DELTA); -//name = new char[80]; -name = (char *) malloc((unsigned)(strlen(ar->identifier())+4+1)); -sprintf(name,"%s_gpu",ar->identifier()); -typearray = new SgArrayType(*SgTypeInt()); -typearray-> addRange(*rnk); -sn = new SgVariableSymb(name, *typearray, *cur_func); -return(sn); -} -*/ - -SgType *Type_dim3() -{ - SgSymbol *sdim3 = new SgSymbol(TYPE_NAME, "dim3", *(current_file->firstStatement())); - SgFieldSymb *sx = new SgFieldSymb("x", *SgTypeInt(), *sdim3); - SgFieldSymb *sy = new SgFieldSymb("y", *SgTypeInt(), *sdim3); - SgFieldSymb *sz = new SgFieldSymb("z", *SgTypeInt(), *sdim3); - SYMB_NEXT_FIELD(sx->thesymb) = sy->thesymb; - SYMB_NEXT_FIELD(sy->thesymb) = sz->thesymb; - SYMB_NEXT_FIELD(sz->thesymb) = NULL; - - SgType *tstr = new SgType(T_STRUCT); - TYPE_COLL_FIRST_FIELD(tstr->thetype) = sx->thesymb; - sdim3->setType(tstr); - - SgType *td = new SgType(T_DERIVED_TYPE); - TYPE_SYMB_DERIVE(td->thetype) = sdim3->thesymb; - TYPE_SYMB(td->thetype) = sdim3->thesymb; - - return(td); -} - -SgType *FortranDvmType() -{ - SgType *t; - if (type_FortranDvmType) - return(type_FortranDvmType); - if (len_DvmType) - { - SgExpression *le; - le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(len_DvmType)); - t = new SgType(T_INT, le, NULL); - - } - else - t = SgTypeInt(); - type_FortranDvmType = t; - return(type_FortranDvmType); -} - -void DeviceTypeConsts() -{ - if (device_const[HOST]) return; - device_const[HOST] = new SgConstantSymb("DEVICE_TYPE_HOST", *cur_func, *new SgValueExp(HOST)); - device_const[CUDA] = new SgConstantSymb("DEVICE_TYPE_CUDA", *cur_func, *new SgValueExp(CUDA)); -} - -SgSymbol *DeviceTypeConst(int i) -{ - if (device_const[i]) - return(device_const[i]); - switch (i) - { - case HOST: - device_const[HOST] = new SgConstantSymb("DEVICE_TYPE_HOST", *cur_func, *new SgValueExp(HOST)); - break; - case CUDA: - device_const[CUDA] = new SgConstantSymb("DEVICE_TYPE_CUDA", *cur_func, *new SgValueExp(CUDA)); - break; - } - return(device_const[i]); -} - - -void HandlerTypeConsts() -{ - if (handler_const[HANDLER_TYPE_PARALLEL]) return; - handler_const[HANDLER_TYPE_PARALLEL] = new SgConstantSymb("HANDLER_TYPE_PARALLEL", *cur_func, *new SgValueExp(HANDLER_TYPE_PARALLEL)); - handler_const[HANDLER_TYPE_MASTER] = new SgConstantSymb("HANDLER_TYPE_MASTER", *cur_func, *new SgValueExp(HANDLER_TYPE_MASTER)); -} - -SgSymbol *HandlerTypeConst(int i) -{ - if (handler_const[i]) - return(handler_const[i]); - switch (i) - { - case HANDLER_TYPE_PARALLEL: - handler_const[HANDLER_TYPE_PARALLEL] = new SgConstantSymb("HANDLER_TYPE_PARALLEL", *cur_func, *new SgValueExp(HANDLER_TYPE_PARALLEL)); - break; - case HANDLER_TYPE_MASTER: - handler_const[HANDLER_TYPE_MASTER] = new SgConstantSymb("HANDLER_TYPE_MASTER", *cur_func, *new SgValueExp(HANDLER_TYPE_MASTER)); - break; - } - return(handler_const[i]); -} - -SgSymbol *RegionRegimConst(int regim) -{ - if (region_const[regim]) return(region_const[regim]); - if (regim == REGION_ASYNC) - region_const[REGION_ASYNC] = new SgConstantSymb("REGION_ASYNC", *cur_func, *new SgValueExp(REGION_ASYNC)); - else if (regim == REGION_COMPARE_DEBUG) - region_const[REGION_COMPARE_DEBUG] = new SgConstantSymb("REGION_COMPARE_DEBUG", *cur_func, *new SgValueExp(REGION_COMPARE_DEBUG)); - return(region_const[regim]); -} - - -SgSymbol *IntentConst(int intent) -{ - const char *name; - - if (intent_const[intent]) - return(intent_const[intent]); - - switch (intent) - { - case(INTENT_IN) : name = "INTENT_IN"; break; - case(INTENT_OUT) : name = "INTENT_OUT"; break; - case(INTENT_INOUT) : name = "INTENT_INOUT"; break; - case(INTENT_LOCAL) : name = "INTENT_LOCAL"; break; - case(INTENT_INLOCAL) : name = "INTENT_INLOCAL"; break; - case(EMPTY) : name = "EMPTY"; break; - default: name = ""; break; - } - - intent_const[intent] = new SgConstantSymb(name, *cur_func, *new SgValueExp(intent)); - - return(intent_const[intent]); -} - -SgSymbol *ArraySymbol(char *name, SgType *basetype, SgExpression *range, SgStatement *scope) -{ - SgSymbol *ar; - SgArrayType *typearray; - - typearray = new SgArrayType(*basetype); - if (range) - typearray->addRange(*range); - ar = new SgVariableSymb(name, *typearray, *scope); - return(ar); -} - -SgSymbol *ArraySymbol(const char *name, SgType *basetype, SgExpression *range, SgStatement *scope) -{ - SgSymbol *ar; - SgArrayType *typearray; - - typearray = new SgArrayType(*basetype); - if (range) - typearray->addRange(*range); - ar = new SgVariableSymb(name, *typearray, *scope); - return(ar); -} - - -SgSymbol *KernelSymbol(SgStatement *st_do) -{ - SgSymbol *sk; - ++nkernel; - - char *kname = (char *)malloc((unsigned)(strlen(st_do->fileName())) + 38); - if (inparloop) - sprintf(kname, "%s_%s_%d_cuda_kernel", "loop", filename_short(st_do), st_do->lineNumber()); - else - sprintf(kname, "%s_%s_%d_cuda_kernel", "sequence", filename_short(st_do), st_do->lineNumber()); - - sk = new SgSymbol(PROCEDURE_NAME, kname, *mod_gpu); - if (options.isOn(C_CUDA)) - sk->setType(C_VoidType()); - return(sk); -} - -SgSymbol *HostProcSymbol(SgStatement *st_do) -{ - SgSymbol *s; - char *sname = (char *)malloc((unsigned)(strlen(st_do->fileName())) + 30); - if (inparloop) - sprintf(sname, "%s_%s_%d_host", "loop", filename_short(st_do), st_do->lineNumber()); - else - sprintf(sname, "%s_%s_%d_host", "sequence", filename_short(st_do), st_do->lineNumber()); - s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); - acc_func_list = AddToSymbList(acc_func_list, s); - return(s); -} - -SgSymbol *HostAcrossProcSymbol(SgSymbol *sHostProc, int dependency) -{ - SgSymbol *s; - char *sname = (char *)malloc((unsigned)(strlen(sHostProc->identifier())) + 5); - sprintf(sname, "%s_%d", sHostProc->identifier(), dependency); - s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); - acc_func_list = AddToSymbList(acc_func_list, s); - return(s); -} - -SgSymbol *HostProcSymbol_RA(SgSymbol *sHostProc) -{ - SgSymbol *s; - char *sname = (char *)malloc((unsigned)(strlen(sHostProc->identifier())) + 4); - sprintf(sname, "%s_%s", sHostProc->identifier(), "RA"); - s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); - acc_func_list = AddToSymbList(acc_func_list, s); - return(s); -} - -SgSymbol *IndirectFunctionSymbol(SgStatement *stmt, char *name) -{ - char *sname = (char *)malloc((unsigned)(strlen(stmt->fileName())) + 40); - sprintf(sname, "indirect_%s_%s_%d", name, filename_short(stmt), stmt->lineNumber()); - SgSymbol *s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); - acc_func_list = AddToSymbList(acc_func_list, s); - return(s); -} - -SgSymbol *GPUModuleSymb(SgStatement *global_st) -{ - SgSymbol *mod_symb; - char *modname; - - modname = (char *)malloc((unsigned)(strlen(global_st->fileName()) + 8 + 1)); - sprintf(modname, "dvm_gpu_%s", filename_short(global_st)); - mod_symb = new SgSymbol(MODULE_NAME, modname, *global_st); - return(mod_symb); -} - - -SgSymbol *CudaforSymb(SgStatement *global_st) -{ - SgSymbol *cudafor_symb; - cudafor_symb = new SgSymbol(MODULE_NAME, "cudafor", *global_st); - return(cudafor_symb); -} - -/* -SgSymbol *KernelArgumentSymbol(int n) -{char *name; -SgSymbol *sn; -name = new char[80]; -sprintf(name,"dbv_goto00%d", n); -sn = new SgVariableSymb(name,*t,*cur_func); -if_goto = AddToSymbList(if_goto, sn); -return(sn); -} -*/ - -/* -SgSymbol *Var_Offset_Symbol(SgSymbol *var) -{ -if(!red_offset_symb) -red_offset_symb = new SgVariableSymb("red_offset",*new SgArrayType(*IndexType()),*cur_func); - -return(red_offset_symb); -} -*/ - -SgSymbol *RedCountSymbol(SgStatement *scope) -{ - //if(red_count_symb) return; - - return(new SgVariableSymb("red_count", *SgTypeInt(), *scope)); // IndexType() - -} - -char *PointerNameForPrivateArray(SgSymbol *symb) -{ - char *name = new char[strlen(symb->identifier())+4]; - sprintf(name, "_%s_p", symb->identifier()); - return name; -} - -SgSymbol *OverallBlocksSymbol() -{ - SgType *type; - type = options.isOn(C_CUDA) ? C_CudaIndexType() : FortranDvmType(); - return(new SgVariableSymb("overall_blocks", *type, *kernel_st)); -} - -void BeginEndBlocksSymbols(int pl_rank) -{ - int i; - char *name = new char[20]; - SgType *type; - for (i = MAX_LOOP_LEVEL; i; i--) - { - s_begin[i - 1] = NULL; - s_end[i - 1] = NULL; - s_blocksS_k[i - 1] = NULL; - s_loopStep[i - 1] = NULL; - } - type = options.isOn(C_CUDA) ? C_Derived_Type(s_CudaIndexType_k) : CudaIndexType(); - for (i = 1; i <= pl_rank; i++) - { - sprintf(name, "begin_%d", i); - s_begin[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); - sprintf(name, "end_%d", i); - s_end[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); - sprintf(name, "blocks_%d", i); - s_blocksS_k[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); - sprintf(name, "loopStep_%d", i); - s_loopStep[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); - - } - -} - -/* -SgSymbol *RedOffsetSymbolInKernel(SgSymbol *s) -{ char *name; -SgSymbol *soff; - -name = (char *) malloc((unsigned)(strlen(s->identifier())+8)); -//strcpy (name,s->identifier()); -sprintf(name,"%s_offset",s->identifier()); -soff = new SgVariableSymb(name, *IndexType(), *kernel_st); - -return(soff); -} -*/ -/* -SgSymbol *RedOffsetSymbolInKernel_ToList(SgSymbol *s) -{ char *name; -SgSymbol *soff; -SgExpression *ell, *el; -name = (char *) malloc((unsigned)(strlen(s->identifier())+8)); -sprintf(name,"%s_offset",s->identifier()); -soff = new SgVariableSymb(name, *IndexType(), *kernel_st); -ell = new SgExprListExp(*new SgVarRefExp(*soff)); -if(!formal_red_offset_list) -formal_red_offset_list = ell; -else -{ el = formal_red_offset_list; -while( el->rhs()) -el=el->rhs(); -el->setRhs(ell); -} -return(soff); -} - -*/ - -SgStatement * MakeStructDecl(SgSymbol *strc) -{ - SgStatement *typedecl, *st1, *st2; - SgSymbol *sf; - typedecl = new SgDeclarationStatement(STRUCT_DECL); - typedecl->setSymbol(*strc); - sf = FirstTypeField(strc->type()); - st1 = sf->makeVarDeclStmt(); - typedecl->insertStmtAfter(*st1, *typedecl); - sf = ((SgFieldSymb *)sf)->nextField(); - st2 = sf->makeVarDeclStmt(); - st1->insertStmtAfter(*st2, *typedecl); - return(typedecl); - - /* - sf = =((SgFieldSymb *)sf)->nextField(); - for(sf=FirstTypeField(s->type());sf;sf=((SgFieldSymb *)sf)->nextField()) - - SYMB_NEXT_FIELD(sz->thesymb) = NULL; - - SgType *tstr = new SgType(T_STRUCT); - TYPE_COLL_FIRST_FIELD(tstr->thetype)= sx->thesymb; - SymbMapping - */ -} - -/* -int isIntrinsicFunction(SgSymbol *sf) -{ -if(IntrinsicInd(sf) == -1) -return(0); -else -return( 1); -} - - -int IntrinsicInd(SgSymbol *sf) -{ int i; -for(i=0; iidentifier()); - -if(!strcmp(sf->identifier(),intrinsic_name[i])) -return(i); -} -return(-1); -} -*/ - -void DeclareVarGPU(SgStatement *lstat, SgType *tlen) -{ - SgStatement *st; - SgExpression *eatr, *el, *eel; - int i; - - // declare created procedures(C-functions) as EXTERNAL - - if (acc_func_list) - { - symb_list *sl; - SgExpression *el, *eel; - st = new SgStatement(EXTERN_STAT); - el = new SgExprListExp(*new SgVarRefExp(acc_func_list->symb)); - for (sl = acc_func_list->next; sl; sl = sl->next) - { - eel = new SgExprListExp(*new SgVarRefExp(sl->symb)); - eel->setRhs(*el); - el = eel; - } - st->setExpression(0, *el); - - lstat->insertStmtAfter(*st); - } - - // declare INTENT constants - - for (i = Nintent - 1, el = NULL; i >= 0; i--) - if (intent_const[i]) - { - eel = new SgExprListExp(*new SgRefExp(CONST_REF, *intent_const[i])); - eel->setRhs(el); - el = eel; - } - if (el) - { - st = fdvm[0]->makeVarDeclStmt(); - st->setExpression(0, *el); - if (len_DvmType) - st->expr(1)->setType(tlen); - eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); - st->setExpression(2, *eatr); - lstat->insertStmtAfter(*st); - } - // declare CUDA constants - - for (i = Ndev - 1, el = NULL; i; i--) - if (device_const[i]) - { - eel = new SgExprListExp(*new SgRefExp(CONST_REF, *device_const[i])); - eel->setRhs(el); - el = eel; - } - if (el) - { - st = fdvm[0]->makeVarDeclStmt(); - st->setExpression(0, *el); - if (len_DvmType) - st->expr(1)->setType(tlen); - eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); - st->setExpression(2, *eatr); - lstat->insertStmtAfter(*st); - } - - // declare Handler constants /* OpenMP * / - - for (i = Nhandler - 1, el = NULL; i; i--) - if (handler_const[i]) - { - eel = new SgExprListExp(*new SgRefExp(CONST_REF, *handler_const[i])); - eel->setRhs(el); - el = eel; - } - if (el) - { - st = fdvm[0]->makeVarDeclStmt(); - st->setExpression(0, *el); - if (len_DvmType) - st->expr(1)->setType(tlen); - eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); - st->setExpression(2, *eatr); - lstat->insertStmtAfter(*st); - } - - - - - // declare REGION-REGIM constants - - for (i = Nregim - 1, el = NULL; i; i--) - if (region_const[i]) - { - eel = new SgExprListExp(*new SgRefExp(CONST_REF, *region_const[i])); - eel->setRhs(el); - el = eel; - } - if (el) - { - st = fdvm[0]->makeVarDeclStmt(); - st->setExpression(0, *el); - if (len_DvmType) - st->expr(1)->setType(tlen); - eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); - st->setExpression(2, *eatr); - lstat->insertStmtAfter(*st); - } - -} - -/************************************************************************************/ -/* Data Region */ -/************************************************************************************/ -void EnterDataRegionForAllocated(SgStatement *stmt) -{SgExpression *al; - if(!ACC_program) - return; - for(al=stmt->expr(0); al; al=al->rhs()) - EnterDataRegion(al->lhs(),stmt); - - allocated_list = AddListToList(allocated_list,&stmt->expr(0)->copy()); -} - -void EnterDataRegion(SgExpression *ale,SgStatement *stmt) -{ SgExpression *e,*size; - SgSymbol *ar; - - e = &(ale->copy()); - if(isSgRecordRefExp(e)) - { - SgExpression *alce = RightMostField(e); - alce->setLhs(NULL); - ar = alce->symbol(); - } else - { - e->setLhs(NULL); - ar = e->symbol(); - } -/* - SgType *t = ar->type(); - if(isSgArrayType(t)) - { - t = t->baseType(); - size = &(*SizeFunction(ar,0) * (*ConstRef_F95(TypeSize(t)))); - } else - size = ConstRef_F95(TypeSize(t)); - InsertNewStatementAfter(DataEnter(e,size),cur_st,cur_st->controlParent()); -*/ - InsertNewStatementAfter(DataEnter(e,ConstRef(0)),cur_st,cur_st->controlParent()); -} - -void ExitDataRegion(SgExpression *ale,SgStatement *stmt) -{ SgExpression *e,*size; - SgSymbol *ar,*ar2; - - e = &(ale->copy()); - if(isSgRecordRefExp(e)) - { - SgExpression *alce = RightMostField(e); - alce->setLhs(NULL); - ar = LeftMostField(e)->symbol(); - - //if(!(ar2 = GetTypeField(RightMostField(e->lhs())->symbol(),RightMostField(e)->symbol()))) - ar2 = RightMostField(e)->symbol(); - - - //printf("==%s %d\n",ar->identifier(), TYPE_COLL_FIRST_FIELD(ar->type()->symbol()->type()->thetype)->attr); - //ar->type()->symbol()->type()->firstField()->identifier());// ->type()->symbol()->type()->variant()); - } else - { - e->setLhs(NULL); - ar = ar2 = e->symbol(); - } - - // printf("%s %d %d %d\n",ar->identifier(),ar->attributes() & POINTER_BIT, ar->attributes(),e->rhs()->symbol()->variant()); - if(isLocal(ar) && !IS_POINTER_F90(ar2)) - doLogIfForAllocated(e,stmt); - -} - -void UnregisterVariables(int begin_block) -{ - stmt_list *stl; - int is; - if (!ACC_program || IN_MAIN_PROGRAM) - return; - for (stl = acc_return_list; stl; stl = stl->next) - { - is = ExitDataRegionForAllocated(stl->st, begin_block); - ExitDataRegionForLocalVariables(stl->st, is || begin_block); - } -} - -/* -void InsertDestroyBlock(SgStatement *st) -{ - SgExpression *el; - symb_list *sl; - - if (st->lexNext()->lineNumber() == 0) // there are inserted (by EndOfProgramUnit()) statements - st = st->lexNext(); // to insert new statements after dvmlf() call - for (el = registered_uses_list; el; el = el->rhs()) - { - if (!el->lhs()) continue; - if (el->lhs()->symbol()->variant() != CONST_NAME && isLocal(el->lhs()->symbol()) && !IS_ALLOCATABLE(el->lhs()->symbol())) // //!(el->lhs()->symbol()->attributes() & PARAMETER_BIT) ) - st->insertStmtAfter(*DestroyScalar(new SgVarRefExp(el->lhs()->symbol()))); - } - for (sl = acc_registered_list; sl; sl = sl->next) - { - if (sl->symb->variant() != CONST_NAME && isLocal(sl->symb)) //&& !IS_ALLOCATABLE(sl->symb) //!(sl->symb->attributes() & PARAMETER_BIT)) - { - if (HEADER(sl->symb)) - st->insertStmtAfter(*DestroyArray(HeaderRef(sl->symb))); - else if (!IS_ALLOCATABLE(sl->symb)) - st->insertStmtAfter(*DestroyScalar(new SgVarRefExp(sl->symb))); - } - } - -} -*/ - -void DeclareDataRegionSaveVariables(SgStatement *lstat, SgType *tlen) -{ - SgExpression *el; - symb_list *sl; - SgSymbol *symb; - for (el = registered_uses_list; el; el = el->rhs()) - { - symb = el->lhs()->symbol(); - SgSymbol **attr = (SgSymbol **)(symb)->attributeValue(0,DATA_REGION_SYMB); - if (attr) - DeclareVariableWithInitialization (*attr, tlen, lstat); - - } - for (sl = acc_registered_list; sl; sl = sl->next) - { - symb = sl->symb; - SgSymbol **attr = (SgSymbol **)(symb)->attributeValue(0,DATA_REGION_SYMB); - if (attr) - DeclareVariableWithInitialization (*attr, tlen, lstat); - } - for (el = acc_declared_list; el; el = el->rhs()) - { - symb = el->lhs()->symbol(); - if (!(IS_ARRAY(symb)) || isInExprList(el->lhs(), registered_uses_list) || isInSymbList(symb, acc_registered_list)) - continue; - SgSymbol **attr = (SgSymbol **)(symb)->attributeValue(0,DATA_REGION_SYMB); - if (attr) - DeclareVariableWithInitialization (*attr, tlen, lstat); - } -} - -SgSymbol *DataRegionVar(SgSymbol *symb) -{ - char *name = new char[strlen(symb->identifier())+10]; - sprintf(name, "dvm_save_%s", symb->identifier()); - SgSymbol *dvm_symb = new SgVariableSymb(name, *SgTypeInt(), *cur_func); - SgSymbol **new_s = new (SgSymbol *); - *new_s= dvm_symb; - symb->addAttribute(DATA_REGION_SYMB, (void*) new_s, sizeof(SgSymbol *)); - - return(dvm_symb); -} - -void EnterDataRegionForLocalVariables(SgStatement *st, SgStatement *first_exec, int begin_block) -{ - SgExpression *el; - symb_list *sl; - SgStatement *newst=NULL; - for (el = registered_uses_list; el; el = el->rhs()) - { - if (!el->lhs()) continue; - SgSymbol *sym = el->lhs()->symbol(); - if (IS_ARRAY(sym) && sym->variant() != CONST_NAME && IS_LOCAL_VAR(sym) && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !(sym->attributes() & HEAP_BIT)) // //!(el->lhs()->symbol()->attributes() & PARAMETER_BIT) ) - { - if (HAS_SAVE_ATTR(sym) || IN_DATA(sym)) - newst = doIfThenForDataRegion(DataRegionVar(sym), st, DataEnter(new SgVarRefExp(sym),ConstRef(0))); - else - st->insertStmtAfter(*(newst=DataEnter(new SgVarRefExp(sym),ConstRef(0))),*st->controlParent()); - } - } - for (sl = acc_registered_list; sl; sl = sl->next) - { - if (IS_ARRAY(sl->symb) && sl->symb->variant() != CONST_NAME && IS_LOCAL_VAR(sl->symb) && !IS_ALLOCATABLE(sl->symb) && !IS_POINTER_F90(sl->symb) && !HEADER(sl->symb)) //!(sl->symb->attributes() & PARAMETER_BIT)) - { - if (HAS_SAVE_ATTR(sl->symb) || IN_DATA(sl->symb)) - newst = doIfThenForDataRegion(DataRegionVar(sl->symb), st, DataEnter(new SgVarRefExp(sl->symb),ConstRef(0))); - else - st->insertStmtAfter(*(newst=DataEnter(new SgVarRefExp(sl->symb),ConstRef(0))),*st->controlParent()); - } - } - - for (el = acc_declared_list; el; el = el->rhs()) - { - SgSymbol *sym = el->lhs()->symbol(); - if (!IS_ARRAY(sym) || isInExprList(el->lhs(), registered_uses_list) || isInSymbList(sym, acc_registered_list)) - continue; - - if (sym->variant() != CONST_NAME && IS_LOCAL_VAR(sym) && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !(sym->attributes() & HEAP_BIT) && !HEADER(sym)) - { - if (HAS_SAVE_ATTR(sym) || IN_DATA(sym)) - newst = doIfThenForDataRegion(DataRegionVar(sym), st, DataEnter(new SgVarRefExp(sym),ConstRef(0))); - else - st->insertStmtAfter(*(newst=DataEnter(new SgVarRefExp(sym),ConstRef(0))),*st->controlParent()); - } - } - - if (newst && !begin_block) - LINE_NUMBER_AFTER(first_exec,st); -} - -void ExitDataRegionForLocalVariables(SgStatement *st, int is) -{ - SgExpression *el; - symb_list *sl; - - for (el = registered_uses_list; el; el = el->rhs()) - { - if (!el->lhs()) continue; - SgSymbol *sym = el->lhs()->symbol(); - if (IS_ARRAY(sym) && sym->variant() != CONST_NAME && IS_LOCAL_VAR(sym) && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !(sym->attributes() & HEAP_BIT)) // //!(el->lhs()->symbol()->attributes() & PARAMETER_BIT) ) - { - if (HAS_SAVE_ATTR(sym) || IN_DATA(sym)) - continue; - if (!is++) - LINE_NUMBER_BEFORE(st,st); - InsertNewStatementBefore(DataExit(new SgVarRefExp(sym),0),st); - } - } - for (sl = acc_registered_list; sl; sl = sl->next) - { - if (IS_ARRAY(sl->symb) && sl->symb->variant() != CONST_NAME && IS_LOCAL_VAR(sl->symb) && !IS_ALLOCATABLE(sl->symb) && !IS_POINTER_F90(sl->symb) && !HEADER(sl->symb)) //!(sl->symb->attributes() & PARAMETER_BIT)) - { - if (HAS_SAVE_ATTR(sl->symb) || IN_DATA(sl->symb)) - continue; - if (!is++) - LINE_NUMBER_BEFORE(st,st); - InsertNewStatementBefore(DataExit(new SgVarRefExp(sl->symb),0),st); - } - } - for (el = acc_declared_list; el; el = el->rhs()) - { - if (!el->lhs()) continue; - SgSymbol *sym = el->lhs()->symbol(); - if (!IS_ARRAY(sym) || isInExprList(el->lhs(), registered_uses_list) || isInSymbList(sym, acc_registered_list)) - continue; - if (sym->variant() != CONST_NAME && IS_LOCAL_VAR(sym) && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !(sym->attributes() & HEAP_BIT) && !HEADER(sym)) - { - if (HAS_SAVE_ATTR(sym) || IN_DATA(sym)) - continue; - if (!is++) - LINE_NUMBER_BEFORE(st,st); - InsertNewStatementBefore(DataExit(new SgVarRefExp(sym),0),st); - } - } -} - -void testScopeOfDeclaredVariables(SgStatement *stmt) -{ - SgExpression *el; - for (el = stmt->expr(0); el; el = el->rhs()) - { - SgSymbol *sym = el->lhs()->symbol(); - if (!IS_LOCAL_VAR(sym)) - Error("Non-local data object in DECLARE directive: %s", sym->identifier(), 668, stmt); - continue; - } -} - -void testDeclareDirectives(SgStatement *first_dvm_exec) -{ - SgStatement *stmt; - for (stmt = cur_func->lexNext(); stmt && (stmt != first_dvm_exec); stmt = stmt->lastNodeOfStmt()->lexNext()) - { - if (stmt->variant()==ACC_DECLARE_DIR) - { - if (IN_MODULE) - err("Illegal directive in module", 632, stmt); - else if (!IN_MAIN_PROGRAM) - testScopeOfDeclaredVariables(stmt); - } - continue; - } - // eliminating duplicate objects from the acc_declared_list - SgExpression *el, *el2, *prev; - for (el = acc_declared_list; el; el = el->rhs()) - { - for (el2 = el->rhs(), prev = el; el2; ) - if (ORIGINAL_SYMBOL(el->lhs()->symbol()) == ORIGINAL_SYMBOL(el2->lhs()->symbol())) - { prev->setRhs(el2->rhs()); el2 = el2->rhs(); } - else - { prev = el2; el2 = el2->rhs(); } - } -} - -void ExtractCopy(SgExpression *elist) -{ - SgExpression *el; - SgExpression *e = elist->lhs(); - if(!e) return; - for (el = elist->rhs(); el; el = el->rhs()) - if(el->lhs() && ExpCompare(e,el->lhs())) - el->setLhs(NULL); -} - -void CleanAllocatedList() -{ -//the same allocated_list items are deleted - SgExpression *el; - for (el = allocated_list; el; el = el->rhs()) - ExtractCopy(el); - for (el = allocated_list; el; ) - if(el->rhs() && !el->rhs()->lhs()) - el->setRhs(el->rhs()->rhs()); - else - el = el->rhs(); -} - -int ExitDataRegionForAllocated(SgStatement *st,int begin_block) -{ - SgExpression *el; - if (!ACC_program) - return(0); - - if (TestLocal(allocated_list)) - { - if(!begin_block) - LINE_NUMBER_BEFORE(st,st); - } else - return(0); - CleanAllocatedList(); - for (el = allocated_list; el; el = el->rhs()) - ExitDataRegion(el->lhs(),st); - return(1); -} - -int TestLocal(SgExpression *list) -{ - SgExpression *el; - SgSymbol *s; - for (el = list; el; el = el->rhs()) - { - s = isSgRecordRefExp(el->lhs()) ? LeftMostField(el->lhs())->symbol() : el->lhs()->symbol(); - if(isLocal(s)) - return(1); - } - return (0); -} - -int is_deleted_module_symbol(SgSymbol *s) // deleted because it was renamed (parser/sym.c: function delete_symbol()) -{ - if (!strcmp("***", s->identifier())) - return 1; - return 0; -} - -int hasSameOriginalName(SgSymbol *s) -{ - SgSymbol *symb = cur_func->symbol()->next(); - while (symb != s) - { - if (ORIGINAL_SYMBOL(symb) == ORIGINAL_SYMBOL(s)) - return 1; - symb = symb->next(); - } - return 0; -} - -void EnterDataRegionForVariablesInMainProgram(SgStatement *st) -{ -/* - symb_list *sl; - SgSymbol *s; - for(sl=registration; sl; sl=sl->next) - { - s = sl->symb; - if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && s->scope() == cur_func && !IS_BY_USE(s) && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) && !(s->attributes() & HEAP_BIT)) - st->insertStmtAfter(*DataEnter(new SgVarRefExp(s),ConstRef(0)),*st->controlParent()); - } - s = cur_func->symbol()->next(); - while (IS_BY_USE(s)) - { - if (!is_deleted_module_symbol(s) && IS_ARRAY(s) && !hasSameOriginalName(s) && s->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) ) - st->insertStmtAfter(*DataEnter(new SgVarRefExp(s),ConstRef(0)),*st->controlParent()); - s = s->next(); - } -*/ - SgExpression *el; - symb_list *sl; - for (el = registered_uses_list; el; el = el->rhs()) - { - SgSymbol *sym = el->lhs()->symbol(); - if (IS_ARRAY(sym) && sym->variant() != CONST_NAME && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !(sym->attributes() & HEAP_BIT)) - st->insertStmtAfter(*DataEnter(new SgVarRefExp(sym),ConstRef(0)),*st->controlParent()); - } - for (sl = acc_registered_list; sl; sl = sl->next) - { - if (sl->symb->variant() != CONST_NAME && !IS_ALLOCATABLE(sl->symb) && !IS_POINTER_F90(sl->symb) && !HEADER(sl->symb)) - st->insertStmtAfter(*DataEnter(new SgVarRefExp(sl->symb),ConstRef(0)),*st->controlParent()); - } - for (el = acc_declared_list; el; el = el->rhs()) - { - SgSymbol *sym = el->lhs()->symbol(); - if (!IS_ARRAY(sym) || isInExprList(el->lhs(), registered_uses_list) || isInSymbList(sym, acc_registered_list)) - continue; - - if (sym->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !HEADER(sym) && !(sym->attributes() & HEAP_BIT)) - st->insertStmtAfter(*DataEnter(new SgVarRefExp(sym),ConstRef(0)),*st->controlParent()); - } -} - -void ExitDataRegionForVariablesInMainProgram(SgStatement *st) -{ -/* - symb_list *sl; - SgSymbol *s; - for(sl=registration; sl; sl=sl->next) - { - s = sl->symb; - if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && s->scope() == cur_func && !IS_BY_USE(s) && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) && !(s->attributes() & HEAP_BIT) ) - InsertNewStatementBefore(DataExit(new SgVarRefExp(s),0),st); - } - - s=cur_func->symbol()->next(); - while (IS_BY_USE(s)) - { - if (!is_deleted_module_symbol(s) && IS_ARRAY(s) && !hasSameOriginalName(s) && s->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) ) - InsertNewStatementBefore(DataExit(new SgVarRefExp(s),0),st); - s = s->next(); - } - SgSymbol *s; - SgExpression *el; - for (el = acc_declared_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) && !(s->attributes() & HEAP_BIT)) - InsertNewStatementBefore(DataExit(new SgVarRefExp(s),0),st); - } -*/ - SgExpression *el; - symb_list *sl; - for (el = registered_uses_list; el; el = el->rhs()) - { - SgSymbol *sym = el->lhs()->symbol(); - if (IS_ARRAY(sym) && sym->variant() != CONST_NAME && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !(sym->attributes() & HEAP_BIT)) - InsertNewStatementBefore(DataExit(new SgVarRefExp(sym),0),st); - } - for (sl = acc_registered_list; sl; sl = sl->next) - { - if (sl->symb->variant() != CONST_NAME && !IS_ALLOCATABLE(sl->symb) && !IS_POINTER_F90(sl->symb) && !HEADER(sl->symb)) - InsertNewStatementBefore(DataExit(new SgVarRefExp(sl->symb),0),st); - } - for (el = acc_declared_list; el; el = el->rhs()) - { - SgSymbol *sym = el->lhs()->symbol(); - if (!IS_ARRAY(sym) || isInExprList(el->lhs(), registered_uses_list) || isInSymbList(sym, acc_registered_list)) - continue; - - if (sym->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(sym) && !IS_POINTER_F90(sym) && !HEADER(sym) && !(sym->attributes() & HEAP_BIT)) - InsertNewStatementBefore(DataExit(new SgVarRefExp(sym),0),st); - } -} - -/**********************************************************************************/ - -int isACCdirective(SgStatement *stmt) -{ - switch (stmt->variant()) { - - // case(ACC_DATA_REGION_DIR): - // case(ACC_END_DATA_REGION_DIR): - // case(ACC_REGION_DO_DIR): - // case(ACC_DO_DIR): - // case(ACC_UPDATE_DIR): - - case(ACC_REGION_DIR) : - case(ACC_END_REGION_DIR) : - case(ACC_ACTUAL_DIR) : - case(ACC_GET_ACTUAL_DIR) : - case(ACC_CHECKSECTION_DIR) : - case(ACC_END_CHECKSECTION_DIR) : - return(stmt->variant()); - default: - return(0); - } -} - -SgStatement *ACC_Directive(SgStatement *stmt) -{ - if (!ACC_program) // by option -noH regime - return(stmt); - switch (stmt->variant()) { - case(ACC_REGION_DIR) : - return(ACC_REGION_Directive(stmt)); - - case(ACC_END_REGION_DIR) : - return(ACC_END_REGION_Directive(stmt)); - - - case(ACC_ACTUAL_DIR) : - return(ACC_ACTUAL_Directive(stmt)); - - case(ACC_GET_ACTUAL_DIR) : - return(ACC_GET_ACTUAL_Directive(stmt)); - - case(ACC_CHECKSECTION_DIR) : - if (!IN_COMPUTE_REGION) - err("Misplaced directive", 103, stmt); - in_checksection = 1; - acc_array_list = NULL; - return(stmt); - case(ACC_END_CHECKSECTION_DIR) : - in_checksection = 0; - return(stmt); - default: - return(stmt); - } - -} - -void ACC_DECLARE_Directive(SgStatement *stmt) -{ - if (ACC_program) - acc_declared_list = ExpressionListsUnion(acc_declared_list, &(stmt->expr(0)->copy())); -} - -void ACC_ROUTINE_Directive(SgStatement *stmt) -{ - if(!ACC_program || options.isOn(NO_CUDA) ) - return; - int control_variant = stmt->controlParent()->controlParent()->variant(); - if (control_variant == INTERFACE_STMT || control_variant == INTERFACE_OPERATOR || control_variant == INTERFACE_ASSIGNMENT) - { - stmt->controlParent()->symbol()->addAttribute(ROUTINE_ATTR, (void*)1, 0); - return; - } - else if (control_variant != GLOBAL) - { - err("Misplaced directive",103,stmt); - return; - } - if (!mod_gpu_symb) - CreateGPUModule(); - - SgExpression *targets_spec= NULL, *private_spec = NULL, *el; - - for (el=stmt->expr(0); el; el=el->rhs()) - { - switch (el->lhs()->variant()) - { - case ACC_TARGETS_OP: - if (!targets_spec) - { - targets_spec = el->lhs(); - } else - err("Double TARGETS clause",669,stmt); - break; - case ACC_PRIVATE_OP: - if (!private_spec) - { - private_spec = el->lhs(); - } else - err("Double PRIVATE clause",607,stmt); - break; - } - } - int targets = targets_spec ? TargetsList(targets_spec->lhs()) : dvmh_targets; //stmt->expr(0) ? TargetsList(stmt->expr(0)->lhs()) : dvmh_targets; - targets = targets & dvmh_targets; - SgSymbol *s = stmt->controlParent()->symbol(); - if(!s) - return; - if (targets & CUDA_DEVICE) - { - MarkAsCalled(s); - if (private_spec) - MarkPrivateArgumentsOfRoutine(s, private_spec->lhs()); - } - MarkAsRoutine(s); - - return; -} - -SgStatement *ACC_ACTUAL_Directive(SgStatement *stmt) -{ - SgExpression *e, *el; - SgSymbol *s; - int ilow, ihigh; - - LINE_NUMBER_AFTER(stmt, stmt); - - if (!stmt->expr(0)) - { - doCallAfter(ActualAll()); //inserting after current statement - return(cur_st); - } - - for (el = stmt->expr(0); el; el = el->rhs()) - { - e = el->lhs(); - s = e->symbol(); - if (isSgVarRefExp(e)) - { - doCallAfter(ActualScalar(s)); - continue; - } - if (isSgArrayRefExp(e) && isSgArrayType(s->type())) - { - if (HEADER(s)) //is distributed array reference - { - if (!e->lhs()) //whole array - { - doCallAfter(ActualArray(s)); //inserting after current statement - continue; - } - else - { - ChangeDistArrayRef(e->lhs()); - if(INTERFACE_RTS2) - doCallAfter(ActualSubArray_2(s, Rank(s), SectionBoundsList(e))); - else - { - ilow = ndvm; - ihigh = SectionBounds(e); - doCallAfter(ActualSubArray(s, ilow, ihigh)); //inserting after current statement - } - } - } - else - {//if(isSgArrayType(s->type())) //may be T_STRING - //Warning("%s is not DVM-array",s->identifier(),606,cur_region->region_dir); - //doCallAfter(ActualScalar(s)); - //continue; - if (!e->lhs()) //whole array - doCallAfter(ActualScalar(s)); //inserting after current statement - else - { - ChangeDistArrayRef(e->lhs()); - if(INTERFACE_RTS2) - doCallAfter(ActualSubVariable_2(s, Rank(s), SectionBoundsList(e))); - else - { - ilow = ndvm; - ihigh = SectionBounds(e); - doCallAfter(ActualSubVariable(s, ilow, ihigh)); //inserting after current statement - } - } - } - continue; - } - /* scalar in list is variable name !!! - if(isSgRecordrefExp(e) || e->variant()==ARRAY_OP) //structure component or substring - { Warning ("%s is not DVM-array",e->lhs()->symbol()->identifier(),606,stmt); - doCallAfter(ActualScalar(e->lhs()->symbol())); - continue; - } - */ - err("Illegal element of list",636, stmt); - break; - } - return(cur_st); -} - -SgStatement *ACC_GET_ACTUAL_Directive(SgStatement *stmt) -{ - SgExpression *el, *e; - SgSymbol *s; - int ilow, ihigh; - - LINE_NUMBER_AFTER(stmt, stmt); - - if (!stmt->expr(0)) - { - doCallAfter(GetActualAll()); //inserting after current statement - return(cur_st); - } - for (el = stmt->expr(0); el; el = el->rhs()) - { - e = el->lhs(); - s = e->symbol(); - if (isSgVarRefExp(e)) - { - doCallAfter(GetActualScalar(s)); //inserting after current statement - continue; - } - if (isSgArrayRefExp(e) && isSgArrayType(s->type())) // array reference - { - if (HEADER(s)) //is distributed array reference - - { - if (!e->lhs()) //whole array - doCallAfter(GetActualArray(HeaderRef(s))); //inserting after current statement - else - { - ChangeDistArrayRef(e->lhs()); - if(INTERFACE_RTS2) - doCallAfter(GetActualSubArray_2(s, Rank(s), SectionBoundsList(e))); - else - { - ilow = ndvm; - ihigh = SectionBounds(e); - doCallAfter(GetActualSubArray(s, ilow, ihigh)); //inserting after current statement - } - } - } - else // is not distributed array reference - { - if (!e->lhs()) //whole array - doCallAfter(GetActualScalar(s)); //inserting after current statement - else - { - ChangeDistArrayRef(e->lhs()); - if(INTERFACE_RTS2) - doCallAfter(GetActualSubVariable_2(s, Rank(s), SectionBoundsList(e))); - else - { - ilow = ndvm; - ihigh = SectionBounds(e); - doCallAfter(GetActualSubVariable(s, ilow, ihigh)); //inserting after current statement - } - } - } - continue; - } - err("Illegal element of list",636, stmt); - break; - } - return(cur_st); -} - - -SgStatement *ACC_END_REGION_Directive(SgStatement *stmt) -{ - - dvm_debug = (cur_fragment && cur_fragment->dlevel) ? 1 : 0; //permit dvm-debugging - - if (!cur_region || cur_region->is_data) - { - err("Unmatched directive", 182, stmt); - return(stmt); - } - if (cur_region->region_dir->controlParent() != stmt->controlParent()) - err("Misplaced directive", 103, stmt); //region must be a block - if (in_checksection) - err("Missing END HOSTSECTION directive in region", 571, stmt); - - //!!!printf("END REGION No:%d begin:%d end:%d\n",cur_region->No,cur_region->region_dir->lineNumber(), stmt->lineNumber()); - LINE_NUMBER_AFTER(stmt, stmt); - stmt->lexNext()->addComment(EndRegionComment(cur_region->region_dir->lineNumber())); - DeleteNonDvmArrays(); - InsertNewStatementAfter(EndRegion(cur_region->No), cur_st, stmt->controlParent()); - //cur_st->addComment(EndRegionComment(cur_region->region_dir->lineNumber())); - - SET_DVM(cur_region->No); //SET_GPU(cur_region->No); - region_list *p = cur_region; - cur_region = cur_region->next; - free(p); - return(cur_st); -} - - -SgStatement *ACC_REGION_Directive(SgStatement *stmt) -{ - SgExpression *eop, *el, *tl; - int intent, irgn, user_targets, region_targets; - - // inhibit dvm-debugging inside region ! - dvm_debug = 0; - - // initialization - has_region = 1; - user_targets = 0; - - in_checksection = 0; - - if (inparloop) - err("Misplaced directive", 103, stmt); - if (cur_region && !cur_region->is_data) - err("Nested compute regions are not permitted", 601, stmt); - if(rma) - err("REGION directive within the scope of REMOTE_ACCESS directive", 631, stmt); - irgn = ndvm++; - NewRegion(stmt, irgn, 0); - if(AnalyzeRegion(stmt)==1) // AnalyzeRegion creates uses list for region - { // no END REGION directive - cur_region = cur_region->next; //closing region - dvm_debug = (cur_fragment && cur_fragment->dlevel) ? 1 : 0; //permit dvm-debugging - return(cur_st); - } - //printf("REGION No:%d begin:%d %d\n",cur_region->No,cur_region->region_dir->lineNumber(), stmt->lineNumber()); - LINE_NUMBER_AFTER(stmt, stmt); - //DoHeadersForNonDvmArrays(); - non_dvm_list = NULL; - by_value_list = NULL; - - doAssignTo_After(DVM000(irgn), RegionCreate(0)); //RegionCreate((region_compare ? REGION_COMPARE_DEBUG : 0))); - cur_st->addComment(RegionComment(stmt->lineNumber())); - where = cur_st; - for (el = stmt->expr(0); el; el = el->rhs()) - { - eop = el->lhs(); - if (eop->variant() == ACC_TARGETS_OP) - { - user_targets = TargetsList(eop->lhs()); - /* - for (tl = eop->lhs(); tl; tl = tl->rhs()) - if (tl->lhs()->variant() == ACC_CUDA_OP) - //targets[CUDA] = 1; - user_targets = user_targets | CUDA_DEVICE; - else if (tl->lhs()->variant() == ACC_HOST_OP) - //targets[HOST] = 1; - user_targets = user_targets | HOST_DEVICE; - //targets_on = 1; - */ - continue; - } - if (eop->variant() == ACC_ASYNC_OP) - { - RegionRegimConst(REGION_ASYNC); - err("Clause ASYNC is not implemented yet", 579, stmt); - continue; - } - switch (eop->variant()) - { - case(ACC_INOUT_OP) : intent = INTENT_INOUT; break; - case(ACC_IN_OP) : intent = INTENT_IN; break; - case(ACC_OUT_OP) : intent = INTENT_OUT; break; - case(ACC_LOCAL_OP) : intent = INTENT_LOCAL; break; - case(ACC_INLOCAL_OP) : intent = INTENT_INLOCAL; break; - default: intent = 0; - err("Illegal clause in dvmh-directive", 600, stmt); - continue;//break; - } - RegisterVariablesInRegion(eop->lhs(), intent, irgn); - } - - RegisterUses(irgn); - RegisterDvmArrays(irgn); - - if (user_targets != 0) - { - region_targets = user_targets & dvmh_targets; - if (region_targets == 0) - region_targets = HOST_DEVICE; - if (region_targets != user_targets) - Warning("Demoting targets for region to %s", DevicesString(region_targets), 611, stmt); - if ((cur_region->targets & region_targets) != region_targets) - Error("Impossible to execute region on %s", DevicesString(user_targets), 612, stmt); - cur_region->targets = region_targets; - } - else - { - if (cur_region->targets != dvmh_targets) - Warning("Demoting targets for region to %s", DevicesString(cur_region->targets), 611, stmt); - } - - //if(!targets_on) - // for(i=Ndev-1; i; i--) // set targets by default - // targets[i]=1; - //if(options.isOn(NO_CUDA)) // by option -noCuda - // targets[CUDA] = 0; - - InsertNewStatementAfter(RegionForDevices(irgn, DevicesExpr(cur_region->targets)), cur_st, cur_st->controlParent()); - - //InsertNewStatementAfter(StartRegion(irgn),cur_st,cur_st->controlParent()); /*22.11.12*/ - - - // creating lists of registered variables in procedure - acc_registered_list = SymbolListsUnion(acc_registered_list, acc_array_list); - registered_uses_list = ExpressionListsUnion(registered_uses_list, uses_list); - - return(cur_st); -} - -int TargetsList(SgExpression *tgs) -{ - SgExpression *tl; - int user_targets = 0; - for (tl = tgs; tl; tl = tl->rhs()) - if (tl->lhs()->variant() == ACC_CUDA_OP) - user_targets = user_targets | CUDA_DEVICE; - else if (tl->lhs()->variant() == ACC_HOST_OP) - user_targets = user_targets | HOST_DEVICE; - return (user_targets); -} - -void RegisterVariablesInRegion(SgExpression *evl, int intent, int irgn) -{ - SgExpression *el, *e; - SgSymbol *s; - int ilow, ihigh; - - for (el = evl; el; el = el->rhs()) - { - e = el->lhs(); - s = e->symbol(); - if (e->variant() == CONST_REF || s->attributes() & PARAMETER_BIT) - { - by_value_list = AddNewToSymbList(by_value_list, s); - continue; - } - if (isSgVarRefExp(e)) - { //Warning("%s is not DVM-array",s->identifier(),606,cur_region->region_dir); //!!! - MarkAsRegistered(s); - if (!isInUsesList(s)) - { - by_value_list = AddNewToSymbList(by_value_list, s); - continue; - } - - if (intent == INTENT_IN && (CorrectIntent(e)) == INTENT_IN) - { - by_value_list = AddNewToSymbList(by_value_list, s); - continue; - } - else - { - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterScalar(irgn, IntentConst(intent), s)); - else - { - doCallAfter(RegisterScalar(irgn, IntentConst(intent), s)); - doCallAfter(SetVariableName(irgn, s)); - } - } - continue; - } - if (isSgArrayRefExp(e)) - { - if (isSgArrayType(s->type())) //is array reference or is not string - - { - if (!HEADER(s) && !isIn_acc_array_list(s) && !isInSymbList(s, tie_list)) //reduction array is not included in acc_array_list and not registered - //!!! && !HEADER_OF_REPLICATED(s) is wrong: may be used in previous region as not reduction array - { //doCallAfter(RegisterScalar(irgn,IntentConst(intent),s)); //must be destroyed!!! - //Warning("%s is not DVM-array",s->identifier(),606,cur_region->region_dir); - continue; - } - - MarkAsRegistered(s); - - if (!HEADER(s) && HEADER_OF_REPLICATED(s) && *HEADER_OF_REPLICATED(s) == 0) - HeaderForNonDvmArray(s, cur_region->region_dir); //creating header (HEADER_OF_REPLICATED) for non-dvm array - - if (!e->lhs()) //whole array - { - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterArray(irgn, IntentConst(intent), s)); - else - { - doCallAfter(RegisterArray(irgn, IntentConst(intent), s)); - doCallAfter(SetArrayName(irgn, s)); - } - continue; - } - else - { - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterSubArray(irgn, IntentConst(intent), s, SectionBoundsList(e))); - else - { - ilow = ndvm; - ihigh = SectionBounds(e); - doCallAfter(RegisterSubArray(irgn, IntentConst(intent), s, ilow, ihigh)); - doCallAfter(SetArrayName(irgn, s)); - } - continue; - } - //if( !HEADER(s) ) // deleting created header for RTS - // doAssignStmtAfter(DeleteObject(DVM000(*HEADER_OF_REPLICATED(s)))); - } - else // scalar variable of type character*(n) - { - MarkAsRegistered(s); - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterScalar(irgn, IntentConst(intent), s)); - else - { - doCallAfter(RegisterScalar(irgn, IntentConst(intent), s)); - doCallAfter(SetVariableName(irgn, s)); - } - continue; - } - - } - } -} - -void RegisterUses(int irgn) -{ - SgExpression *el; - - for (el = uses_list; el; el = el->rhs()) - { - if (el->lhs()->variant() == CONST_REF || el->lhs()->symbol()->attributes() & PARAMETER_BIT) // is named constant - { - by_value_list = AddNewToSymbList(by_value_list, el->lhs()->symbol()); - continue; - } - if (*VAR_INTENT(el) == EMPTY) continue; // is registered early by user specification in REGION directive - - if (*VAR_INTENT(el) == INTENT_IN) // this variable doesn't need to be registered - { // inserting call dvmh_get_actual_variable() before dvm000(i) = region_create() - where->insertStmtBefore(*GetActualScalar(el->lhs()->symbol()), *cur_region->region_dir->controlParent()); - by_value_list = AddNewToSymbList(by_value_list, el->lhs()->symbol()); - continue; - } - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterScalar(irgn, IntentConst(*VAR_INTENT(el)), el->lhs()->symbol())); - else - { - doCallAfter(RegisterScalar(irgn, IntentConst(*VAR_INTENT(el)), el->lhs()->symbol())); - doCallAfter(SetVariableName(irgn, el->lhs()->symbol())); - } - - } -} - -void RegisterDvmArrays(int irgn) -{ - symb_list *sl; - - for (sl = acc_array_list; sl; sl = sl->next) - { - // is not registered yet - if ((sl->symb->attributes() & USE_IN_BIT) || (sl->symb->attributes() & USE_OUT_BIT)) - { - if (!HEADER(sl->symb)) - HeaderForNonDvmArray(sl->symb, cur_region->region_dir); //creating header (HEADER_OF_REPLICATED) for non-dvm array - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterArray(irgn, IntentConst(IntentMode(sl->symb)), sl->symb)); - else - { - doCallAfter(RegisterArray(irgn, IntentConst(IntentMode(sl->symb)), sl->symb)); - doCallAfter(SetArrayName(irgn, sl->symb)); - } - } - } - for (sl = parallel_on_list; sl; sl = sl->next) - { - if (sl->symb) - { - if (!HEADER(sl->symb)) - HeaderForNonDvmArray(sl->symb, cur_region->region_dir); //creating header (HEADER_OF_REPLICATED) for non-dvm array in TIE-clause - - if(INTERFACE_RTS2) - doCallAfter(RegionRegisterArray(irgn, IntentConst(EMPTY), sl->symb)); - else - { - doCallAfter(RegisterArray(irgn, IntentConst(EMPTY), sl->symb)); - doCallAfter(SetArrayName(irgn, sl->symb)); - } - } - } -} - -int IntentMode(SgSymbol *s) -{ - int intent = 0; - symb_list *sl; - if ((s->attributes() & USE_IN_BIT) && (s->attributes() & USE_OUT_BIT)) - { - intent = INTENT_INOUT; - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_IN_BIT; - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_OUT_BIT; - } - else if (s->attributes() & USE_IN_BIT) - { - intent = INTENT_IN; - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_IN_BIT; - } - else if (s->attributes() & USE_OUT_BIT) - { - intent = INTENT_INOUT; //14.03.12 OUT=>INOUT - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_OUT_BIT; - } - if ((sl = isInSymbList(s, parallel_on_list))) - sl->symb = NULL; // clear corresponding element of parallel_on_list - - return(intent); -} - -void MarkAsRegistered(SgSymbol *s) -{ - SgExpression *use; - - - if (HEADER(s) || HEADER_OF_REPLICATED(s)) //is distributed array - { - IntentMode(s); //clear INTENT bits - return; - } - if ((use = isInUsesList(s)) != 0) - *VAR_INTENT(use) = EMPTY; //set INTENT attribute value to 0 - return; -} - -int CorrectIntent(SgExpression *e) -{ - SgExpression *el, *eop; - int intent = INTENT_IN; - for (el = cur_region->region_dir->expr(0); el; el = el->rhs()) - { - eop = el->lhs(); - switch (eop->variant()) - { - case(ACC_INOUT_OP) : if (isInExprList(e, eop->lhs())) { - intent = INTENT_INOUT; return(intent); - } - continue; - - case(ACC_OUT_OP) : if (isInExprList(e, eop->lhs())) { - intent = INTENT_OUT; return(intent); - } - continue; - - case(ACC_LOCAL_OP) : if (isInExprList(e, eop->lhs())) { - intent = INTENT_LOCAL; return(intent); - } - continue; - - case(ACC_INLOCAL_OP) : if (isInExprList(e, eop->lhs())) { - intent = INTENT_INLOCAL; return(intent); - } - continue; - - default: continue; - } - } - return(intent); -} - -void doNotForCuda() -{ - cur_region->targets = cur_region->targets & ~CUDA_DEVICE; -} - -int isForCudaRegion() -{ - if (cur_region && cur_region->targets & CUDA_DEVICE) - return(1); - else - return(0); -} - -char * DevicesString(int targets) -{ - char *str = new char[20]; - str[0] = '\0'; - if (targets & HOST_DEVICE) - strcpy(str, "HOST "); - if (targets & CUDA_DEVICE) - strcat(str, "CUDA"); - return(str); -} - -SgExpression *DevicesExpr(int targets) -{ - SgExpression *de = NULL, *e; - if (targets & HOST_DEVICE) - de = new SgVarRefExp(DeviceTypeConst(HOST)); //device_const[HOST]); - if (targets & CUDA_DEVICE) - { - e = new SgVarRefExp(DeviceTypeConst(CUDA)); //device_const[CUDA]); - de = de ? IorFunction(de, e) : e; - } - return(de); -} - -/* -SgExpression *DevicesExpr(int targets[]) -{int i; -SgExpression *de,*e; -for(i=Ndev-1,de=NULL; i; i--) -if (targets[i]) -{ e = new SgVarRefExp(device_const[i]); -de = de ? IorFunction(de,e) : e; -} -return(de); -} -*/ -SgExpression *HandlerExpr() /* OpenMP */ -{ - int i; - SgExpression *de, *e; - if (has_max_minloc) - return(ConstRef(0)); - - for (i = Nhandler - 1, de = NULL; i; i--) - { - e = new SgVarRefExp(HandlerTypeConst(i)); //handler_const[i]); - de = de ? IorFunction(de, e) : e; - } - return(de); -} - -int isIn_acc_array_list(SgSymbol *s) -{ - symb_list *sl; - if (!s) - return (0); - for (sl = acc_array_list; sl; sl = sl->next) - if (sl->symb == s) - return(1); - return(0); -} - -void NewRegion(SgStatement *stmt, int n, int data_flag) -{ - region_list * curreg; - curreg = new region_list; - curreg->is_data = data_flag; - curreg->No = n; - curreg->region_dir = stmt; - curreg->cur_do_dir = NULL; - curreg->Lnums = 0; - curreg->next = cur_region; - curreg->targets = dvmh_targets; - cur_region = curreg; - return; -} - -void FlagStatement(SgStatement *st) -{ - st->addAttribute(STATEMENT_GROUP, (void*)1, 0); -} - -void MarkAsInsertedStatement(SgStatement *st) -{ - st->addAttribute(INSERTED_STATEMENT, (void*)1, 0); -} - -void DeleteNonDvmArrays() -{ - symb_list *sl; - for (sl = non_dvm_list; sl; sl = sl->next) - if (HEADER_OF_REPLICATED(sl->symb)) - { //doCallAfter( DestroyArray(DVM000(*HEADER_OF_REPLICATED(sl->symb)))); - SgExpression *header_ref = DVM000(*HEADER_OF_REPLICATED(sl->symb)); - doCallAfter(INTERFACE_RTS2 ? ForgetHeader(header_ref) : DeleteObject_H(header_ref)); - *HEADER_OF_REPLICATED(sl->symb) = 0; - } -} - -void StoreLowerBoundsOfNonDvmArray(SgSymbol *ar) -// generating assign statements to -//store lower bounds of array in Header(rank+3:2*rank+2) - -{ - int i, rank, ind; - SgExpression *le; - rank = Rank(ar); - ind = *HEADER_OF_REPLICATED(ar); - for (i = 0; i < rank; i++) - { - le = Exprn(LowerBound(ar, i)); - doAssignTo_After(DVM000(ind + rank + 2 + i), le); //header_ref(ar,rank+3+i) - } -} - -SgExpression *HeaderForArrayInParallelDir(SgSymbol *ar, SgStatement *st, int err_flag) -{ - if(HEADER(ar)) - return HeaderRef(ar); - if(st->expr(0) && err_flag) - { - Error("'%s' isn't distributed array", ar->identifier(), 72, st); - return DVM000(0); //for the correct completion - } - if(HEADER_OF_REPLICATED(ar) && *HEADER_OF_REPLICATED(ar) != 0) - return DVM000(*HEADER_OF_REPLICATED(ar)); - if(!HEADER_OF_REPLICATED(ar)) - { - int *id = new int; - *id = 0; - ar->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); - } - *HEADER_OF_REPLICATED(ar) = ndvm; - HeaderForNonDvmArray(ar, st); - return DVM000(*HEADER_OF_REPLICATED(ar)); -} - -int HeaderForNonDvmArray(SgSymbol *s, SgStatement *stat) -{ - int dvm_ind, static_sign, re_sign, rank, i; - SgExpression *size_array; - - // creating list of non-dvm-arrays for deleting after region - if (IN_COMPUTE_REGION) - non_dvm_list = AddNewToSymbList(non_dvm_list, s); - - rank = Rank(s); - dvm_ind = ndvm; //header index - if (IN_COMPUTE_REGION) - *HEADER_OF_REPLICATED(s) = dvm_ind; - ndvm += 2 * rank + DELTA; // extended header - if(INTERFACE_RTS2) - { - doCallAfter(CreateDvmArrayHeader_2(s, DVM000(dvm_ind), rank, doShapeList(s,stat))); - if (TestType_RTS2(s->type()->baseType()) == -1) - Error("Array reference of illegal type in region: %s ", s->identifier(), 583, stat); - return (dvm_ind); - } - //store lower bounds of array in Header(rank+3:2*rank+2) - for (i = 0; i < rank; i++) - doAssignTo_After(DVM000(dvm_ind + rank + 2 + i), Calculate(LowerBound(s, i))); //header_ref(ar,rank+3+i) - - static_sign = 1; // staticSign - size_array = DVM000(ndvm); - re_sign = 0; // created array may not be redistributed - - doCallAfter(CreateDvmArrayHeader(s, DVM000(dvm_ind), size_array, rank, static_sign, re_sign)); - if (TypeIndex(s->type()->baseType()) == -1) - Error("Array reference of illegal type in region: %s ", s->identifier(), 583, stat); - where = cur_st; - doSizeFunctionArray(s, stat); - cur_st = where; - return (dvm_ind); -} - -void DoHeadersForNonDvmArrays() -{ - symb_list *sl; - int dvm_ind, static_sign, re_sign, rank, i; - SgExpression *size_array; - SgStatement *save = cur_st; - non_dvm_list = NULL; - if(!INTERFACE_RTS2) - cur_st = dvm_parallel_dir->lexNext(); - for (sl = acc_array_list; sl; sl = sl->next) - if (!HEADER(sl->symb)) - { - non_dvm_list = AddToSymbList(non_dvm_list, sl->symb); // creating list of non-dvm-arrays for deleting after region - rank = Rank(sl->symb); - dvm_ind = ndvm; //header index - // adding the attribute REPLICATED_ARRAY to non-dvm-array - if (!HEADER_OF_REPLICATED(sl->symb)) - { - int *id = new int; - *id = 0; - sl->symb->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); - } - // adding the attribute DUMMY_ARRAY to non-dvm-array - if (!DUMMY_FOR_ARRAY(sl->symb)) - { - SgSymbol **dummy = new (SgSymbol *); - *dummy = NULL; - sl->symb->addAttribute(DUMMY_ARRAY, (void*)dummy, sizeof(SgSymbol *)); - } - if(*HEADER_OF_REPLICATED(sl->symb) != 0) - continue; - *HEADER_OF_REPLICATED(sl->symb) = dvm_ind; - ndvm += 2 * rank + DELTA; // extended header - if(INTERFACE_RTS2) - { - doCallAfter(CreateDvmArrayHeader_2(sl->symb, DVM000(dvm_ind), rank, doShapeList(sl->symb,dvm_parallel_dir))); - if (TestType_RTS2(sl->symb->type()->baseType()) == -1) - Error("Array reference of illegal type in region: %s ", sl->symb->identifier(), 583, dvm_parallel_dir); - continue; - } - - //store lower bounds of array in Header(rank+3:2*rank+2) - for (i = 0; i < rank; i++) - doAssignTo_After(DVM000(dvm_ind + rank + 2 + i), Calculate(LowerBound(sl->symb, i))); //header_ref(ar,rank+3+i) - - static_sign = 1; // staticSign - size_array = DVM000(ndvm); - re_sign = 0; // aligned array may not be redistributed - - doCallAfter(CreateDvmArrayHeader(sl->symb, DVM000(dvm_ind), size_array, rank, static_sign, re_sign)); - if (TypeIndex(sl->symb->type()->baseType()) == -1) - Error("Array reference of illegal type in parallel loop: %s", sl->symb->identifier(), 583, dvm_parallel_dir); - - where = cur_st; - doSizeFunctionArray(sl->symb, dvm_parallel_dir); - cur_st = where; - } - if(!INTERFACE_RTS2) - cur_st = save; -} - -int AnalyzeRegion(SgStatement *reg_dir) //AnalyzeLoopBody() AnalyzeBlock() -{ - SgStatement *stmt, *save, *begin; - int analysis_err = 0; - uses_list = NULL; - acc_array_list = NULL; - parallel_on_list = NULL; - tie_list = NULL; - save = cur_st; - analyzing = 1; - - for (stmt = reg_dir->lexNext(); stmt; stmt = stmt->lexNext()) - { - cur_st = stmt; - - // does statement belong to statement group of region? - if (stmt->controlParent() == reg_dir->controlParent() && !in_checksection && !inparloop - && stmt->variant() != DVM_PARALLEL_ON_DIR && stmt->variant() != OMP_PARALLEL_DIR - && stmt->variant() != ACC_CHECKSECTION_DIR && stmt->variant() != ACC_END_CHECKSECTION_DIR - && stmt->variant() != ACC_END_REGION_DIR - && stmt->variant() != DVM_INTERVAL_DIR && stmt->variant() != DVM_ENDINTERVAL_DIR - // && stmt->variant() != DVM_ON_DIR && stmt->variant() != DVM_END_ON_DIR - && stmt->variant() != FORMAT_STAT && stmt->variant() != DATA_DECL) - FlagStatement(stmt); // statement belongs to statement group of region - // add attribute STATEMENT_GROUP - - switch (stmt->variant()) - { - // FORMAT_STAT, ENTRY_STAT, DATA_DECL may appear among executable statements - case ENTRY_STAT: //error - case CONTAINS_STMT: //error - case RETURN_STAT: - err("Illegal statement in region", 578, cur_st); - continue; - case STOP_STAT: - warn("STOP statement in region", 578, cur_st); - doNotForCuda(); - case FORMAT_STAT: - case DATA_DECL: - continue; - case CONTROL_END: - if (stmt->controlParent() == cur_func) - { - err("Missing END REGION directive", 603, stmt); - analysis_err = 1; - goto END_ANALYS; - } - else - break; - case ASSIGN_STAT: // Assign statement - RefInExpr(stmt->expr(1), _READ_); - RefInExpr(stmt->expr(0), _WRITE_); - break; - - case POINTER_ASSIGN_STAT: // Pointer assign statement - RefInExpr(stmt->expr(1), _READ_); // ???? _READ_ ???? - RefInExpr(stmt->expr(0), _WRITE_); - break; - - case WHERE_NODE: - RefInExpr(stmt->expr(0), _READ_); - RefInExpr(stmt->expr(1), _WRITE_); - RefInExpr(stmt->expr(2), _READ_); - break; - - case WHERE_BLOCK_STMT: - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - case LOGIF_NODE: // Logical IF - case WHILE_NODE: // DO WHILE (...) - RefInExpr(stmt->expr(0), _READ_); - break; - - case COMGOTO_NODE: // Computed GO TO - RefInExpr(stmt->expr(1), _READ_); - break; - - case PROC_STAT: // CALL - Call(stmt->symbol(), stmt->expr(0)); - break; - - case FOR_NODE: - //!!!stmt->symbol() - RefInExpr(new SgVarRefExp(stmt->symbol()), _WRITE_); - RefInExpr(stmt->expr(0), _READ_); - RefInExpr(stmt->expr(1), _READ_); - break; - - case FORALL_NODE: - case FORALL_STAT: - err("FORALL statement", 7, stmt); - break; - - case ALLOCATE_STMT: - err("Illegal statement in compute region", 578, cur_st); - //err("ALLOCATE/DEALLOCATE statement in parallel loop",588,stmt); - //RefInExpr(stmt->expr(0), _NUL_); - break; - - case DEALLOCATE_STMT: - err("Illegal statement in compute region", 578, cur_st); - //err("ALLOCATE/DEALLOCATE statement in parallel loop",588,stmt); - break; - - case DVM_IO_MODE_DIR: - continue; - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - {SgExpression *ioc[NUM__O]; - control_list_open(stmt->expr(1), ioc); // control_list analysis - /* - if (!io_err && !inparloop) { - err("Illegal elements in control list", 185, stmt); - break; - } - if (ioc[ERR_] && !inparloop){ - err("END= and ERR= specifiers are illegal in FDVM", 186, stmt); - break; - } - */ - //warn("Input/Output statement in region",587,stmt); - RefInControlList_Inquire(ioc, NUM__O); - doNotForCuda(); - break; - } - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - {SgExpression *ioc[NUM__R]; - control_list1(stmt->expr(1), ioc); // control_list analysis - /* - if (!io_err && !inparloop) { - err("Illegal elements in control list", 185, stmt); - break; - } - if ((ioc[END_] || ioc[ERR_]) && !inparloop) - err("END= and ERR= specifiers are not allowed in FDVM", 186, stmt); - */ - //warn("Input/Output statement in region",587,stmt); - RefInControlList(ioc, NUM__R); - doNotForCuda(); - break; - } - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - {SgExpression *ioc[NUM__R]; - - // analizes IO control list and sets on ioc[] - IOcontrol(stmt->expr(1), ioc, stmt->variant()); - /* - if (!io_err && !inparloop){ - err("Illegal elements in control list", 185, stmt); - break; - } - if ((ioc[END_] || ioc[ERR_] || ioc[EOR_]) && !inparloop){ - err("END=, EOR= and ERR= specifiers are illegal in FDVM", 186, stmt); - break; - } - */ - //warn("Input/Output statement in region",587,stmt); - RefInControlList(ioc, NUM__R); - RefInIOList(stmt->expr(0), (stmt->variant() == READ_STAT ? _WRITE_ : _READ_)); - doNotForCuda(); - break; - } - - case DVM_PARALLEL_ON_DIR: - if(!TestParallelWithoutOn(stmt,0) || !TestParallelDirective(stmt,0,0,NULL)) - continue; // directive is ignored - inparloop = 1; - dvm_parallel_dir = stmt; - - ParallelOnList(stmt); // add target array reference to list - TieList(stmt); - par_do = stmt->lexNext(); - while (par_do->variant() != FOR_NODE) - par_do = par_do->lexNext(); - DoPrivateList(stmt); - - red_struct_list = NULL; - CreateStructuresForReductions(DoReductionOperationList(stmt)); - continue; - - case ACC_END_REGION_DIR: //end of compute region - //if(reg_dir->controlParent() == stmt->controlParent()) - goto END_ANALYS; - - case ACC_REGION_DIR: - err("Nested compute regions are not permitted", 601, stmt); - //continue; - goto END_ANALYS; - - case ACC_CHECKSECTION_DIR: - // omitting statements until section end - begin = stmt; - while (stmt && stmt->variant() != ACC_END_CHECKSECTION_DIR && stmt->variant() != ACC_END_REGION_DIR) - { - if (stmt->variant() == ACC_ACTUAL_DIR || stmt->variant() == ASSIGN_STAT || stmt->variant() == DVM_PARALLEL_ON_DIR) - err("llegal statement/directive in the range of host-section", 572, stmt); - stmt = stmt->lexNext(); - } - if (stmt->variant() == ACC_END_CHECKSECTION_DIR) - { - if (begin->controlParent() != stmt->controlParent()) - err("Misplaced directive", 103, stmt); // section must be a block - continue; - } - - err("Missing END HOSTSECTION directive in region", 571, stmt); - if (stmt->variant() != ACC_END_REGION_DIR) - { - stmt = stmt->lexPrev(); - - continue; - } - else - goto END_ANALYS; - - case ACC_END_CHECKSECTION_DIR: - err("Unmatched directive", 182, stmt); - continue; - - case DVM_ON_DIR: - RefInExpr(stmt->expr(0), _READ_); - continue; - case DVM_END_ON_DIR: - continue; - - case ACC_GET_ACTUAL_DIR: - case ACC_ACTUAL_DIR: - - case DVM_ASYNCHRONOUS_DIR: - case DVM_ENDASYNCHRONOUS_DIR: - case DVM_REDUCTION_START_DIR: - case DVM_REDUCTION_WAIT_DIR: - case DVM_SHADOW_GROUP_DIR: - case DVM_SHADOW_START_DIR: - case DVM_SHADOW_WAIT_DIR: - case DVM_REMOTE_ACCESS_DIR: - case DVM_NEW_VALUE_DIR: - case DVM_REALIGN_DIR: - case DVM_REDISTRIBUTE_DIR: - case DVM_ASYNCWAIT_DIR: - case DVM_F90_DIR: - case DVM_CONSISTENT_START_DIR: - case DVM_CONSISTENT_WAIT_DIR: - // case DVM_INTERVAL_DIR: - // case DVM_ENDINTERVAL_DIR: - case DVM_OWN_DIR: - case DVM_DEBUG_DIR: - case DVM_ENDDEBUG_DIR: - case DVM_TRACEON_DIR: - case DVM_TRACEOFF_DIR: - case DVM_BARRIER_DIR: - case DVM_CHECK_DIR: - case DVM_TASK_REGION_DIR: - case DVM_END_TASK_REGION_DIR: - //case DVM_ON_DIR: - //case DVM_END_ON_DIR: - case DVM_MAP_DIR: - case DVM_RESET_DIR: - case DVM_PREFETCH_DIR: - case DVM_PARALLEL_TASK_DIR: - case DVM_LOCALIZE_DIR: - case DVM_SHADOW_ADD_DIR: - err("Illegal DVMH-directive in compute region", 577, stmt); - continue; - default: - break; - } - {SgStatement *end_stmt; - end_stmt = isSgLogIfStmt(stmt->controlParent()) ? stmt->controlParent() : stmt; - - if (inparloop && isParallelLoopEndStmt(end_stmt,par_do)) //end of parallel loop - { - inparloop = 0; dvm_parallel_dir = NULL; private_list = NULL; cur_region->cur_do_dir = NULL; - red_struct_list = NULL; - } - } - - } //end for -END_ANALYS: - cur_st = save; - analyzing = 0; - inparloop = 0; - return(analysis_err); -} - -int WithAcrossClause() -{ - SgExpression *el; - // looking through the specification list - for (el = dvm_parallel_dir->expr(1); el; el = el->rhs()) - { - if (el->lhs()->variant() == ACROSS_OP) - return(1); - } - return(0); -} - -void ACC_ParallelLoopEnd(SgStatement *pardo) -{ - AddRemoteAccessBufferList_ToArrayList(); // add to acc_array_list remote_access buffer array symbols - - if (options.isOn(O_HOST)) //dvm-array references in host handler are not linearised (do not changed) - for_host = 0; - - if (cur_region && cur_region->targets & CUDA_DEVICE) //if(targets[CUDA]) - { - SgStatement* cuda_kernel = NULL; - - if (WithAcrossClause()) - // creating Cuda-handlers and Cuda-kernels for loop with ACROSS clause. - Create_C_Adapter_Function_Across(adapter_symb); - else - { - for (unsigned k = 0; k < countKernels; ++k) - { - loop_body = CopyOfBody.top(); - CopyOfBody.pop(); - - //enabled analysis for each parallel loop for CUDA - if (options.isOn(LOOP_ANALYSIS)) - currentLoop = new Loop(loop_body, options.isOn(OPT_EXP_COMP), options.isOn(GPU_IRR_ACC)); - - std::string new_kernel_symb = kernel_symb->identifier(); - if (rtTypes[k] == rt_INT) - new_kernel_symb += "_int"; - else if (rtTypes[k] == rt_LONG) - new_kernel_symb += "_long"; - else if (rtTypes[k] == rt_LLONG) - new_kernel_symb += "_llong"; - - SgSymbol *kernel_symbol = new SgSymbol(PROCEDURE_NAME, new_kernel_symb.c_str(), *mod_gpu); - if (options.isOn(C_CUDA)) - kernel_symbol->setType(C_VoidType()); - - if (options.isOn(GPU_O1)) //optimization by option -gpuO1 - { - AnalyzeReturnGpuO1 infoGpuO1 = analyzeLoopBody(NON_ACROSS_TYPE); - int InternalPosition = -1; - for (size_t i = 0; i < infoGpuO1.allArrayGroup.size(); ++i) - { - for (size_t k = 0; k < infoGpuO1.allArrayGroup[i].allGroups.size(); ++k) - { - if (infoGpuO1.allArrayGroup[i].allGroups[k].tableNewVars.size() != 0) - { - InternalPosition = infoGpuO1.allArrayGroup[i].allGroups[k].position; - break; - } - } - } - - if (InternalPosition == -1) - { - if (k == 0) - Create_C_Adapter_Function(adapter_symb); //creating Cuda-handler for loop - cuda_kernel = CreateLoopKernel(kernel_symbol, indexTypeInKernel(rtTypes[k])); //creating Cuda-kernel for loop - } - else // don't work yet, because only gpuO1 lvl1 enable - { - if (k == 0) - Create_C_Adapter_Function(adapter_symb, InternalPosition); //creating Cuda-handler for loop with gpuO1 - cuda_kernel = CreateLoopKernel(kernel_symbol, infoGpuO1, indexTypeInKernel(rtTypes[k])); //creating optimal Cuda-kernel for loop with gpuO1 - } - - } - else - { - if (k == 0) - Create_C_Adapter_Function(adapter_symb); //creating Cuda-handler for loop - cuda_kernel = CreateLoopKernel(kernel_symbol, indexTypeInKernel(rtTypes[k])); //creating Cuda-kernel for loop - } - - if (newVars.size() != 0) - { - correctPrivateList(RESTORE); - newVars.clear(); - } - - if (options.isOn(RTC)) - { - acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); - if (options.isOn(C_CUDA)) - ACC_RTC_ConvertCudaKernel(cuda_kernel, kernel_symbol->identifier()); - else - ACC_RTC_AddCalledProcedureComment(kernel_symbol); - - RTC_FKernelArgs.push_back((SgFunctionCallExp *)kernel_st->expr(0)); - } - - if (options.isOn(LOOP_ANALYSIS)) - { - delete currentLoop; - currentLoop = NULL; - } - } - - if (options.isOn(RTC)) - ACC_RTC_CompleteAllParams(); - } - } - - // creating host-handler for loop anyway - if (!WithAcrossClause()) - Create_Host_Loop_Subroutine_Main(hostproc_symb); - else - { - Create_Host_Across_Loop_Subroutine(hostproc_symb); - first_do_par->extractStmt(); - } - - dvm_ar = NULL; - if (cur_region) - cur_region->cur_do_dir = NULL; - - dvm_parallel_dir = NULL; - return; -} - - -void ACC_RenewParLoopHeaderVars(SgStatement *first_do, int nloop) -{ - SgStatement *st; - int i; - SgForStmt *stdo; - SgExpression *el, *e; - SgSymbol *s; - - uses_list = NULL; - acc_array_list = NULL; - // looking through the loop nest - for (st = first_do, i = 0; i < nloop; st = st->lexNext(), i++) - { - stdo = isSgForStmt(st); - if (!stdo) - break; - RefIn_LoopHeaderExpr(stdo->start(), st); - RefIn_LoopHeaderExpr(stdo->end(), st); - RefIn_LoopHeaderExpr(stdo->step(), st); - } - - for (el = uses_list; el; el = el->rhs()) - { - e = el->lhs(); - s = e->symbol(); - - if (isSgVarRefExp(e)) - { - doCallAfter(GetActualScalar(s)); //inserting after current statement - continue; - } - if (isSgArrayRefExp(e)) - { - if (HEADER(s) || HEADER_OF_REPLICATED(s) && *HEADER_OF_REPLICATED(s) != 0) //is distributed array reference - - { - doCallAfter(GetActualArray(HEADER(s) ? HeaderRef(s) : DVM000(*HEADER_OF_REPLICATED(s)))); //inserting after current statement - continue; - } - else - { - doCallAfter(GetActualScalar(s)); //inserting after current statement - continue; - } - } - } - uses_list = NULL; - return; -} -void CorrectUsesList() -{ - SgExpression *el, *e; - symb_list *sl,*slp; - for(el = uses_list, e=NULL; el; el = el->rhs()) - { - if(IS_BY_USE(el->lhs()->symbol())) - { //deleting from list - if(e) - { - e->setRhs(el->rhs()); - el = e; - } - else - uses_list=el->rhs(); - } - else - e = el; - } - acc_array_list_whole = CopySymbList(acc_array_list); //to create full base list - for (sl = acc_array_list,slp = NULL; sl; sl = sl->next) - if(IS_BY_USE(sl->symb)) - if(slp) - { - slp->next = sl->next; - sl = slp; - } - else - acc_array_list = sl->next; - else - slp = sl; -} - - -void ACC_CreateParallelLoop(int ipl, SgStatement *first_do, int nloop, SgStatement *par_dir, SgExpression *clause[], int interface) -{ - int first, last; - SgStatement *dost; - - if(in_checksection) - return; - - ReplaceCaseStatement(first_do); - FormatAndDataStatementExport(par_dir, first_do); - //!printf("loop on gpu %d\n",first_do->lineNumber() ); - dvm_parallel_dir = par_dir; - first_do_par = first_do; - - if (options.isOn(O_HOST)) //dvm-array references in host handler are not linearised (do not changed) - for_host = 1; - - // making structures for reductions - red_struct_list = NULL; - CreateStructuresForReductions(clause[REDUCTION_] ? clause[REDUCTION_]->lhs() : NULL); - - // creating private_list - private_list = clause[PRIVATE_] ? clause[PRIVATE_]->lhs() : NULL; - private_array_arg = 0; - - dost = InnerMostLoop(first_do, nloop); - - // error checking - CompareReductionAndPrivateList(); - TestPrivateList(); - // removing different names of the same variable "by use" - RemovingDifferentNamesOfVar(first_do); - // creating uses_list - assigned_var_list = NULL; - for_shadow_compute = clause[SHADOW_COMPUTE_] ? 1 : 0; // for optimization of shadow_compute - uses_list = UsesList(dost->lexNext(), lastStmtOfDo(dost)); - RefInExpr(IsRedBlack(nloop), _READ_); // add to uses_list variables used in start-expression of redblack loop - if (!options.isOn(C_CUDA)) - UsesInPrivateArrayDeclarations(private_list); // add to uses_list variables used in private array declarations - if(USE_STATEMENTS_ARE_REQUIRED) // || !IN_COMPUTE_REGION) - CorrectUsesList(); - for_shadow_compute = 0; - if (assigned_var_list) - Error("Variables assign to: %s", SymbListString(assigned_var_list), 586, dvm_parallel_dir); - - // creating replicated arrays for non-dvm-arrays outside regions - if (!cur_region) - DoHeadersForNonDvmArrays(); - - if (!mod_gpu_symb) - CreateGPUModule(); - - if (!block_C) - Create_C_extern_block(); - - if (!info_block) - Create_info_block(); - - adapter_symb = AdapterSymbol(first_do); - - // add #define for adapter name - block_C->addComment(DefineComment(adapter_symb->identifier())); - - hostproc_symb = HostProcSymbol(first_do); - - kernel_symb = KernelSymbol(first_do); - - loop_body = CopyBodyLoopForCudaKernel(first_do, nloop); - - // for TRACE in acc_f2c.cpp - number_of_loop_line = first_do->lineNumber(); - - // creating buffers for remote_access references (after creating GPU module) - //if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive - CreateRemoteAccessBuffersUp(); - if (cur_region) - { - // is first loop of compute region - first = (cur_region->Lnums == 0) ? 1 : 0; - (cur_region->Lnums)++; - - // is last loop of compute region - last = (first_do->lastNodeOfStmt()->lexNext()->variant() == ACC_END_REGION_DIR) ? 1 : 0; - //END_REGION directive follows last statement of parallel loop - } - // --------------------------------------------------- - // Generating statements for loop in source program unit - - if (clause[SHADOW_COMPUTE_] && cur_region) // optimization of SHADOW_COMPUTE in REGION - doStatementsForShadowCompute(ipl,interface); // is based on the result of UsesList() - - doStatementsToPerformByHandler(ipl, adapter_symb, hostproc_symb, 1, interface); // registration of hahdlers and performing with them - - return; -} - - -SgStatement *ACC_CreateStatementGroup(SgStatement *first_st) -{ - SgStatement *last_st, *st, *st_end; - last_st = st = st_end = NULL; - SgStatement* cuda_kernel = NULL; - - first_do_par = first_st; - for (st = first_st; IN_STATEMENT_GROUP(st); st = st->lexNext()) - { //printf("begin %d %d\n",st->lineNumber(),st->variant()); - if (st->variant() == LOGIF_NODE) - LogIf_to_IfThen(st); - if (st->variant() == SWITCH_NODE) - ReplaceCaseStatement(st); - if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) - st = lastStmtOfDo(st); - else if (st->variant() == IF_NODE) - st = lastStmtOfIf(st); - else - st = st->lastNodeOfStmt(); - last_st = st; - } - - if (!TestGroupStatement(first_st, last_st)) - return(last_st); - - // creating uses_list - uses_list = UsesList(first_st, last_st); - - if (!mod_gpu_symb) - CreateGPUModule(); - - if (!block_C) - Create_C_extern_block(); - // !!! loop for subgroups of statement group - // (subgroup of statements without dvm-array references, statement with dvm-array references ) - adapter_symb = AdapterSymbol(first_st); - // add #define for adapter name - block_C->addComment(DefineComment(adapter_symb->identifier())); - - hostproc_symb = HostProcSymbol(first_st); - - kernel_symb = KernelSymbol(first_st); - - // --------------------------------------------------- - // Generating statements for block (sequence) in source program unit - cur_st = first_st->lexPrev();//last_st; - //doStatementsInSourceProgramUnit(first_st, 0, NULL, NULL, adapter_symb, hostproc_symb, 0, NULL, NULL, NULL, NULL); - doStatementsToPerformByHandler(CreateLoopForSequence(first_st),adapter_symb, hostproc_symb, 0, parloop_by_handler); - st_end = cur_st; - // --------------------------------------------------- - if ((cur_region->targets & CUDA_DEVICE)) //if(targets[CUDA]) - { - // Generating Kernel - for_kernel = 1; - - for (unsigned k = 0; k < countKernels; ++k) - { - std::string new_kernel_symb = kernel_symb->identifier(); - if (rtTypes[k] == rt_INT) - new_kernel_symb += "_int"; - else if (rtTypes[k] == rt_LONG) - new_kernel_symb += "_long"; - else if (rtTypes[k] == rt_LLONG) - new_kernel_symb += "_llong"; - - SgSymbol *kernel_symbol = new SgSymbol(PROCEDURE_NAME, new_kernel_symb.c_str(), *mod_gpu); - if (options.isOn(C_CUDA)) - kernel_symbol->setType(C_VoidType()); - - cuda_kernel = CreateKernel_ForSequence(kernel_symbol, first_st, last_st, indexTypeInKernel(rtTypes[k])); - - if (newVars.size() != 0) - { - correctPrivateList(RESTORE); - newVars.clear(); - } - - if (options.isOn(RTC)) - { - acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); - if (options.isOn(C_CUDA)) - ACC_RTC_ConvertCudaKernel(cuda_kernel, kernel_symbol->identifier()); - else - ACC_RTC_AddCalledProcedureComment(kernel_symbol); - - RTC_FKernelArgs.push_back((SgFunctionCallExp *)kernel_st->expr(0)); - } - } - - for_kernel = 0; - - // Generating Adapter (handler) Function - Create_C_Adapter_Function_For_Sequence(adapter_symb, first_st); - - if (options.isOn(RTC)) - ACC_RTC_CompleteAllParams(); - } - // Generating host-handler anyway - - Create_Host_Sequence_Subroutine(hostproc_symb, first_st, last_st); - - // return last statement of block - - return(st_end); -} - -int TestGroupStatement(SgStatement *first, SgStatement *last) -{ - SgStatement *st, *end; - int test = 1; - has_io_stmt = 0; - end = last->lexNext(); - for (st = first; st != end; st = st->lexNext()) - if (!TestOneGroupStatement(st)) - test = 0; - return(test); -} - -int TestOneGroupStatement(SgStatement *stmt) -{ - if (isExecutableDVMHdirective(stmt) && stmt->variant() != DVM_ON_DIR && stmt->variant() != DVM_END_ON_DIR) - { - err("Misplaced directive", 103, stmt); - return 0; - } - if (stmt->variant() == DATA_DECL || stmt->variant() == FORMAT_STAT) - { - err("Illegal statement in the range of region", 576, stmt); - return 0; - } - switch (stmt->variant()) { - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - has_io_stmt = 1; - break; - } - return 1; -} - - -void doStatementsForShadowCompute(int ilh, int interface) -{ - symb_list *sl; - - for (sl = acc_array_list; sl; sl = sl->next) - { - if (HEADER(sl->symb)) - { - if (isOutArray(sl->symb)) - doCallAfter(interface==1 ? LoopShadowCompute_H(ilh, HeaderRef(sl->symb)) : LoopShadowCompute_Array(ilh, HeaderRef(sl->symb)) ); - //doCallAfter(interface==1 ? LoopShadowCompute_H(ilh, HeaderRef(sl->symb)) : LoopShadowCompute_Array(ilh, Register_Array_H2(HeaderRef(sl->symb))) ); - MarkAsRegistered(sl->symb); - } - } - return; -} - - -int CreateLoopForSequence(SgStatement *first) -{ - LINE_NUMBER_AFTER(first,cur_st); - cur_st->addComment(SequenceComment(first->lineNumber())); - int il = ndvm; - doAssignStmtAfter(LoopCreate_H(cur_region->No, 0)); - return (il); -} - -void doStatementsToPerformByHandler(int ilh, SgSymbol *adapter_symb, SgSymbol *hostproc_symb,int is_parloop,int interface) -{ SgExpression *arg_list, *base_list, *copy_uses_list, *copy_arg_list, *red_dim_list, *red_bound_list, *private_dim_list=NULL, *private_bound_list=NULL; - int numb=0, numb_r=0, numb_b=0, numb_p_dim=0, numb_p_bound=0; - SgStatement *st_register; - - copy_uses_list = uses_list ? &(uses_list->copy()) : NULL; //!!! - base_list = options.isOn(O_HOST) && inparloop ? AddrArgumentList() : BaseArgumentList(); //before ArrayArgumentList call where: dummy_ar=>ar in acc_array_list - arg_list = is_parloop ? RemoteAccessHeaderList() : NULL; - arg_list = AddListToList(arg_list, ArrayArgumentList()); - copy_arg_list = arg_list ? &(arg_list->copy()) : NULL; - red_dim_list = DimSizeListOfReductionArrays(); - numb_r = ListElemNumber(red_dim_list); - red_bound_list = BoundListOfReductionArrays(); // !!! to change - numb_b = ListElemNumber(red_bound_list); - private_bound_list = BoundListOfPrivateArrays(); - numb_p_bound = ListElemNumber(private_bound_list); - if (options.isOn(C_CUDA)) - { - private_dim_list = DimSizeListOfPrivateArrays(); - numb_p_dim = ListElemNumber(private_dim_list); - } - numb = ListElemNumber(arg_list) + ListElemNumber(uses_list); - -// register CUDA-handler - if (cur_region && (cur_region->targets & CUDA_DEVICE)) //if(targets[CUDA]) - { - - arg_list = AddListToList(arg_list, copy_uses_list); - arg_list = AddListToList(arg_list, red_dim_list); - arg_list = AddListToList(arg_list, private_dim_list); - if(interface == 1) - { - InsertNewStatementAfter(RegisterHandler_H(ilh, DeviceTypeConst(CUDA), ConstRef(0), adapter_symb->next(), 0, numb + numb_r + numb_p_dim), cur_st, cur_st->controlParent()); /* OpenMP */ - AddListToList(cur_st->expr(0), arg_list); - } else - { - SgExpression *efun = HandlerFunc(adapter_symb->next(), numb + numb_r + numb_p_dim, arg_list); - InsertNewStatementAfter(RegisterHandler_H2(ilh, DeviceTypeConst(CUDA), ConstRef(0), efun), cur_st, cur_st->controlParent()); /* OpenMP */ - } - } - //base_list = options.isOn(O_HOST) && inparloop ? addr_list : BaseArgumentList(); - numb = numb + ListElemNumber(base_list); -// register HOST-handler - int iht = ndvm; - doAssignStmtAfter(new SgValueExp(0)); - copy_arg_list = AddListToList(copy_arg_list, base_list); - copy_uses_list = uses_list ? &(uses_list->copy()) : NULL; - copy_arg_list = AddListToList(copy_arg_list, copy_uses_list); - copy_arg_list = AddListToList(copy_arg_list, red_bound_list); - copy_arg_list = AddListToList(copy_arg_list, private_bound_list); - - if(interface == 1) - { - InsertNewStatementAfter(RegisterHandler_H(ilh, DeviceTypeConst(HOST), DVM000(iht), hostproc_symb, 0, numb+numb_b+numb_p_bound), cur_st, cur_st->controlParent()); /* OpenMP */ - AddListToList(cur_st->expr(0), copy_arg_list); - } else - { - SgExpression *efun = HandlerFunc(hostproc_symb, numb+numb_b+numb_p_bound, copy_arg_list); - InsertNewStatementAfter(RegisterHandler_H2(ilh, DeviceTypeConst(HOST), DVM000(iht), efun), cur_st, cur_st->controlParent()); /* OpenMP */ - } - cur_st->addComment(OpenMpComment_HandlerType(iht)); -// perform by handler - InsertNewStatementAfter((interface==1 ? LoopPerform_H(ilh) : LoopPerform_H2(ilh)), cur_st, cur_st->controlParent()); - if (is_parloop) //inparloop - cur_st->setComments("! Loop execution\n"); - else - cur_st->setComments("! Execution\n"); -} - -SgExpression *DimSizeListOfReductionArrays() -{//create dimmesion size list for reduction arrays - reduction_operation_list *rsl; - int idim; - SgExpression *ell, *el, *arg, *arg_list; - - if (!red_list) - return(NULL); - arg_list = NULL; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (rsl->redvar_size == -1) //reduction variable is array with passed dimension's sizes - { - el = NULL; - for (idim = Rank(rsl->redvar); idim; idim--) - { - arg = ArrayDimSize(rsl->redvar, idim); - if (arg && arg->variant() == STAR_RANGE) - //arg = SizeFunction(rsl->redvar,idim); - Error("Assumed-size array: %s", rsl->redvar->identifier(), 162, dvm_parallel_dir); - else - arg = DvmType_Ref(SizeFunctionWithKind(rsl->redvar, idim, len_DvmType)); - ell = new SgExprListExp(*arg); - ell->setRhs(el); - el = ell; - } - arg_list = AddListToList(arg_list, el); - el = NULL; - for (idim = Rank(rsl->redvar); idim; idim--) - { - arg = DvmType_Ref(LBOUNDFunction(rsl->redvar, idim)); - ell = new SgExprListExp(*arg); - ell->setRhs(el); - el = ell; - } - arg_list = AddListToList(arg_list, el); - } - } - - return(arg_list); -} - -SgExpression *DimSizeListOfPrivateArrays() -{ - int i; - SgExpression *pl, *arg_list=NULL; - SgSymbol *s; - if (!private_list) - return(NULL); - for (pl = private_list; pl; pl = pl->rhs()) - { - s = pl->lhs()->symbol(); - if (isSgArrayType(s->type()) && !TestArrayShape(s)) - { - for (i=0; iisInteger()) - return bound; - else - return NULL; -} - -SgExpression *CreateBoundListOfArray(SgSymbol *ar) -{ - SgExpression *sl = NULL; - SgSymbol *low_s, *upper_s, *new_ar; - SgExpression *up_bound, *low_bound; - int i; - if(!isSgArrayType(ar->type())) - return (sl); - for(i=0;inext) - { - if (rl->redvar_size != 0) - bound_list = AddListToList(bound_list, CreateBoundListOfArray(rl->redvar)); - if (rl->locvar) - bound_list = AddListToList(bound_list, CreateBoundListOfArray(rl->locvar)); - } - return bound_list; -} - -SgExpression * BoundListOfPrivateArrays() -{ - SgExpression *pl, *bound_list=NULL; - SgSymbol *s; - for (pl = private_list; pl; pl = pl->rhs()) - { - s = pl->lhs()->symbol(); - if (isSgArrayType(s->type())) - bound_list = AddListToList(bound_list, CreateBoundListOfArray(s)); - } - return bound_list; -} - -void ReplaceCaseStatement(SgStatement *first) -{ - SgStatement *stmt, *last_st; - last_st=lastStmtOf(first); - for(stmt= first; stmt != last_st; stmt=stmt->lexNext()) - { - if(stmt->variant() == CASE_NODE) - //ConstantExpansionInExpr(stmt->expr(0)); - stmt->setExpression(0,*ReplaceParameter(stmt->expr(0))); - } -} - -void FormatAndDataStatementExport(SgStatement *par_dir, SgStatement *first_do) -{ - SgStatement *stmt, *last, *st; - last = lastStmtOfDo(first_do); - last = last->lexNext(); - - for (stmt = first_do; stmt != last;) - { - st = stmt; - stmt = stmt->lexNext(); - if (st->variant() == DATA_DECL || st->variant() == FORMAT_STAT) - { - st->extractStmt(); - par_dir->insertStmtBefore(*st, *par_dir->controlParent()); - } - } - -} - -void CreateStructuresForReductions(SgExpression *red_op_list) -{ - SgExpression *er = NULL, *ev = NULL, *ered = NULL, *loc_var_ref = NULL, *en = NULL, *esize = NULL; - - reduction_operation_list *rl = NULL; - has_max_minloc = 0; - - for (er = red_op_list; er; er = er->rhs()) - { - ered = er->lhs(); // reduction (variant==ARRAY_OP) - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - loc_var_ref = NULL; - - if (isSgExprListExp(ev)) //MAXLOC,MINLOC - { - ev = ev->lhs(); // reduction variable reference - loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference - en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array - loc_el_num = LocElemNumber(en); - has_max_minloc = 1; - } - - if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array - esize = ArrayLengthInElems(ev->symbol(), NULL, 0); - else - esize = NULL; - - - // create reduction structure and add to red_struct_list - { - reduction_operation_list *redstruct = new reduction_operation_list; - - redstruct->redvar = ev->symbol(); - redstruct->locvar = loc_var_ref ? loc_var_ref->symbol() : NULL; - - redstruct->number = loc_var_ref ? loc_el_num : 0; - redstruct->redvar_size = esize ? (esize->isInteger() ? esize->valueInteger() : -1) : 0; - redstruct->array_red_size = redstruct->redvar_size; - - if (Rank(redstruct->redvar) > 1 || redstruct->redvar_size > 16) - redstruct->redvar_size = -1; - if (redstruct->redvar_size == -1) - { - if (loc_var_ref && !analyzing && cur_region->targets & CUDA_DEVICE) - Error("Wrong reduction variable %s", ev->symbol()->identifier(), 151, dvm_parallel_dir); - else if (analyzing) - Warning("Reduction variable %s is array of unknown(large) size", ev->symbol()->identifier(), 597, dvm_parallel_dir); - } - redstruct->next = NULL; - redstruct->dimSize_arg = NULL; - redstruct->lowBound_arg = NULL; - redstruct->red_host = NULL; - redstruct->loc_host = NULL; - if (!red_struct_list) - red_struct_list = rl = redstruct; - else - { - rl->next = redstruct; - rl = redstruct; - } - } - } -} - - -void CompareReductionAndPrivateList() -{ - reduction_operation_list *rsl; - if (!red_struct_list) - return; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (isPrivate(rsl->redvar)) - Error("'%s' in REDUCTION and PRIVATE clause", rsl->redvar->identifier(), 609, dvm_parallel_dir); - if (rsl->locvar && isPrivate(rsl->locvar)) - Error("'%s' in REDUCTION and PRIVATE clause", rsl->locvar->identifier(), 609, dvm_parallel_dir); - } - return; -} - -void TestPrivateList() -{ - SgExpression *el, *el2; - for (el = private_list; el; el = el->rhs()) - { - for (el2 = el->rhs(); el2; el2 = el2->rhs()) - if (ORIGINAL_SYMBOL(el->lhs()->symbol()) == ORIGINAL_SYMBOL(el2->lhs()->symbol())) - Error("'%s' appears twice in PRIVATE clause", el->lhs()->symbol()->identifier(), 610, dvm_parallel_dir); - } - return; -} - -void ReplaceSymbolInExpr(SgExpression *e,SgSymbol *symb) -{ - if(!e) return; - if(isSgVarRefExp(e) || isSgArrayRefExp(e)) - { - if(ORIGINAL_SYMBOL(e->symbol()) == ORIGINAL_SYMBOL(symb) && e->symbol() != symb) - e->setSymbol(symb); - return; - } - ReplaceSymbolInExpr(e->lhs(),symb); - ReplaceSymbolInExpr(e->rhs(),symb); - return; -} - -void ReplaceSymbolInLoop (SgStatement *first, SgSymbol *symb) -{ - SgStatement *last=lastStmtOfDo(first); - SgStatement *stmt; - for( stmt=first; stmt!=last; stmt=stmt->lexNext()) - { - ReplaceSymbolInExpr(stmt->expr(0), symb); - ReplaceSymbolInExpr(stmt->expr(1), symb); - ReplaceSymbolInExpr(stmt->expr(2), symb); - } -} - -void RemovingDifferentNamesOfVar(SgStatement *first) -{ - SgExpression *el; - for (el = private_list; el; el = el->rhs()) - { - if(IS_BY_USE(el->lhs()->symbol())) - ReplaceSymbolInLoop(first,el->lhs()->symbol()); - } - reduction_operation_list *rsl; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (IS_BY_USE(rsl->redvar)) - ReplaceSymbolInLoop(first,rsl->redvar); - if (rsl->locvar && IS_BY_USE(rsl->locvar)) - ReplaceSymbolInLoop(first,rsl->locvar); - } -} - -void ACC_ReductionVarsAreActual() -{ - reduction_operation_list *rl; - - for (rl = red_struct_list; rl; rl = rl->next) - { - if(rl->redvar) - doCallAfter(ActualScalar(rl->redvar)); - if (rl->locvar) - doCallAfter(ActualScalar(rl->locvar)); - } -} - -void CreateRemoteAccessBuffers(SgExpression *rml, int pl_flag) -{ - SgExpression *el; - rem_var *remv; - coeffs *scoef; - int interface = parloop_by_handler == 2 && WhatInterface(dvm_parallel_dir) == 2 ? 2 : 1; - for (el = rml; el; el = el->rhs()) - { - remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); - if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause - remv->buffer = RemoteAccessBufferInKernel(el->lhs()->symbol(), remv->ncolon); - // creating variables used for optimisation buffer references in parallel loop - scoef = new coeffs; - CreateCoeffs(scoef, remv->buffer); - // scoef = BufferCoeffs(remv->buffer,el->lhs()->symbol()); - // adding the attribute (ARRAY_COEF) to buffer symbol - remv->buffer->addAttribute(ARRAY_COEF, (void*)scoef, sizeof(coeffs)); - if (pl_flag && interface == 2) - remv->buffer->addAttribute(REMOTE_ACCESS_BUF, (void*)1, 0); - } - return; -} - -void CreateRemoteAccessBuffersUp() -{ - rem_acc *r; - //looking through the remote-access directive/clause list - for (r=rma; r; r=r->next) - { - //if (r->rml->symbol()) // asynchronous REMOTE_ACCESS clause/directive - // continue; - if (!r->rmout) // REMOTE_ACCESS clause in PARALLEL directive - CreateRemoteAccessBuffers(r->rml, 1); - else - CreateRemoteAccessBuffers(r->rml, 0); - } - return; -} - -SgSymbol *CreateReplicatedArray(SgSymbol *s) -{ - SgSymbol *ar; - - ar = DummyReplicatedArray(s, Rank(s)); - - // renewing attribute DUMMY_ARRAY of symbol s - *DUMMY_FOR_ARRAY(s) = ar; - - return(ar); -} - -/* -void ACC_RegisterDvmBuffer(SgExpression *bufref, int buffer_rank) -{ - SgStatement *call; - int ilow, j; - ilow = ndvm; - for (j = buffer_rank; j; j--) - doAssignStmtAfter(&(*new SgValueExp(-2147483647) - *new SgValueExp(1))); - call = RegisterBufferArray(cur_region->No, IntentConst(INTENT_LOCAL), bufref, ilow, ilow); - cur_st->insertStmtAfter(*call); - cur_st = call; - return; -} -*/ - -void ACC_Before_Loadrb(SgExpression *bufref) -{ - SgStatement *call; - call = RegionBeforeLoadrb(bufref); - cur_st->insertStmtAfter(*call); - cur_st = call; - return; -} - -void ACC_Region_After_Waitrb(SgExpression *bufref) -{ - SgStatement *call; - if (!cur_region) - return; - call = RegionAfterWaitrb(cur_region->No, bufref); - cur_st->insertStmtAfter(*call); - cur_st = call; - return; -} - -void ACC_StoreLowerBoundsOfDvmBuffer(SgSymbol *s, SgExpression *dim[], int dim_num[], int rank, int ibuf, SgStatement *stmt) -// generating assign statements to -//store lower bounds of dvm-array in Header(rank+3:2*rank+2) of remote_access buffer - -{ - int i; - - - if (IS_POINTER(s)) - Error("Fortran 77 dynamic array %s. Obsolescent feature.", s->identifier(), 575, stmt); - - for (i = 0; i < rank; i++) - { - if (dim[i]->variant() == DDOT) // ':' - doAssignTo_After(DVM000(ibuf + rank + 2 + i), header_ref(s, rank + 3 + dim_num[i])); - else // a*I+b depends on do-variable of parallel loop - { - warn("Remote_Access Reference depends on do-variable of parallel loop", 575, stmt); - doAssignTo_After(DVM000(ibuf + rank + 2 + i), BufferLowerBound(dim[i])); - } - } - -} - -SgExpression *BufferLowerBound(SgExpression *ei) -{ - SgSymbol *dovar; - SgExpression *e, *do_start; - dovar = (*IS_DO_VARIABLE_USE(ei))->symbol(); //printf("%s\n",dovar->identifier()); return(new SgValueExp(0)); - do_start = DoStart(dovar); //redblack ??? - e = &(ei->copy()); - e = ReplaceIndexRefByLoopLowerBound(e, dovar, do_start); //e->unparsestdout(); - return(e); -} - -SgExpression *DoStart(SgSymbol *dovar) -{ - SgStatement *st; - SgExpression *estart; - - for (st = par_do; st->variant() == FOR_NODE; st = st->lexNext()) //first_do_par not initialized yet - { - if (st->symbol() == dovar) - { - estart = &((SgForStmt *)st)->start()->copy(); // estart->unparsestdout(); - if (!isSgArrayRefExp(estart)) //redblack - { - warn("Remote_access for redblack", 575, st); - estart = estart->lhs(); - } - return(estart); - } - } - return(DVM000(0)); //may not be -} - -SgExpression *ReplaceIndexRefByLoopLowerBound(SgExpression *e, SgSymbol *dovar, SgExpression *estart) -{ - if (!e) - return(e); - if (isSgVarRefExp(e) && e->symbol() == dovar) - return(&(estart->copy())); - e->setLhs(ReplaceIndexRefByLoopLowerBound(e->lhs(), dovar, estart)); - e->setRhs(ReplaceIndexRefByLoopLowerBound(e->rhs(), dovar, estart)); - return(e); -} - - -void ACC_UnregisterDvmBuffers() -{ - SgExpression *el; - rem_var *remv; - - if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive - for (el = rma->rml; el; el = el->rhs()) - { - remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); - if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause - doCallAfter(RegionDestroyRb(cur_region->No, DVM000(remv->index))); - } -} - -void ACC_ShadowCompute(SgExpression *shadow_compute_list, SgStatement *st_shcmp) -{ - // if(shadow_compute_list) - return; -} - -SgExpression *SectionBoundsList(SgExpression *are) -{ - SgExpression *el, *einit[MAX_DIMS], *elast[MAX_DIMS], *bounds_list=NULL; - SgSymbol *ar = are->symbol(); - int rank = Rank(ar); - int i; - for (el = are->lhs(), i = 0; el; el = el->rhs(), i++) - if(ilhs(), ar, i, einit, elast); - bounds_list = AddElementToList(bounds_list, DvmType_Ref(Calculate(elast[i]))); - bounds_list = AddElementToList(bounds_list, DvmType_Ref(Calculate(einit[i]))); - } - if (i != rank) - Error("Wrong number of subscripts specified for '%s'", ar->identifier(), 140, cur_st); - - return (bounds_list); -} - -int SectionBounds(SgExpression *are) -{ - SgExpression *el, *einit[MAX_DIMS], *elast[MAX_DIMS]; //,*estep[MAX_DIMS]; - SgSymbol *ar; - int init, i, j, rank; - init = ndvm; - ar = are->symbol(); - rank = Rank(ar); - if (!are->lhs()) { // A => A(:,:, ...,:) - for (j = rank; j; j--) - doAssignStmtAfter(&SgUMinusOp(*new SgValueExp(1073741824) * *new SgValueExp(2))); - - return(init); - } - if(!TestMaxDims(are->lhs(),ar,cur_st)) - return (0); - for (el = are->lhs(), i = 0; el; el = el->rhs(), i++) - Doublet(el->lhs(), ar, i, einit, elast); - if (i != rank){ - Error("Wrong number of subscripts specified for '%s'", ar->identifier(), 140, cur_st); - return(0); - } - - for (j = i; j; j--) - doAssignStmtAfter(Calculate(einit[j - 1])); - for (j = i; j; j--) - doAssignStmtAfter(Calculate(elast[j - 1])); - //for(j=i; j; j--) - // doAssignStmtAfter(estep[j-1]); - return(init + rank); -} - -void Doublet(SgExpression *e, SgSymbol *ar, int i, SgExpression *einit[], SgExpression *elast[]) -{ - SgValueExp c1(1), c0(0); - - if (e->variant() != DDOT) { //is not doublet - einit[i] = e; //&(*e-*Exprn(LowerBound(ar,i))); - elast[i] = einit[i]; - - return; - } - // is doublet - - if (!e->lhs()) - einit[i] = &c1.copy(); - else - einit[i] = e->lhs(); //&(*(e->lhs())-*Exprn(LowerBound(ar,i))); - if (!e->rhs()) - elast[i] = Exprn(UpperBound(ar, i)); // &(*Exprn(UpperBound(ar,i))-*Exprn(LowerBound(ar,i))); - else - elast[i] = e->rhs(); //&(*(e->rhs())-*Exprn(LowerBound(ar,i))); - - return; -} - - - -SgExpression *ArrayArgumentList() -{ - symb_list *sl; - SgExpression *el, *ell, *list; - // create dvm-array list for parallel loop - if (!acc_array_list) - return(NULL); - - el = list = NULL; - for (sl = acc_array_list; sl; sl = sl->next) - { - if (HEADER(sl->symb)) - { - ell = new SgExprListExp(*new SgArrayRefExp(*(sl->symb))); - } - else if (HEADER_OF_REPLICATED(sl->symb)) - { - ell = new SgExprListExp(*DVM000(*HEADER_OF_REPLICATED(sl->symb))); - sl->symb = CreateReplicatedArray(sl->symb); - } - else - return(list); //error - if (el) - { - el->setRhs(ell); - el = ell; - } - else - list = el = ell; - - } - return(list); -} - - -SgExpression *RemoteAccessHeaderList() -{ - SgExpression *el, *l, *rma_list; - rem_var *remv; - rem_acc *r; - rma_list = NULL; - for (r=rma; r; r=r->next) - { - for (el = r->rml; el; el = el->rhs()) - { - remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); - if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause - l = new SgExprListExp(*DVM000(remv->index)); - l->setRhs(rma_list); - rma_list = l; - //rma_list = AddListToList(rma_list, l ); - } - } - return(rma_list); -} - -void AddRemoteAccessBufferList_ToArrayList() -{ - SgExpression *el; - rem_var *remv; - rem_acc *r; - //looking through the remote-access directive/clause list - for (r=rma; r; r=r->next) - { - //if (r->rml->symbol()) // asynchronous REMOTE_ACCESS clause/directive - // continue; - for (el = r->rml; el; el = el->rhs()) - { - remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); - if (remv && remv->buffer) - acc_array_list = AddNewToSymbList(acc_array_list, remv->buffer); - } - - } - - return; -} - -SgExpression *AddNewToBaseList(SgExpression *base_list, SgSymbol *symb) -{ - SgExpression *el, *l; - - for (l = base_list; l; l = l->rhs()) - if (baseMemory(symb->type()->baseType()) == l->lhs()->symbol()) //baseMemory(l->lhs()->symbol()->type()->baseType()) ) - break; - if (!l) - { - el = new SgExprListExp(*new SgArrayRefExp(*baseMemory(symb->type()->baseType()))); - el->setRhs(base_list); - base_list = el; - } - return(base_list); -} - -SgExpression *ElementOfBaseList(SgExpression *base_list, SgSymbol *symb) -{ - SgExpression *el = NULL, *l; - - for (l = base_list; l; l = l->rhs()) - if (baseMemory(symb->type()->baseType()) == l->lhs()->symbol()) //baseMemory(l->lhs()->symbol()->type()->baseType()) ) - break; - if (!l) - el = new SgExprListExp(*new SgArrayRefExp(*baseMemory(symb->type()->baseType()))); - - return(el); -} - - -SgExpression *BaseArgumentList() -{ - symb_list *sl, *array_list; - SgExpression *el, *l, *base_list = NULL; - rem_acc *r; - // create memory base list - array_list = NULL; - // create remote_access objects list - for (r=rma; r; r=r->next) - { - for (el = r->rml; el; el = el->rhs()) - array_list = AddToSymbList(array_list, el->lhs()->symbol()); - } - if (array_list) - { - base_list = ElementOfBaseList(NULL, array_list->symb); - for (sl = array_list->next; sl; sl = sl->next) - { - l = ElementOfBaseList(base_list, sl->symb); - if (l) - { - l->setRhs(base_list); - base_list = l; - } - } - } - array_list = USE_STATEMENTS_ARE_REQUIRED ? acc_array_list_whole : acc_array_list; - if (!base_list && array_list) - base_list = ElementOfBaseList(NULL, array_list->symb); - for (sl = array_list; sl; sl = sl->next) - { - l = ElementOfBaseList(base_list, sl->symb); - if (l) - { - l->setRhs(base_list); - base_list = l; - } - } - - return(base_list); - -} - - - -SgExpression *FirstDvmArrayAddress(SgSymbol *ar, int ind) -{ - SgExpression *ae; - ae = ind ? DVM000(ind) : new SgArrayRefExp(*ar, *new SgValueExp(Rank(ar) + 2)); - return (new SgArrayRefExp(*baseMemory(ar->type()->baseType()), *ae)); -} - -SgExpression *ElementOfAddrArgumentList(SgSymbol *s) -{ - SgExpression *ae; - if (HEADER(s)) - ae = new SgArrayRefExp(*s, *new SgValueExp(Rank(s) + 2)); - else if (HEADER_OF_REPLICATED(s)) - ae = DVM000(*HEADER_OF_REPLICATED(s) + Rank(s) + 1); - else - ae = DVM000(1); //error - return(new SgExprListExp(*new SgArrayRefExp(*baseMemory(s->type()->baseType()), *ae))); -} - -SgExpression *AddrArgumentList() -{ - symb_list *sl; - SgExpression *el, *l, *addr_list = NULL, *ae, *rem_list = NULL; - rem_var *remv; - rem_acc *r; - // create array address list - if (acc_array_list) - { - addr_list = el = ElementOfAddrArgumentList(acc_array_list->symb); - - for (sl = acc_array_list->next; sl; sl = sl->next) - { - l = ElementOfAddrArgumentList(sl->symb); - el->setRhs(l); - el = l; - } - } - // create remote_access buffer address list and add it to addr_list - - //looking through the remote-access directive/clause list - for (r=rma; r; r=r->next) - { - for (el = r->rml; el; el = el->rhs()) - { - remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); - if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause - if (IS_REMOTE_ACCESS_BUFFER(remv->buffer) ) - l = new SgExprListExp(*new SgArrayRefExp(*baseMemory(el->lhs()->symbol()->type()->baseType()))); - else - { - ae = DVM000(remv->index + remv->ncolon + 1); - l = new SgExprListExp(*new SgArrayRefExp(*baseMemory(el->lhs()->symbol()->type()->baseType()), *ae)); - } - l->setRhs(rem_list); - rem_list = l; - } - } - addr_list = AddListToList(rem_list, addr_list); - return(addr_list); -} - -SgStatement *DoStmt(SgStatement *first_do, int i) -{ - SgStatement *stmt; - int ind; - for (stmt = first_do, ind = 1; ind < i; ind++) - stmt = stmt->lexNext(); - return(stmt); -} - -void CreateRegionVarList() -{ - SgStatement *reg_dir; - SgExpression *el, *eop; - reg_dir = cur_region->region_dir; - dvm_array_list = NULL; - do_st_list = NULL; - for (el = reg_dir->expr(0); el; el = el->rhs()) - { - eop = el->lhs(); - //dvm_array_list = AddToVarRefList(dvm_array_list,eop->lhs()); - dvm_array_list = AddListToList(dvm_array_list, eop->lhs()); - } -} - - -SgStatement *InnerMostLoop(SgStatement *dost, int nloop) -{ - int i; - SgStatement *stmt; - for (i = nloop - 1, stmt = dost; i; i--) - stmt = stmt->lexNext(); - return(stmt); -} - -void UsesInPrivateArrayDeclarations(SgExpression *privates) -{ - SgExpression *el; - SgArrayType *tp; - for (el=privates; el; el=el->rhs()) - if(el->lhs()->symbol() && (tp=isSgArrayType(el->lhs()->symbol()->type()))) - RefInExpr(tp->getDimList(),_READ_); -} - -SgExpression *UsesList(SgStatement *first, SgStatement *last) //AnalyzeLoopBody() AnalyzeBlock() -{ - SgStatement *stmt, *save; - - uses_list = NULL; - acc_array_list = NULL; - acc_call_list = NULL; - save = cur_st; - - for (stmt = first; stmt != last->lexNext(); stmt = stmt->lexNext()) - { - cur_st = stmt; //!printf("in useslist line %d\n",stmt->lineNumber()); - if (stmt->lineNumber() == 0) //inserted debug statement - continue; - - // FORMAT_STAT, ENTRY_STAT, DATA_DECL may appear among executable statements - switch (stmt->variant()) - { - case ASSIGN_STAT: // Assign statement - RefInExpr(stmt->expr(1), _READ_); - RefInExpr(stmt->expr(0), _WRITE_); - break; - - case POINTER_ASSIGN_STAT: // Pointer assign statement - RefInExpr(stmt->expr(1), _READ_); // ???? _READ_ ???? - RefInExpr(stmt->expr(0), _WRITE_); - break; - - case WHERE_NODE: - RefInExpr(stmt->expr(0), _READ_); - RefInExpr(stmt->expr(1), _WRITE_); - RefInExpr(stmt->expr(2), _READ_); - break; - - case WHERE_BLOCK_STMT: - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - case LOGIF_NODE: // Logical IF - case WHILE_NODE: // DO WHILE (...) - RefInExpr(stmt->expr(0), _READ_); - break; - - case COMGOTO_NODE: // Computed GO TO - RefInExpr(stmt->expr(1), _READ_); - break; - - case PROC_STAT: // CALL - //err("Call statement in parallel loop",589,stmt); - Call(stmt->symbol(), stmt->expr(0)); - break; - - case FOR_NODE: - if (inparloop && !isPrivate(stmt->symbol())) - assigned_var_list = AddNewToSymbListEnd(assigned_var_list, stmt->symbol()); - //Error("Index variable %s should be specified as private",stmt->symbol()->identifier(),585,stmt); - if (!inparloop) - RefInExpr(new SgVarRefExp(stmt->symbol()), _WRITE_); - RefInExpr(stmt->expr(0), _READ_); - RefInExpr(stmt->expr(1), _READ_); - break; - - case FORALL_NODE: - case FORALL_STAT: - //err("FORALL statement",7,stmt); - break; - - case ALLOCATE_STMT: - //err("ALLOCATE/DEALLOCATE statement in region",588,stmt); - //RefInExpr(stmt->expr(0), _NUL_); - break; - - case DEALLOCATE_STMT: - //err("ALLOCATE/DEALLOCATE statement in region",588,stmt); - break; - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - {SgExpression *ioc[NUM__O]; - control_list_open(stmt->expr(1), ioc); // control_list analysis - RefInControlList_Inquire(ioc, NUM__O); - break; - } - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - {SgExpression *ioc[NUM__R]; - control_list1(stmt->expr(1), ioc); // control_list analysis - RefInControlList(ioc, NUM__R); - break; - } - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - {SgExpression *ioc[NUM__R]; - // analyzes IO control list and sets on ioc[] - IOcontrol(stmt->expr(1), ioc, stmt->variant()); - RefInControlList(ioc, NUM__R); - RefInIOList(stmt->expr(0), (stmt->variant() == READ_STAT ? _WRITE_ : _READ_)); - break; - } - default: - break; - } - - - } //end for - cur_st = save; - return(uses_list); -} - -void Add_Use_Module_Attribute() -{ - if(!USE_STATEMENTS_ARE_REQUIRED) - { - int *index = new int; - *index = 0; - first_do_par->addAttribute(MODULE_USE, (void *) index, sizeof(int)); - } -} - -void RefInExpr(SgExpression *e, int mode) -{ - int i; - SgExpression *el, *use; - if (!e) - return; - if (isSgValueExp(e)) - { - if (analyzing) - ConstantSubstitutionInTypeSpec(e); // replace kind parameter if it is a named constant - return; - } - if (!analyzing && inparloop && mode == _WRITE_ && !isSgArrayRefExp(e) && e->symbol() && !isPrivate(e->symbol()) && !isReductionVar(e->symbol()) && e->symbol()->type() && e->symbol()->type()->variant() != T_DERIVED_TYPE) // && !HEADER(e->symbol()) && !IS_CONSISTENT(e->symbol()) - //Error("Assign to %s",e->symbol()->identifier(),586,cur_st); - assigned_var_list = AddNewToSymbListEnd(assigned_var_list, e->symbol()); - - //if(e->variant() == CONST_REF && isInUsesList(e->symbol()) != NULL) - // return; - if (e->variant() == VAR_REF || e->variant() == CONST_REF || e->variant() == ARRAY_REF && e->symbol()->type()->variant() == T_STRING) - { //!printf("refinExpr: var %s\n",e->symbol()->identifier()); - SgType *tp = e->symbol()->type(); - if (tp->variant() == T_DERIVED_TYPE && (IS_BY_USE(tp->symbol()) || IS_BY_USE(e->symbol()))) - Add_Use_Module_Attribute(); - if (inparloop && isParDoIndexVar(e->symbol())) //index of parallel loop - return; - if (inparloop && isPrivate(e->symbol())) - return; - if (inparloop && isReductionVar(e->symbol())) - return; - - if ((use = isInUsesListByChar(e->symbol()->identifier())) != 0) - { //!printf("RefInExpr 2 (is in list) %d\n",VAR_INTENT(use)); - //uses_list ->unparsestdout(); printf("\n"); - *VAR_INTENT(use) = WhatMode(*VAR_INTENT(use), mode); - return; - } - - i = tp->variant(); - - if (inparloop && !analyzing) - if (i == T_DERIVED_TYPE && !IS_BY_USE(tp->symbol()) && !IS_BY_USE(e->symbol()) || (i == T_STRING && TypeSize(tp) != 1)) //|| i==T_COMPLEX || i==T_DCOMPLEX - { - Error("Variable reference %s of illegal type in parallel loop", e->symbol()->identifier(), 583, cur_st); - } - use = new SgExprListExp(*e); - uses_list = AddListToList(uses_list, use); - { - int *id = new int; - *id = WhatMode(mode,mode); - use->addAttribute(INTENT_OF_VAR, (void *)id, sizeof(int)); - } - return; - } - - if (isSgArrayRefExp(e)) - { //!printf("refinExpr: array %s\n",e->symbol()->identifier()); - for (el = e->lhs(), i = 1; el; el = el->rhs(), i++) - RefInExpr(el->lhs(), _READ_); //Index(el->lhs(),use,i); - SgType *tp = e->symbol()->type(); - if (tp->variant()==T_ARRAY && tp->baseType()->variant()==T_DERIVED_TYPE && (IS_BY_USE(tp->baseType()->symbol()) || IS_BY_USE(e->symbol()))) - Add_Use_Module_Attribute(); - - if (HEADER(e->symbol())) //dvm-array - { - if (!analyzing && inparloop && mode != _WRITE_ && isRemAccessRef(e)) - return; - if (inparloop && isPrivate(e->symbol())) - return; - acc_array_list = AddNewToSymbList(acc_array_list, e->symbol()); - if (analyzing || for_shadow_compute) - MarkArraySymbol(e->symbol(), mode); - return; - } - // non-dvm-array - - if (inparloop && isPrivate(e->symbol())) - return; - if (inparloop && isReductionVar(e->symbol())) - return; - - acc_array_list = AddNewToSymbList(acc_array_list, e->symbol()); - - if (analyzing) - { - MarkArraySymbol(e->symbol(), mode); - // adding the attribute REPLICATED_ARRAY to non-dvm-array - if (!HEADER_OF_REPLICATED(e->symbol())) - { - int *id = new int; - *id = 0; - e->symbol()->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); - } - // adding the attribute DUMMY_ARRAY to non-dvm-array - if (!DUMMY_FOR_ARRAY(e->symbol())) - { - SgSymbol **dummy = new (SgSymbol *); - *dummy = NULL; - e->symbol()->addAttribute(DUMMY_ARRAY, (void*)dummy, sizeof(SgSymbol *)); - } - } - return; - } - - if (isSgFunctionCallExp(e)) - { - Call(e->symbol(), e->lhs()); - //err("Function Call in parallel loop",589,cur_st); - return; - } - if (e->variant() == ARRAY_OP) - { - if (inparloop && !analyzing) - Error("Substring reference %s in parallel loop", e->lhs()->symbol()->identifier(), 583, cur_st); - RefInExpr(e->lhs(), mode); - RefInExpr(e->rhs(), _READ_); - return; - } - if (isSgRecordRefExp(e)) - { - SgExpression *estr = LeftMostField(e); - if(analyzing) - doNotForCuda(); - SgExpression *erec = e; - while(isSgRecordRefExp(erec)) - { - RefInExpr(RightMostField(erec)->lhs(),_READ_); - erec = erec->lhs(); - } - RefInExpr(erec->lhs(),_READ_); - SgType *tp = estr->symbol()->type(); - if(isSgArrayType(tp)) - tp = tp->baseType(); - if(IS_BY_USE(tp->symbol()) || IS_BY_USE(estr->symbol())) - { - Warning("Structure component reference %s in parallel loop/region", estr->symbol()->identifier(), 582, cur_st); - Add_Use_Module_Attribute(); - //printf("structure reference:: %s of TYPE %s\n", estr->symbol()->identifier(),estr->symbol()->type()->symbol()->identifier()); - } - else - Error("Structure component reference %s in parallel loop/region", estr->symbol()->identifier(), 582, cur_st); - //StructureRef(e,mode); - RefInExpr(estr,mode); - return; - } - - RefInExpr(e->lhs(), mode); - RefInExpr(e->rhs(), mode); - - return; -} - -void RefIn_LoopHeaderExpr(SgExpression *e, SgStatement *dost) -{ - SgExpression *el, *use; - - if (!e) - return; - if (e->variant() == VAR_REF) - { - if ((use = isInUsesList(e->symbol())) != 0) - return; - - use = new SgExprListExp(*e); - uses_list = AddListToList(uses_list, use); - return; - } - - if (isSgArrayRefExp(e)) - { - for (el = e->lhs(); el; el = el->rhs()) - RefIn_LoopHeaderExpr(el->lhs(), dost); - - if(!(use= isInUsesList(e->symbol()))) - { - use = new SgExprListExp(*new SgArrayRefExp(*e->symbol())); - uses_list = AddListToList(uses_list,use); - } - - // Warning("Array reference %s in parallel loop",e->symbol()->identifier(),584,dost); - - return; - } - - if (e->variant() == ARRAY_OP) - { - Warning("Substring reference %s in parallel loop", e->symbol()->identifier(), 583, dost); - RefIn_LoopHeaderExpr(e->lhs(), dost); - RefIn_LoopHeaderExpr(e->rhs(), dost); - return; - } - if (isSgRecordRefExp(e)) - { - SgSymbol *s = LeftMostField(e)->symbol(); - Warning("Structure component reference %s in parallel loop/region", s->identifier(), 582, dost); - if(!(use= isInUsesList(s))) - { - use = new SgExprListExp(*new SgVarRefExp(*s)); - uses_list = AddListToList(uses_list,use); - } - return; - } - - RefIn_LoopHeaderExpr(e->lhs(), dost); - RefIn_LoopHeaderExpr(e->rhs(), dost); - - return; -} - -void RefInControlList(SgExpression *eoc[], int n) -{ - int i; - if (!eoc[UNIT_]) // PRINT - ; - else if (eoc[UNIT_]->type()->variant() == T_INT) //external file - RefInExpr(eoc[UNIT_], _READ_); - else // internal file = variable of character type - RefInExpr(eoc[UNIT_], _WRITE_); - for (i = 1; i < n; i++) - if (i == IOSTAT_) - RefInExpr(eoc[i], _WRITE_); - else - RefInExpr(eoc[i], _READ_); -} - -void RefInControlList_Inquire(SgExpression *eoc[], int n) -{ - int i; - for (i = 0; i < n; i++) - if (i == U_ || i == ER_ || i == FILE_) - RefInExpr(eoc[i], _READ_); - else - RefInExpr(eoc[i], _WRITE_); -} - -void RefInIOList(SgExpression *iol, int mode) -{ - SgExpression *el, *e; - for (el = iol; el; el = el->rhs()) { - e = el->lhs(); // list item - if (analyzing) - ReplaceFuncCall(e); - if (isSgExprListExp(e)) // implicit loop in output list - e = e->lhs(); - if (isSgIOAccessExp(e)) - RefInImplicitLoop(e, mode); - else - RefInExpr(e, mode); //RefInIOitem(e,mode); - } - -} - -void RefInImplicitLoop(SgExpression *eim, int mode) -{ - SgExpression *ell, *e; - if (isSgExprListExp(eim->lhs())) - for (ell = eim->lhs(); ell; ell = ell->rhs()) //looking through item list of implicit loop - { - e = ell->lhs(); - if (isSgExprListExp(e)) // implicit loop in output list - e = e->lhs(); - if (isSgIOAccessExp(e)) - RefInImplicitLoop(e, mode); - else - RefInExpr(e, mode); - } - else - RefInExpr(eim->lhs(), mode); - - return; -} - -/*void RefInIOitem(SgExpression *e, int mode) -{}*/ - -int WhatMode(int mode, int mode_new) -{ //17.08.16 - if (mode == mode_new && mode == _READ_) - return(mode); - else - return(_READ_WRITE_); - -} - -void MarkArraySymbol(SgSymbol *ar, int mode) -{ - if (mode == _READ_) - SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_IN_BIT; - else if (mode == _WRITE_) - SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_OUT_BIT; - else if (mode == _READ_WRITE_) - { - SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_IN_BIT; - SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_OUT_BIT; - } -} - -int isOutArray(SgSymbol *s) -{ - if (s->attributes() & USE_OUT_BIT) - return(1); - else - return(0); -} - -int isPrivate(SgSymbol *s) -{ - SgExpression *el; - for (el = private_list; el; el = el->rhs()) - { - if (ORIGINAL_SYMBOL(el->lhs()->symbol()) == ORIGINAL_SYMBOL(s)) - return(1); - } - return(0); -} - -int isPrivateInRegion(SgSymbol *s) -{ - if (IN_COMPUTE_REGION && inparloop && isPrivate(s)) - return(1); - else - return(0); -} - -int is_acc_array(SgSymbol *s) -{ - if (HEADER(s) && isIn_acc_array_list(s) || - DUMMY_FOR_ARRAY(s) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(s))) - return 1; - else - return 0; -} - -int isReductionVar(SgSymbol *s) -{ - reduction_operation_list *rl; - for (rl = red_struct_list; rl; rl = rl->next) - { - if(ORIGINAL_SYMBOL(rl->redvar) == ORIGINAL_SYMBOL(s)) - return(1); - if (rl->locvar && ORIGINAL_SYMBOL(rl->locvar) == ORIGINAL_SYMBOL(s)) - return(1); - } - return(0); -} - -SgExpression *isInUsesList(SgSymbol *s) -{ - - SgExpression *el; - for (el = uses_list; el; el = el->rhs()) - { - if (el->lhs()->symbol() == s) - return(el); - } - return(NULL); -} - -SgExpression *isInUsesListByChar(const char *symb) -{ - - SgExpression *el; - for (el = uses_list; el; el = el->rhs()) - { - if (strcmp(el->lhs()->symbol()->identifier(), symb) == 0) - return(el); - } - return(NULL); -} - -int isParDoIndexVar(SgSymbol *s) -{ - SgExpression *vl; - if (!dvm_parallel_dir) - return(0); - for (vl = dvm_parallel_dir->expr(2); vl; vl = vl->rhs()) - { - if (vl->lhs()->symbol() == s) - return(1); - } - return(0); -} - -int isByValue(SgSymbol *s) -{ - return(isInByValueList(s)); -} - -int isInByValueList(SgSymbol *s) -{ - symb_list *sl; - for (sl = by_value_list; sl; sl = sl->next) - { - if (sl->symb == s) - return(1); - } - return(0); -} - -SgExpression *DoReductionOperationList(SgStatement *par) -{ - SgExpression *el; - - // looking through the specification list of PARALLEL directive - for (el = par->expr(1); el; el = el->rhs()) - if (el->lhs()->variant() == REDUCTION_OP) - { - return (el->lhs()->lhs()); - } - return(NULL); -} - -void ParallelOnList(SgStatement *par) -{ - if(par->expr(0)) - parallel_on_list = AddNewToSymbList(parallel_on_list, par->expr(0)->symbol()); -} - -void TieList(SgStatement *par) -{ - SgExpression *el, *es; - for(el=par->expr(1); el; el=el->rhs()) - if(el->lhs()->variant() == ACC_TIE_OP) // TIE specification - { - for(es=el->lhs()->lhs(); es; es=es->rhs()) - { - SgSymbol *s = es->lhs()->symbol(); - if (!HEADER(s) && !HEADER_OF_REPLICATED(s)) - { - int *id = new int; - *id = 0; - s->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); - } - - tie_list = AddNewToSymbList(tie_list, s); - parallel_on_list = AddNewToSymbList(parallel_on_list, s); - } - return; - } -} - -void DoPrivateList(SgStatement *par) -{ - SgExpression *el; - private_list = NULL; - - // looking through the specification list of PARALLEL directive - for (el = par->expr(1); el; el = el->rhs()) - if (el->lhs()->variant() == ACC_PRIVATE_OP) - { - private_list = el->lhs()->lhs(); - break; - } - UsesInPrivateArrayDeclarations(private_list); -} - -void CreatePrivateAndUsesVarList() -{ - SgExpression *el, *eop; - SgStatement *do_dir; - - private_list = NULL; - //uses_list = NULL; - do_dir = cur_region->cur_do_dir; - if (!do_dir) - return; - - for (el = do_dir->expr(0); el; el = el->rhs()) - { - eop = el->lhs(); - if (eop->variant() == ACC_PRIVATE_OP) - { //private_list = AddToVarRefList(private_list,eop->lhs()); - private_list = AddListToList(private_list, eop->lhs()); - continue; - } - /* - if(eop->variant()==ACC_USES_OP) - { //uses_list = AddToVarRefList(uses_list,eop->lhs()); - uses_list = AddListToList(uses_list,eop->lhs()); - continue; - } - */ - } - - /* - // compare two list - for(el=private_list; el; el=el->rhs()) - { - for(el2=uses_list; el2; el2=el2->rhs()) - if(el2->lhs()->symbol() == el->lhs()->symbol() && el2->lhs()->symbol()->variant()==VAR_REF) - Error("%s in USES and PRIVATE clause",el->lhs()->symbol()->identifier(),605,do_dir); - } - */ - return; -} - -SgSymbol *FunctionResultVar(SgStatement *func) -{ - if (func->expr(0)) - return(func->expr(0)->symbol()); - else - return(func->symbol()); -} - - -void Argument(SgExpression *e, int i, SgSymbol *s) -{ - int variant; - if(e->variant() == LABEL_ARG) return; //!!! illegal - if(e->variant() == KEYWORD_ARG) - Argument(e->rhs(), findParameterNumber(ProcedureSymbol(s), NODE_STR(e->lhs()->thellnd)), s); - if (e->variant() == CONST_REF) - { - RefInExpr(e, _READ_); - return; - } - if (isSgVarRefExp(e)) - { - variant = e->symbol()->variant(); /*printf("argument %s\n", e->symbol()->identifier());*/ - if ((variant == FUNCTION_NAME && e->symbol() != FunctionResultVar(cur_func)) || variant == PROCEDURE_NAME || variant == ROUTINE_NAME) - return; - RefInExpr(e, isInParameter(ProcedureSymbol(s),i) ? _READ_ : _READ_WRITE_); - return; - } - else if (isSgArrayRefExp(e)) - { - if (analyzing && e->lhs() && isSgArrayType(e->type())) // case of array section - { - Warning("Array section of %s in a region", e->symbol()->identifier(), 667, cur_st); - doNotForCuda(); - } - if (!analyzing && isPrivate(e->symbol()) && isArrayParameter(ProcedureSymbol(s),i)) - { // scheme with PrivateArray Class - private_array_arg++; // += isArrayParameter(ProcedureSymbol(s),i); - if (!FromOtherFile(s)) - addArgumentNumber(i, s); - } - RefInExpr(e, _READ_WRITE_); - return; - } - else if (e->variant() == ARRAY_OP) - { - RefInExpr(e->lhs(), _READ_WRITE_); - RefInExpr(e->rhs(), _READ_); - return; - } - else - { - RefInExpr(e, _READ_); - return; - } -} - -void Call(SgSymbol *s, SgExpression *e) -{ - SgExpression *el; - int i; - - if (DECL(s) == 2) //is statement function - { - RefInExpr(e, _READ_); - if (inparloop && analyzing) - Error("Call of statement function %s in parallel loop", s->identifier(), 581, cur_st); - - if (IN_STATEMENT_GROUP(cur_st) && analyzing) - Error("Call of statement function %s in region", s->identifier(), 581, cur_st); - return; - } - if (IsInternalProcedure(s) && analyzing) - Error(" Call of the procedure %s in a region, which is internal/module procedure", s->identifier(), 580, cur_st); - - if (!isUserFunction(s) && (s->attributes() & INTRINSIC_BIT || isIntrinsicFunctionName(s->identifier()))) //IsNoBodyProcedure(s) - { - RefInExpr(e, _READ_); - return; - } - - if (analyzing) - { - if ((!IsPureProcedure(s) && (s->variant() != FUNCTION_NAME || !options.isOn(NO_PURE_FUNC))) || IS_BY_USE(s)) - { - Warning(" Call of the procedure %s in a region, which is not pure. Module procedure call is illegal. Intrinsic procedure should be specified by INTRINSIC statement.", s->identifier(), 580, cur_st); - doNotForCuda(); - } - } - else - { - if (IN_COMPUTE_REGION && isForCudaRegion() && (IsPureProcedure(s) || (s->variant() == FUNCTION_NAME && options.isOn(NO_PURE_FUNC)) )) //pure procedure call from the region witch is preparing for CUDA-device - MarkAsCalled(s); - acc_call_list = AddNewToSymbList(acc_call_list, s); - } - - if (!e) //argument list is absent - return; - in_arg_list++; - for (el = e, i = 0; el; el = el->rhs(), i++) - Argument(el->lhs(), i, s); - in_arg_list--; - - return; -} - -SgExpression * AddListToList(SgExpression *list, SgExpression *el) -{ - SgExpression *l; - - //adding the expression list 'el' to the expression list 'list' - - if (!list) { - list = el; - - } - else { - for (l = list; l->rhs(); l = l->rhs()) - ; - l->setRhs(el); - } - return(list); -} - - -SgExpression * ExpressionListsUnion(SgExpression *list, SgExpression *alist) -{ - SgExpression *l, *el, *first; - - //adding the expression list 'alist' to the expression list 'list' without repeating - - if (!list) - return(alist); - - first = list; - - for (el = alist; el;) - if (isInExprList(el->lhs(), first)) - el = el->rhs(); - else - { - l = el; - el = el->rhs(); - l->setRhs(list); - list = l; - //AddListToList(list,l); - } - - return(list); -} - -SgExpression *isInExprList(SgExpression *e, SgExpression *list) -{ - SgExpression *el; - SgSymbol *s; - s = e->symbol(); - if (!s) - return(NULL); - for (el = list; el; el = el->rhs()) - { - if (el->lhs() && el->lhs()->symbol() == s) - return(el); - } - return(NULL); - -} - - -symb_list *SymbolListsUnion(symb_list *slist1, symb_list *slist2) -{ - symb_list *l, *sl, *first; - - //adding the symbol list 'slist2' to the symbol list 'slist1' without repeating - - if (!slist1) - return(slist2); - - first = slist1; - - for (sl = slist2; sl;) - if (isInSymbList(sl->symb, first) != NULL) - sl = sl->next; - else - { - l = sl; - sl = sl->next; - l->next = slist1; - slist1 = l; - - } - - return(slist1); -} - -symb_list *isInSymbList(SgSymbol *s, symb_list *slist) -{ - symb_list *sl; - for (sl = slist; sl; sl = sl->next) - if (sl->symb == s) - return(sl); - return(NULL); -} - -symb_list *isInSymbListByChar(SgSymbol *s, symb_list *slist) -{ - symb_list *sl; - for (sl = slist; sl; sl = sl->next) - if (!strcmp(sl->symb->identifier(), s->identifier())) - return(sl); - return(NULL); -} - -int ListElemNumber(SgExpression *list) -{ - SgExpression *l; - int n = 0; - if (!list) return(0); - for (l = list; l; l = l->rhs()) - n = n + 1; - return(n); -} - -SgExpression * AddToVarRefList(SgExpression *list, SgExpression *list2) -{ - SgExpression *l, *el; - - //adding the expression 'el' to the expression list 'list' - for (el = list2; el; el = el->rhs()) - if (!list) { - list = el; - el->setRhs(NULL); - } - else { - for (l = list; l; l = l->rhs()) - { - if (l->lhs()->symbol() == el->lhs()->symbol() && el->lhs()->variant() == VAR_REF) - continue; - } - el->setRhs(list); - list = el; - } - return(list); -} - - -void AddToRedVarList(SgExpression *ev, int i) -{ - SgExpression *el, *el1; - el1 = new SgExprListExp(*ev); - //el2 = new SgExprListExp(*new SgArrayRefExp(*red_offset_symb,*new SgValueExp(i))); - if (!red_var_list) - { - red_var_list = el1; - //el1 -> setRhs(el2); - return; - } - el = red_var_list; - while (el->rhs()) - el = el->rhs(); - el->setRhs(el1); - //el1 -> setRhs(el2); - return; -} - - -SgExpression *CreateActualLocationList(SgSymbol *locvar, int numb) -{ - SgExprListExp *sl, *sll; - int i; - if (!locvar) return(NULL); - - sl = NULL; - for (i = numb; i; i--) - { - sll = new SgExprListExp(*new SgArrayRefExp(*locvar, *LocVarIndex(locvar, i))); - sll->setRhs(sl); - sl = sll; - } - return(sl); -} - -/* -SgExpression *CreateRedOffsetVarList() -{ SgExpression *el,*newl,*ell; -SgSymbol *s,*soff; -reduction_operation_list *rsl; -//char *name; -formal_red_offset_list = newl= NULL; -//for(el=red_var_list;el;el=el->rhs()) -for(rsl=red_struct_list;rsl;rsl=rsl->next) -{ //s =el->lhs()->symbol(); -s = rsl->redvar; -soff = RedOffsetSymbolInKernel(s); -ell = new SgExprListExp(*new SgVarRefExp(*soff)); -if(!formal_red_offset_list) -formal_red_offset_list = newl = ell; -else -{ newl->setRhs(ell); -newl = ell; -} -if(rsl->locvar) -{ soff = RedOffsetSymbolInKernel(rsl->locvar); -ell = new SgExprListExp(*new SgVarRefExp(*soff)); -newl->setRhs(ell); -newl = ell; -} -} -return(formal_red_offset_list); -} -*/ -/* -void AddFormalArg_For_LocArrays() -{ SgExpression *el; -reduction_operation_list *rsl; - -el = formal_red_offset_list; -if(!el) return; - -while(el->rhs()) -el=el->rhs(); - -//el - last element of formal_red_offset_list - -for(rsl=red_struct_list;rsl;rsl=rsl->next) -{ -if(rsl->locvar) -{ -el->setRhs(rsl->formal_arg); -while(el->rhs()) -el=el->rhs(); -} -} -} -*/ -/* -void AddActualArg_For_LocArrays() -{ //add to red_var_list (to end of argument list) -SgExpression *el; -reduction_operation_list *rsl; - -el = red_var_list; -if(!el) return; - -while(el->rhs()) -el=el->rhs(); - -//el - last element of red_var_list - -for(rsl=red_struct_list;rsl;rsl=rsl->next) -{ -if(rsl->locvar) -{ -el->setRhs(rsl->actual_arg); -while(el->rhs()) -el=el->rhs(); -} -} -} -*/ -/* -SgExpression *FindUsesInFormalArgumentList() -{ SgExpression *el,*cl; -cl = kernel_st->expr(0); -//cl->unparsestdout(); printf("COPY END\n"); -for(el=argument_list,cl = kernel_st->expr(0); el!=uses_list && el!=red_var_list; el=el->rhs(),cl = cl->rhs()) -; - -return(cl); -} -*/ - -SgType *IndexType() -{ - return(SgTypeInt()); //!!!!! -} - -int KindOfIndexType() -{ - return(4); //!!!!! -} - -SgType *CudaIndexType() -{ - SgType *type; - if (undefined_Tcuda) - return(FortranDvmType()); - - type = new SgType(T_INT); - TYPE_KIND_LEN(type->thetype) = (new SgExpression(KIND_OP, new SgValueExp(4), NULL, NULL))->thellnd; - return(type); //!!!!! -} - -SgType *CudaOffsetType() -{ - SgType *type; - if (!undefined_Tcuda) - return(FortranDvmType()); - - type = new SgType(T_INT); - TYPE_KIND_LEN(type->thetype) = (new SgExpression(KIND_OP, new SgValueExp(4), NULL, NULL))->thellnd; - return(type); //!!!!! -} - -int KindOfCudaIndexType() -{ - return(4); //!!!!! -} - -SgStatement *CopyBlockToKernel(SgStatement *first_st, SgStatement *last_st) -{ - SgStatement *st, *st_end, *last, *st_copy; - int no; - st_end = kernel_st->lastNodeOfStmt(); - for (st = first_st; IN_STATEMENT_GROUP(st); st = st->lexNext()) - { - if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) - { - last = LastStatementOfDoNest(st); - if (last != (st->lastNodeOfStmt()) || last->variant() == LOGIF_NODE) - { - last = ReplaceBy_DO_ENDDO(st, last); //ReplaceLabelOfDoStmt(st,last, GetLabel()); - //ReplaceDoNestLabel_Above(last,first_do,GetLabel()); - } - } - st_copy = st->copyPtr(); - - st_end->insertStmtBefore(*st_copy, *kernel_st); - //replace label identification (it's not correct!!!) - if (st->hasLabel()) - { - no = LABEL_STMTNO(st->label()->thelabel); - LABEL_STMTNO(st_copy->label()->thelabel) = no; - } - if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) - st = lastStmtOfDo(st); //last_st - // else if(st->variant() == IF_NODE && st->lastNodeOfStmt()->variant()==ELSEIF_NODE) - - else - st = st->lastNodeOfStmt(); - - } - if (options.isOn(C_CUDA)) - kernel_st->lexNext()->addComment("// Sequence of statements\n"); - else - kernel_st->lexNext()->addComment("! Sequence of statements\n"); - - return(kernel_st->lexNext()); -} - - -void TransferBlockToHostSubroutine(SgStatement *first_st, SgStatement *last_st, SgStatement *st_end) -{ - first_st->addComment("! Sequence of statements\n"); - TransferStatementGroup(first_st,last_st,st_end); - TranslateFromTo(first_st,st_end,1); -} - -/* -void LookTroughTheStatementOfSequenceForDvmAssign(SgStatement *st,SgStatement *stend) -{ SgStatement *stmt; - -for(stmt=st; stmt!=stend; stmt=stmt->lexNext()) -if( st->variant()==ASSIGN_STAT && isDistObject(st->expr(0)) ) -{ if( !isSgArrayType(st->expr(0)->type())){ //array element -ReplaceByIfWithTestFunction(TranslateBlock (st)); -} else - -} -*/ - -void TestDvmObjectAssign(SgStatement *st) -{ - if (isDistObject(st->expr(0))) - { - if (!isSgArrayType(st->expr(0)->type())) //array element - ReplaceAssignByIfForRegion(st); - else //array section or whole array - err("Illegal statement in the range of region ", 576, st); - } -} - -void ReplaceAssignByIfForRegion(SgStatement *stmt) -{ - ReplaceContext(stmt); - - - ReplaceAssignByIf(stmt); - -} - -SgStatement *CopyBodyLoopForCudaKernel(SgStatement *first_do, int nloop) -{ - int ndo; - SgStatement *st, *copy_st; - //!printf("loop rank = %d\n",nloop); - for (st = first_do, ndo = 0; ndo < nloop; st = ((SgForStmt *)st)->body()) - ndo++; - if (dvm_debug) - while (st->lineNumber() == 0) //inserted debug statement - st = st->lexNext(); - //if(nloop>3) - //err("Not implemented yet.Rank of loop is greater than 3.",599,first_do); - //!printf("in copy body\n"); - copy_st = st->copyBlockPtr(SAVE_LABEL_ID); //&(st->copy()); - - //create loop body copies - unsigned stackSize = CopyOfBody.size(); - for (size_t i = 0; i < stackSize; ++i) - CopyOfBody.pop(); - for (int i = 0; i < countKernels * nloop; ++i) - CopyOfBody.push(st->copyBlockPtr(SAVE_LABEL_ID)); - - return(copy_st); -} - -/*!!! -SgStatement *CopyBodyLoopToKernel(SgStatement *first_do) -{ SgExpression *vl,*dovar,*erb; -int nloop, ndo; -SgStatement *st,*copy_st,*stend,*last, *stk, *for_st; -SgSymbol *sind; -SgForStmt *stdo; - -// looking through the do_variables list -vl = dvm_parallel_dir->expr(2); // do_variables list -for(dovar=vl,nloop=0; dovar; dovar=dovar->rhs()) -nloop++; -//!!!printf("nloop:%d\n",nloop); -// looking through the loop nest -erb=NULL; -for(st=first_do,ndo=0; ndobody()) -{ //!!!printf("line number: %d, %d\n",st->lineNumber(),((SgForStmt *)st)->body()->lineNumber()); -if(((SgForStmt *)st)->start()->variant()==ADD_OP) //redblack scheme -{ erb = ((SgForStmt *)st)->start()->rhs(); // MOD function call -erb = &(erb->lhs()->lhs()->copy()); //first argument of MOD function call -erb-> setLhs(new SgVarRefExp(st->symbol())); -for_st = st; -} -ndo++; -} -//!!!printf("line number of st: %d, %d\n",st->lineNumber(), st); -if(nloop>3) -err("Not implemented yet.Rank of loop is greater 3.",599,first_do); - - -// copy_st = &first_do->copy(); -// cur_in_kernel->insertStmtAfter(*copy_st); - -// for(st=copy_st,ndo=0; ndolexNext()) -// ndo++; - -// while(ndo--) -// { //sind = st->symbol(); -// last = st->lastNodeOfStmt(); -// if(last->variant()!=CONTROL_END) -// continue; -// {InsertNewStatementAfter(new SgStatement(CONTROL_END),last,st); -// last= -// st-> setVariant(IF_NODE); -// st->setExpression(0,*KernelCondition(st->symbol(),ndo)); -// BIF_LL2(st->thebif) = NULL; -// BIF_LL3(st->thebif) = NULL; -// st=st->controlParent(); -// } - - -copy_st=st->copyBlockPtr(); //&(st->copy()); -if(erb) -{ st = new SgIfStmt(*ConditionForRedBlack(erb),*copy_st); -copy_st = st; -} - -last = cur_in_kernel->lexNext(); -cur_in_kernel->insertStmtAfter(*copy_st, *cur_in_kernel); -copy_st->addComment("! Loop body\n"); -stk = erb ? last->lexPrev()->lexPrev(): last->lexPrev(); -if(stk->variant()==CONTROL_END ) -if(stk->hasLabel()) -stk->setVariant(CONT_STAT); -else -stk->extractStmt(); - - -//last = cur_in_kernel->controlParent()->lastNodeOfStmt(); -//last = copy_st->lastNodeOfStmt(); -// last = last->lexPrev(); -// if(last->variant()==CONTROL_END && last->controlParent()==cur_in_kernel->controlParent()) -// last->extractStmt(); -//copy_st->extractStmt(); - -return(last); -} -*/ - - -/* -SgExpression *TypeSizeCExpr(SgType *type) -{ int size; -size = TypeSize(type); -// if integer,real,doublepresision, but no complex,bool -return(& SgSizeOfOp(*new SgTypeRefExp(*type))); -} -*/ - -char *ParallelLoopComment(int line) -{ - char *cmnt = new char[35]; - sprintf(cmnt, "! Parallel loop (line %d)\n", line); - return(cmnt); -} - -char *OpenMpComment_InitFlags(int idvm) -{ - char *cmnt = new char[80]; - sprintf(cmnt, "!$ %s = %s \n", UnparseExpr(DVM000(idvm)), UnparseExpr(&(*DVM000(idvm) + *new SgValueExp(8)))); - return(cmnt); -} - -char *OpenMpComment_HandlerType(int idvm) -{ - char *cmnt = new char[80]; - sprintf(cmnt, "!$ %s = %s \n", UnparseExpr(DVM000(idvm)), UnparseExpr(HandlerExpr())); - return(cmnt); -} - -char *SequenceComment(int line) -{ - char *cmnt = new char[60]; - sprintf(cmnt, "! Sequence of statements (line %d)\n", line); - return(cmnt); -} - -char *RegionComment(int line) -{ - char *cmnt = new char[35]; - sprintf(cmnt, "! Start region (line %d)\n", line); - return(cmnt); -} - -char *EndRegionComment(int line) -{ - char *cmnt = new char[35]; - sprintf(cmnt, "! Region end (line %d)\n", line); - return(cmnt); -} - -char *Host_LoopHandlerComment() -{ - char *cmnt = new char[100]; - sprintf(cmnt, "! Host handler for loop on line %d \n\n", first_do_par->lineNumber()); - return(cmnt); -} - -char *Host_SequenceHandlerComment(int lineno) -{ - char *cmnt = new char[120]; - sprintf(cmnt, "! Host handler for sequence of statements on line %d \n\n", lineno); - return(cmnt); -} - -char *Indirect_ProcedureComment(int lineno) -{ - char *cmnt = new char[130]; - sprintf(cmnt, "! Indirect distribution: procedures for statement on line %d \n\n", lineno); - return(cmnt); -} - -char *CommentLine(const char *txt) -{ - char *cmnt; - cmnt = (char *)malloc((unsigned)(strlen(txt) + 5)); - if (options.isOn(C_CUDA)) - sprintf(cmnt, "// %s", txt); - else - sprintf(cmnt, "! %s\n", txt); - - return(cmnt); -} - -char *IncludeComment(const char *txt) -{ - char *cmnt; - cmnt = (char *)malloc((unsigned)(strlen(txt) + 12)); - sprintf(cmnt, "#include %s\n", txt); - return(cmnt); -} - -char *DefineComment(char *txt) -{ - char *cmnt; - cmnt = (char *)malloc((unsigned)(2 * strlen(txt) + 12)); - sprintf(cmnt, "#define %s %s", txt, txt); - cmnt[2 * strlen(txt) + 8] = '\n'; - cmnt[2 * strlen(txt) + 9] = '\0'; - return(cmnt); -} - -const char *CudaIndexTypeComment() -{ - const char *cmnt = NULL; - - cmnt = "typedef int __indexTypeInt; \n" - "typedef long long __indexTypeLLong;\n"; - - return cmnt; -} - -char *CalledProcedureComment(const char *txt, SgSymbol *symb) -{ - char *cmnt = new char[strlen(txt) + strlen(symb->identifier()) + 20]; - char *tmp = aks_strlowr(txt); - sprintf(cmnt, "//DVMH_CALLS %s:%s\n", symb->identifier(), tmp); - delete []tmp; - return(cmnt); -} - - -SgExpression *ThreadsGridSize(SgSymbol *s_threads) -{ - SgExpression *tgs; - tgs = &((*new SgRecordRefExp(*s_threads, "x")) * (*new SgRecordRefExp(*s_threads, "y")) * (*new SgRecordRefExp(*s_threads, "z"))); - return(tgs); -} - -SgSymbol *isSymbolWithSameNameInTable(SgSymbol *first_in, char *name) -{ - SgSymbol *s; - for (s = first_in; s; s = s->next()) - { - if (!strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -/***************************************************************************************/ -/* Unparsing To .cuf and .cu File */ -/***************************************************************************************/ - -void UnparseTo_CufAndCu_Files(SgFile *f, FILE *fout_cuf, FILE *fout_C_cu, FILE *fout_info) /*ACC*/ -{ - SgStatement *stat, *stmt; - - if (!mod_gpu) return; - - if (!GeneratedForCuda()) //if(options.isOn(NO_CUDA) || !kernel_st) - { - if (info_block) - info_block->extractStmt(); - if (block_C_Cuda) - block_C_Cuda->extractStmt(); - mod_gpu->extractStmt(); - if(block_C) - block_C->extractStmt(); - return; - } - - if (options.isOn(C_CUDA)) - { - // unparsing info_block to fout_info - if (info_block) - { - fprintf(fout_info, "%s", UnparseBif_Char(info_block->thebif, C_LANG)); - info_block->extractStmt(); - } - // unparsing C-Cuda block to fout_C_cu - //block_C_Cuda->setVariant(EXTERN_C_STAT); //10.12.13 - if ( block_C_Cuda) - { - fprintf(fout_C_cu, "%s", UnparseBif_Char(block_C_Cuda->thebif, C_LANG)); - block_C_Cuda->extractStmt(); - } - // unparsing Module of C-Cuda-kernels to fout_C_cu - //mod_gpu ->setVariant(EXTERN_C_STAT); //10.12.13//26.12.14 - fprintf(fout_C_cu, "%s", UnparseBif_Char(mod_gpu->thebif, C_LANG)); - mod_gpu->extractStmt(); - // unparsing C Adapter Functions to fout_C_cu - if (block_C) - { - block_C->setVariant(EXTERN_C_STAT); - fprintf(fout_C_cu, "%s", UnparseBif_Char(block_C->thebif, C_LANG)); - block_C->extractStmt(); - } - return; - } - - // grab the first statement in the file. - stat = f->firstStatement(); // file header - stmt = stat->lexNext(); - - // unparsing info_block to fout_info - if (info_block) - { - fprintf(fout_info, "%s", UnparseBif_Char(info_block->thebif, C_LANG)); - info_block->extractStmt(); - } - // unparsing C Adapter Functions to fout_C_cu (!! C before Fortran because tabulation ) - //block_C->setSymbol(*mod_gpu_symb); - if (block_C) - { - block_C->setVariant(EXTERN_C_STAT); - fprintf(fout_C_cu, "%s", UnparseBif_Char(block_C->thebif, C_LANG)); - block_C->extractStmt(); - } - // unparsing Module of Fortran-Cuda-kernels to fout_cuf (!!Fortran after C because tabulation) - fprintf(fout_cuf, "%s", UnparseBif_Char(mod_gpu->thebif, FORTRAN_LANG)); - mod_gpu->extractStmt(); - - /* - while( stmt!=mod_gpu) - { printf("function C: %s \n", stmt->expr(0)->symbol()->identifier()); - fprintf(fout_C_cu,"%s",UnparseBif_Char(stmt->thebif,C_LANG)); - st_func = stmt; - stmt=stmt->lastNodeOfStmt()->lexNext(); - st_func->extractStmt(); - } - */ - -} - -void UnparseForDynamicCompilation(FILE *fout_cpp) -{ - SgStatement *stmt; - stmt = mod_gpu->lexNext(); - while (stmt->variant() != CONTROL_END) - { //printf("%d\n",stmt->variant()); - BIF_CMNT(stmt->thebif) = NULL; - char *unp_buf = UnparseBif_Char(stmt->thebif, C_LANG); - //char *buff = new char[strlen(unp_buf) + 1]; - //sprintf(buff, "const char *%s = ""extern ""C"" %s"";""", stmt->symbol()->identifier(),unp_buf); - fprintf(fout_cpp, "const char *%s = \"extern \"C\" %s\";\n\n", stmt->symbol()->identifier(), unp_buf); - //delete []buff; - stmt = stmt->lastNodeOfStmt()->lexNext(); //printf("%d\n",stmt->variant()); - } - -} - -/***************************************************************************************/ -/* Creating New File */ -/***************************************************************************************/ -int Create_New_File(char *file_name, SgFile *file, char *fout_name) - -{ - SgFile *fcuf; - FILE *fout; - char *new_file_name, *dep_file_name; - int ll; - // old file - mod_gpu->extractStmt(); - ll = strlen(file_name) + 1; - dep_file_name = (char *)malloc((unsigned)ll); - strcpy(dep_file_name, file_name); - *(dep_file_name + ll - 3) = 'd'; - *(dep_file_name + ll - 2) = 'e'; - *(dep_file_name + ll - 1) = 'p'; - file->saveDepFile(dep_file_name); - - // new file - fcuf = new SgFile(0, "dvm_gpu"); - - fcuf->firstStatement()->insertStmtAfter(*mod_gpu); - fcuf->saveDepFile("dvm_gpu.dep"); - - new_file_name = (char *)malloc((unsigned)(strlen(file_name) + 10)); - sprintf(new_file_name, "dvm_gpu_%s", fout_name); - - if ((fout = fopen(new_file_name, "w")) == NULL) { - (void)fprintf(stderr, "Can't open file %s for write\n", new_file_name); - return 1; - } - fcuf->unparse(fout); - fclose(fout); - - return 0; -} - -/***************************************************************************************/ -/*ACC*/ -/* Creating and Inserting New Statement in the Program */ -/* (Fortran Language, .f file) */ -/***************************************************************************************/ -/* -void InsertUseStatementForGpuModule() -{ -if((fmask[LOOP_GPU] == 0) && (fmask[LOOPNS_GPU] == 0) ) // has been generated kernels -return; -SgStatement * st_use = new SgStatement(USE_STMT); -st_use->setSymbol(*mod_gpu_symb); -if(cur_func->controlParent()->variant() == MODULE_STMT) -cur_func->controlParent()->insertStmtAfter(*st_use,*cur_func->controlParent()); -else -cur_func->insertStmtAfter(*st_use,*cur_func); -} -*/ - -SgStatement *doIfThenConstrForLoop_GPU(SgExpression *ref, SgStatement *endhost, SgStatement *dowhile) -{ - SgStatement *ifst; - // SgExpression *ea; - // creating - // IF ( ref .EQ. 0) THEN - // - // ELSE - // - // ENDIF - // - - ifst = new SgIfStmt(SgEqOp(*ref, *new SgValueExp(0)), *endhost, *dowhile); - cur_st->insertStmtAfter(*ifst, *cur_st->controlParent()); - - // ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(ifst); -} - -SgExpression *ReductionPrivateVariables() -{ - reduction_operation_list *rl; - SgExpression *red_vars=NULL; - for (rl = red_struct_list; rl; rl = rl->next) - { - red_vars = AddListToList(red_vars, new SgExprListExp(*new SgVarRefExp(rl->redvar))); - if (rl->locvar) - red_vars = AddListToList(red_vars, new SgExprListExp(*new SgVarRefExp(rl->locvar))); - } - return red_vars; -} - -SgExpression * TranslateReductionToOpenmp(SgExpression *reduction_clause) /* OpenMP */ -{ - SgExprListExp *explist, *OpenMPReductions; - SgExpression *clause; - SgExprListExp *red_max, *red_min, *red_sum, *red_product; - SgExprListExp *red_and, *red_eqv, *red_neqv; - SgExprListExp *red_or; - int i, length; - red_max = red_min = red_sum = red_product = red_or = red_and = red_eqv = red_neqv = NULL; - OpenMPReductions = NULL; - explist = isSgExprListExp(reduction_clause); - if (explist == NULL) return NULL; - length = explist->length(); - for (i = 0; i < length; i++) { - clause = explist->elem(i); - switch (clause->variant()) { - case ARRAY_OP: { - if ((clause->lhs() != NULL) && (clause->rhs() != NULL)) { - if (clause->lhs()->variant() == KEYWORD_VAL) { - char *reduction_name = NODE_STRING_POINTER(clause->lhs()->thellnd); - if (!strcmp(reduction_name, "max")) { - if (red_max != NULL) red_max->append(*clause->rhs()); - else red_max = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "min")) { - if (red_min != NULL) red_min->append(*clause->rhs()); - else red_min = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "sum")) { - if (red_sum != NULL) red_sum->append(*clause->rhs()); - else red_sum = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "product")) { - if (red_product != NULL) red_product->append(*clause->rhs()); - else red_product = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "or")) { - if (red_or != NULL) red_or->append(*clause->rhs()); - else red_or = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "and")) { - if (red_and != NULL) red_and->append(*clause->rhs()); - else red_and = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "eqv")) { - if (red_eqv != NULL) red_eqv->append(*clause->rhs()); - else red_eqv = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "neqv")) { - if (red_neqv != NULL) red_neqv->append(*clause->rhs()); - else red_neqv = new SgExprListExp(*clause->rhs()); - continue; - } - if (!strcmp(reduction_name, "maxloc")) { - return NULL; - } - if (!strcmp(reduction_name, "minloc")) { - return NULL; - } - } - - } - break; - } - - } - } - SgKeywordValExp *kwd; - SgExpression *ddot; - SgExpression *red; - if (red_max != NULL) { - kwd = new SgKeywordValExp("max"); - ddot = new SgExpression(DDOT, kwd, red_max, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_min != NULL) { - kwd = new SgKeywordValExp("min"); - ddot = new SgExpression(DDOT, kwd, red_min, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_sum != NULL) { - kwd = new SgKeywordValExp("+"); - ddot = new SgExpression(DDOT, kwd, red_sum, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_product != NULL) { - kwd = new SgKeywordValExp("*"); - ddot = new SgExpression(DDOT, kwd, red_product, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_eqv != NULL) { - kwd = new SgKeywordValExp(".eqv."); - ddot = new SgExpression(DDOT, kwd, red_eqv, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_neqv != NULL) { - kwd = new SgKeywordValExp(".neqv."); - ddot = new SgExpression(DDOT, kwd, red_neqv, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_or != NULL) { - kwd = new SgKeywordValExp(".or."); - ddot = new SgExpression(DDOT, kwd, red_or, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - if (red_and != NULL) { - kwd = new SgKeywordValExp(".and."); - ddot = new SgExpression(DDOT, kwd, red_and, NULL); - red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); - if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); - else OpenMPReductions->append(*red); - } - return OpenMPReductions; -} - -/* -SgStatement *checkInternal(SgSymbol *s) -{ - enum { SEARCH_INTERNAL, SEARCH_CONTAINS }; - - SgStatement *searchStmt = cur_func->lexNext(); - SgStatement *tmp; - const char *funcName = s->identifier(); - int mode = SEARCH_CONTAINS; - - //search internal function - while (searchStmt) - { - switch (mode) - { - case SEARCH_CONTAINS: - if (searchStmt->variant() == CONTAINS_STMT) - mode = SEARCH_INTERNAL; - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - break; - case SEARCH_INTERNAL: - if (searchStmt->variant() == CONTROL_END) - return NULL; - else if (!strcmp(searchStmt->symbol()->identifier(), funcName)) - return searchStmt; - else - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - break; - } - } - return NULL; -} -*/ - -void TestRoutineAttribute(SgSymbol *s, SgStatement *routine_interface) -{ - if (isForCudaRegion() && FromOtherFile(s) && !routine_interface) - Error("Interface with ROUTINE specification is required for %s", s->identifier(), 646, routine_interface ? routine_interface : cur_func); -} - -/* -int LookForRoutineDir( SgStatement *interfaceFunc ) -{ - SgStatement *st; - for(st=interfaceFunc->lexNext(); st->variant() != CONTROL_END; st=st->lexNext()) - if(st->variant() == ACC_ROUTINE_DIR) - return 1; - return 0; -} -*/ - -void CreateCalledFunctionDeclarations(SgStatement *st_hedr) -{ - symb_list *sl; - SgStatement *contStmt = st_hedr->lastNodeOfStmt(); - int has_routine_attr = 0; - - for (sl = acc_call_list; sl; sl = sl->next) - { - if ((sl->symb->variant() == FUNCTION_NAME || sl->symb->variant() == PROCEDURE_NAME || sl->symb->variant() == INTERFACE_NAME) && !IS_BY_USE(sl->symb)) - { - SgStatement *interfaceFunc = getInterface(sl->symb); - if (interfaceFunc != NULL) - { - if(interfaceFunc->variant() == INTERFACE_STMT) - st_hedr->insertStmtAfter(interfaceFunc->copy(), *st_hedr); - else - { - SgStatement *block = new SgStatement(INTERFACE_STMT); - block->insertStmtAfter(*new SgStatement(CONTROL_END), *block); - block->insertStmtAfter(interfaceFunc->copy(), *block); - st_hedr->insertStmtAfter(*block, *st_hedr); - if (isForCudaRegion() && HAS_ROUTINE_ATTR(interfaceFunc->symbol())) - has_routine_attr = 1; - } - } - /* - else if (interfaceFunc = checkInternal(sl->symb)) - { - if (contStmt->variant() == CONTROL_END) - { - contStmt->insertStmtBefore(*new SgStatement(CONTAINS_STMT)); - contStmt = contStmt->lexPrev(); - } - contStmt->insertStmtAfter(interfaceFunc->copy(), *st_hedr); - } - */ - else if(sl->symb->variant() == FUNCTION_NAME) - st_hedr->insertStmtAfter(*sl->symb->makeVarDeclStmt(), *st_hedr); - TestRoutineAttribute(sl->symb, has_routine_attr ? interfaceFunc : NULL); - } - } -} - -void CreateUseStatements(SgStatement *st_hedr) -{ - CreateUseStatementsForCalledProcedures(st_hedr); - CreateUseStatementsForDerivedTypes(st_hedr); -} - -void CreateUseStatementsForCalledProcedures(SgStatement *st_hedr) -{ - symb_list *sl; - SgStatement *st_use, *stmt; - - for (sl = acc_call_list; sl; sl = sl->next) - { - SgSymbol *sf = ORIGINAL_SYMBOL(sl->symb); //SourceProcedureSymbol(sl->symb); - stmt = sf->scope(); - if (stmt->variant() == MODULE_STMT) - { - st_use = new SgStatement(USE_STMT); - st_use->setSymbol(*stmt->symbol()); - st_use->setExpression(0, *new SgExpression(ONLY_NODE, new SgVarRefExp(sl->symb), NULL, NULL)); - st_hedr->insertStmtAfter(*st_use, *st_hedr); - } - } -} - -void CreateUseStatementsForDerivedTypes(SgStatement *st_hedr) -{ - SgStatement *st, *st_copy, *cur=st_hedr, *from_hedr = cur_func; - if(USE_STATEMENTS_ARE_REQUIRED) - { - while (from_hedr->variant() != GLOBAL) - { - for(st=from_hedr->lexNext(); st->variant()==USE_STMT; st=st->lexNext()) - { - st_copy=&st->copy(); - cur->insertStmtAfter(*st_copy,*st_hedr); - cur = st_copy; - } - from_hedr = from_hedr->controlParent(); - } - } -} - -SgStatement *CreateHostProcedure(SgSymbol *sHostProc) -{ - SgStatement *st_hedr, *st_end; - - st_hedr = new SgStatement(PROC_HEDR); - st_hedr->setSymbol(*sHostProc); - st_hedr->setExpression(2, *new SgExpression(RECURSIVE_OP)); - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*sHostProc); - if (!cur_in_source) - cur_in_source = (*FILE_LAST_STATEMENT(current_file->firstStatement()))->lexNext(); //empty statement inserted after last statement of file - //mod_gpu ? mod_gpu->lastNodeOfStmt() : current_file->firstStatement(); - cur_in_source->insertStmtAfter(*st_hedr, *current_file->firstStatement()); - st_hedr->insertStmtAfter(*st_end, *st_hedr); - st_hedr->setVariant(PROS_HEDR); - - cur_in_source = st_end; - return(st_hedr); - -} - -SgStatement *Create_Host_Across_Loop_Subroutine(SgSymbol *sHostProc) -{ - SgStatement *stmt = NULL, *st_end = NULL, *st_hedr = NULL, *cur = NULL, *last_decl = NULL; - SgExpression *ae = NULL, *arg_list = NULL, *el = NULL, *de = NULL, *tail = NULL, *baseMem_list = NULL; - SgSymbol *s_loop_ref = NULL, *sarg = NULL, *h_first = NULL, *h_last = NULL,*hl = NULL; - symb_list *sl = NULL; - SgType *tdvm = NULL; - int ln, nbuf = 0; - char *name = NULL; - - SgExprListExp *list = isSgExprListExp(dvm_parallel_dir->expr(2)); // do_variables list - SgSymbol *sHostAcrossProc; - symb_list *acc_acr_call_list = NULL; - for (int i = 0; i < list->length(); i++) - { - sHostAcrossProc = HostAcrossProcSymbol(sHostProc, i + 1); - Create_Host_Loop_Subroutine(sHostAcrossProc, i + 1); - acc_acr_call_list = AddToSymbList(acc_acr_call_list, sHostAcrossProc); - } - sHostAcrossProc = HostAcrossProcSymbol(sHostProc, 0); - Create_Host_Loop_Subroutine(sHostAcrossProc, -1); - acc_acr_call_list = AddToSymbList(acc_acr_call_list, sHostAcrossProc); - - // create Host procedure header and end - - st_hedr = CreateHostProcedure(sHostProc); - st_hedr->addComment(Host_LoopHandlerComment()); - st_end = st_hedr->lexNext(); - - // create dummy argument list - // loop_ref,,, - tdvm = FortranDvmType(); - - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *tdvm, *st_hedr); - - ae = new SgVarRefExp(s_loop_ref); - arg_list = new SgExprListExp(*ae); - st_hedr->setExpression(0, *arg_list); - - // add dvm-array-header list - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { - sarg = DummyDvmHeaderSymbol(sl->symb,st_hedr); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - } - h_last = sarg; - // add dvm-array-address list - if (options.isOn(O_HOST)) - { - tail = arg_list; - for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next()) - { - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - { - sarg = DummyDvmBufferSymbol(sl->symb, hl); - nbuf++; - } - else - sarg = DummyDvmArraySymbol(sl->symb, hl); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - tail = tail->rhs(); - } - else - // create memory base list and add it to the dummy argument list - { - baseMem_list = tail = CreateBaseMemoryList(); - AddListToList(arg_list, baseMem_list); - } - - // add use's list to dummy argument list - if (uses_list) - { - AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); - if (!tail) - tail = copy_uses_list; - } - - // add bounds of reduction arrays to dummy argument list - if(red_list) - { - SgExpression * red_bound_list; - AddListToList(arg_list, red_bound_list = DummyListForReductionArrays(st_hedr)); - if(!tail) - tail = red_bound_list; - } - - // add dummy arguments for private arrays - if(private_list) - { - SgExpression * private_dummy_list; - AddListToList(arg_list, private_dummy_list = DummyListForPrivateArrays(st_hedr)); - if(!tail) - tail = private_dummy_list; - } - - // create get_dependency_mask function declaration - stmt = fdvm[GET_DEP_MASK_F]->makeVarDeclStmt(); - stmt->expr(1)->setType(tdvm); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - last_decl = cur = stmt; - - // create called functions declarations - CreateCalledFunctionDeclarations(st_hedr); - - for (sl = acc_acr_call_list; sl; sl = sl->next) - { - if (sl->symb->variant() == PROCEDURE_NAME) { - stmt = new SgStatement(EXTERN_STAT); - el = new SgExprListExp(*new SgVarRefExp(sl->symb)); - stmt->setExpression(0, *el); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - } - - // create dummy argument declarations - - for (el = tail; el; el = el->rhs()) - { - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - el = st_hedr->expr(0); - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - de = stmt->expr(0); - //for(el=el->rhs(); el!=baseMem_list && el!=copy_uses_list; el=el->rhs()) - for (el = el->rhs(); el != tail; el = el->rhs()) - { //printf("%s \n",el->lhs()->symbol()->identifier()); - de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); - de = de->rhs(); - } - - SgSymbol *which_run = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("which_run"), *tdvm, *st_hedr); - stmt = which_run->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - // generate IMPLICIT NONE statement - st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); - - // generate USE statements for called module procedures - CreateUseStatements(st_hedr); - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_DEP_MASK_F]); - fe->addArg(*new SgVarRefExp(s_loop_ref)); - SgFunctionCallExp *fen = new SgFunctionCallExp(*new SgFunctionSymb(FUNCTION_NAME, "not", *SgTypeBool(), *cur_func)); - fen->addArg(*fe); - SgVarRefExp *which_run_expr = new SgVarRefExp(which_run); - stmt = new SgAssignStmt(*which_run_expr, *fen); - st_end->insertStmtBefore(*stmt, *st_hedr); - //stmt = PrintStat(which_run_expr); - //st_end->insertStmtBefore(*stmt, *st_hedr); - - // create argument list of handler's call - SgExpression *new_arg_list = &st_hedr->expr(0)->copy(); - if (nbuf > 0) // there is REMOTE_ACCESS clause and RTS2 interface is used - // correct argument list of handler's call - { - el = new_arg_list->rhs(); - while(el->lhs()->symbol() != h_last->next()) - el = el->rhs(); - for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next(), el = el->rhs()) - { - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) - { - // correct argument: buffer => buffer(buf_header(Rank+2)) - SgArrayRefExp *buf_ref = new SgArrayRefExp(*hl,*new SgValueExp(Rank(sl->symb)+2)); - el->lhs()->setLhs(*new SgExprListExp(*buf_ref)); - // generate call statements of 'dvmh_loop_get_remote_buf' for remote access buffers - stmt = GetRemoteBuf(s_loop_ref, nbuf--, hl); - last_decl->insertStmtAfter(*stmt, *st_hedr); - } - } - // create external statement - stmt = new SgStatement(EXTERN_STAT); - el = new SgExprListExp(*new SgVarRefExp(fdvm[GET_REMOTE_BUF])); - stmt->setExpression(0, *el); - last_decl->insertStmtAfter(*stmt, *st_hedr); - } - - SgIfStmt *ifstmt = NULL; - SgStatement *falsestmt = NULL; - int i = 0; - for (sl = acc_acr_call_list; sl; sl = sl->next) - { - SgFunctionSymb *sbtest = new SgFunctionSymb(FUNCTION_NAME, "btest", *SgTypeBool(), *cur_func); - if (sl->symb->variant() == PROCEDURE_NAME) { - SgFunctionCallExp *fbtest = new SgFunctionCallExp(*sbtest); - fbtest->addArg(*which_run_expr); - fbtest->addArg(*new SgValueExp(i - 1)); - if (i != 0) - { - SgCallStmt *truestmt = new SgCallStmt(*sl->symb, *new_arg_list); - ifstmt = new SgIfStmt(*fbtest, *truestmt, *falsestmt); - falsestmt = ifstmt; - } - else { - falsestmt = new SgCallStmt(*sl->symb, *new_arg_list); - } - i++; - } - } - if (ifstmt) st_end->insertStmtBefore(*ifstmt, *st_hedr); - return(st_hedr); -} - -SgStatement *Create_Host_Loop_Subroutine_Main (SgSymbol *sHostProc) -{ - SgStatement *stmt = NULL, *st_end = NULL, *st_hedr = NULL, *last_decl = NULL; - SgExpression *ae, *arg_list = NULL, *el = NULL, *de = NULL, *tail = NULL, *baseMem_list = NULL; - SgSymbol *s_loop_ref = NULL, *sarg = NULL, *h_first = NULL, *h_last = NULL, *hl = NULL, *bl = NULL; - SgSymbol *s = NULL; - symb_list *sl = NULL; - int ln, nbuf = 0; - SgSymbol *sHostProc_RA; - - if(rma && !rma->rmout && !rma->rml->symbol() && parloop_by_handler == 2 && WhatInterface(dvm_parallel_dir) == 2 )// there is synchronous REMOTE_ACCESS clause in PARALLEL directive and RTS2 interface is used - // create additional procedure for creating headers of remote access buffers - { - sHostProc_RA = HostProcSymbol_RA(sHostProc); - Create_Host_Loop_Subroutine (sHostProc_RA, 0); - } - else - return (Create_Host_Loop_Subroutine (sHostProc, 0)); - - // create Host procedure header and end for subroutine named by sHostProc - - st_hedr = CreateHostProcedure(sHostProc); - st_hedr->addComment(Host_LoopHandlerComment()); - st_end = st_hedr->lexNext(); - - // create dummy argument list - // loop_ref,,, - - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *FortranDvmType(), *st_hedr); - - ae = new SgVarRefExp(s_loop_ref); - arg_list = new SgExprListExp(*ae); - st_hedr->setExpression(0, *arg_list); - - // add dvm-array-header list - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { - sarg = DummyDvmHeaderSymbol(sl->symb,st_hedr); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - } - h_last = sarg; - - // add dvm-array-address list - if (options.isOn(O_HOST)) - { - tail = arg_list; - for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next()) - { - if(IS_REMOTE_ACCESS_BUFFER(sl->symb)) - { - sarg = DummyDvmBufferSymbol(sl->symb, hl); - nbuf++; - } - else - sarg = DummyDvmArraySymbol(sl->symb, hl); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - tail = tail->rhs(); - } - else - // create memory base list and add it to the dummy argument list - { - baseMem_list = tail = CreateBaseMemoryList(); - AddListToList(arg_list, baseMem_list); - } - - // add use's list to dummy argument list - if (uses_list) - { - AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); - if (!tail) - tail = copy_uses_list; - } - // add dummy arguments for reductions - if(red_list) - { - SgExpression * red_bound_list; - AddListToList(arg_list, red_bound_list = DummyListForReductionArrays(st_hedr)); - if(!tail) - tail = red_bound_list; - } - - // add dummy arguments for private arrays - if(private_list) - { - SgExpression * private_dummy_list; - AddListToList(arg_list, private_dummy_list = DummyListForPrivateArrays(st_hedr)); - if(!tail) - tail = private_dummy_list; - } - - // create external statement - stmt = new SgStatement(EXTERN_STAT); - el = new SgExprListExp(*new SgVarRefExp(fdvm[GET_REMOTE_BUF])); - el->setRhs(*new SgExprListExp(*new SgVarRefExp(sHostProc_RA))); - stmt->setExpression(0, *el); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - last_decl = stmt; - - // create dummy argument declarations - - for (el = tail; el; el = el->rhs()) - { - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - el = st_hedr->expr(0); - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - de = stmt->expr(0); - - for (el = el->rhs(); el != tail; el = el->rhs()) - { //printf("%s \n",el->lhs()->symbol()->identifier()); - de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); - de = de->rhs(); - } - - // generate IMPLICIT NONE statement - st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); - - // generate handler call - stmt = new SgCallStmt(*sHostProc_RA, (st_hedr->expr(0))->copy()); - last_decl->insertStmtAfter(*stmt, *st_hedr); - el = stmt->expr(0)->rhs(); - // correct argument list of handler call - while(el->lhs()->symbol() != h_last->next()) - el = el->rhs(); - for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next(), el = el->rhs()) - { - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) - { - // correct argument: buffer => buffer(buf_header(Rank+2)) - SgArrayRefExp *buf_ref = new SgArrayRefExp(*hl,*new SgValueExp(Rank(sl->symb)+2)); - el->lhs()->setLhs(*new SgExprListExp(*buf_ref)); - // generate call statements of 'dvmh_loop_get_remote_buf' for remote access buffers - stmt = GetRemoteBuf(s_loop_ref, nbuf--, hl); - last_decl->insertStmtAfter(*stmt, *st_hedr); - } - } - - return (st_hedr); -} - -SgStatement *Create_Host_Loop_Subroutine(SgSymbol *sHostProc, int dependency) -{ - SgStatement *stmt = NULL, *st_end = NULL, *st_hedr = NULL, *cur = NULL, *last_decl = NULL, *ass = NULL; - SgStatement *alloc = NULL, *red_init_first = NULL; - SgStatement *paralleldo = NULL; - SgStatement *firstdopar = NULL; - SgExprListExp *parallellist = NULL; - SgExprListExp *omp_dolist = NULL; - SgExprListExp *omp_perflist = NULL; - SgExpression *ae, *arg_list = NULL, *el = NULL, *de = NULL, *tail = NULL, *baseMem_list = NULL, *omp_red_vars=NULL; - SgSymbol *s_loop_ref = NULL, *sarg = NULL, *h_first = NULL, *hl = NULL; - SgSymbol *s_lgsc = NULL; /* OpenMP */ - SgVarRefExp *v_lgsc = NULL; /* OpenMP */ - SgSymbol *s = NULL, *s_low_bound = NULL, *s_high_bound = NULL, *s_step = NULL; - symb_list *sl = NULL; - SgType *tdvm = NULL; - int ln, lrank, addopenmp, number_of_reductions = 0; - char *name; - tail = NULL; - addopenmp = 1; /* OpenMP */ - - // create Host procedure header and end - st_hedr = CreateHostProcedure(sHostProc); - st_hedr->addComment(Host_LoopHandlerComment()); - st_end = st_hedr->lexNext(); - - // create dummy argument list - // loop_ref,,, - - tdvm = FortranDvmType(); - - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *tdvm, *st_hedr); - - ae = new SgVarRefExp(s_loop_ref); - arg_list = new SgExprListExp(*ae); - st_hedr->setExpression(0, *arg_list); - - // add dvm-array-header list - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { //printf("%s\n",sl->symb->identifier()); - sarg = DummyDvmHeaderSymbol(sl->symb,st_hedr); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - } - - // add dvm-array-address list - if (options.isOn(O_HOST)) - { - tail = arg_list; - for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next()) - { - sarg = DummyDvmArraySymbol(sl->symb, hl); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - tail = tail->rhs(); - } - else - // create memory base list and add it to the dummy argument list - { - baseMem_list = tail = CreateBaseMemoryList(); - AddListToList(arg_list, baseMem_list); - } - - // add use's list to dummy argument list - if (uses_list) - { - AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); - if (!tail) - tail = copy_uses_list; - } - // add dummy arguments for reductions - if(red_list) - { - SgExpression * red_bound_list; - AddListToList(arg_list, red_bound_list = DummyListForReductionArrays(st_hedr)); - if(!tail) - tail = red_bound_list; - } - // add dummy arguments for private arrays - if(private_list) - { - SgExpression * private_dummy_list; - AddListToList(arg_list, private_dummy_list = DummyListForPrivateArrays(st_hedr)); - if(!tail) - tail = private_dummy_list; - } - - // create external statement - stmt = new SgStatement(EXTERN_STAT); - el = new SgExprListExp(*new SgVarRefExp(fdvm[FILL_BOUNDS])); - if (red_list) - { - SgExpression *eel; - eel = new SgExprListExp(*new SgVarRefExp(fdvm[RED_INIT])); - eel->setRhs(*el); - el = eel; - eel = new SgExprListExp(*new SgVarRefExp(fdvm[RED_POST])); - eel->setRhs(*el); - el = eel; - } - stmt->setExpression(0, *el); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - last_decl = cur = stmt; - - // create called functions declarations - CreateCalledFunctionDeclarations(st_hedr); - - // create get_slot_count function declaration /* OpenMP */ - stmt = fdvm[SLOT_COUNT]->makeVarDeclStmt(); - stmt->expr(1)->setType(tdvm); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - // - s_lgsc = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("lgsc"), *tdvm, *st_hedr); /* OpenMP */ - v_lgsc = new SgVarRefExp(*s_lgsc); /* OpenMP */ - stmt = s_lgsc->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - if (omp_perf) /* OpenMP */ - { - //SgVarRefExp *varDvmhstring = new SgVarRefExp(fdvm[STRING]); - SgVarRefExp *varThreadID = new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "dvmh_threadid",tdvm,st_hedr)); - SgVarRefExp *varStmtID = new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "dvmh_stmtid",tdvm,st_hedr)); - //SgExpression *exprFilenameType = new SgExpression(LEN_OP); - //exprFilenameType->setLhs(new SgValueExp((int)(strlen(dvm_parallel_dir->fileName())+1))); - //SgType *typeFilename = new SgType(T_STRING,exprFilenameType,SgTypeChar()); - //SgVarRefExp *varFilename = new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "dvmh_filename",typeFilename,st_hedr)); - //stmt=varFilename->symbol()->makeVarDeclStmt(); - //stmt->expr(0)->setLhs(FileNameInitialization(stmt->expr(0)->lhs(),dvm_parallel_dir->fileName())); - //stmt->setVariant(VAR_DECL_90); - //stmt->setlineNumber(-1); - //st_hedr->insertStmtAfter(*stmt, *st_hedr); - //stmt=varDvmhstring->symbol()->makeVarDeclStmt(); - //stmt->setlineNumber(-1); - //st_hedr->insertStmtAfter(*stmt, *st_hedr); - //SgExprListExp *funcList = new SgExprListExp(*varDvmhstring); - SgExprListExp *funcList = new SgExprListExp(*new SgVarRefExp(fdvm[OMP_STAT_BP])); - //funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_BP])); - funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_AP])); - funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_BL])); - funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_AL])); - if (dependency == -1) { - funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_BS])); - funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_AS])); - } - stmt = new SgStatement(EXTERN_STAT); - stmt->setExpression(0, *funcList); - stmt->setlineNumber(-1); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - omp_perflist = new SgExprListExp(*new SgVarRefExp(s_loop_ref)); /* OpenMP */ - omp_perflist->append(*varStmtID); /* OpenMP */ - omp_perflist->append(*varThreadID); /* OpenMP */ - //omp_perflist->append(*ConstRef_F95(dvm_parallel_dir->lineNumber())); /* OpenMP */ - //omp_perflist->append(*DvmhString(varFilename)); - SgSymbol *symCommon =new SgSymbol (VARIABLE_NAME,"dvmh_common"); - stmt = new SgStatement (OMP_THREADPRIVATE_DIR); - SgExpression *exprThreadprivate = new SgExpression (OMP_THREADPRIVATE); - exprThreadprivate->setLhs (*new SgExprListExp (*new SgVarRefExp (*symCommon))); - stmt->setExpression (0, *exprThreadprivate); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - SgExpression *exprCommon = new SgExpression (COMM_LIST); - exprCommon->setSymbol (*symCommon); - exprCommon->setLhs (*varThreadID); - stmt = new SgStatement(COMM_STAT); - stmt->setExpression (0, *exprCommon); - stmt->setlineNumber(-1); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - stmt = varStmtID->symbol()->makeVarDeclStmt(); - stmt->setlineNumber(-1); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - stmt = varThreadID->symbol()->makeVarDeclStmt(); - stmt->setlineNumber(-1); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - parallellist = new SgExprListExp(*new SgExpression(OMP_NUM_THREADS, v_lgsc, NULL, NULL)); /* OpenMP */ - - // create reduction variables declarations and - // generate 'loop_red_init' and 'loop_red_post' function calls - - //looking through the reduction list - if (red_list) - { - int nr; - SgExpression *ev, *ered, *er, *red; - SgSymbol *loc_var; - reduction_operation_list *rl; - red = TranslateReductionToOpenmp(&red_list->copy()); /* OpenMP */ - if(red != NULL) parallellist->append(*red); /* OpenMP */ - else omp_red_vars = ReductionPrivateVariables(); /*MAXLOC/MINLOC*/ /* OpenMP */ - for (rl = red_struct_list,nr = 1; rl; rl = rl->next, nr++) - { - if (rl->locvar) - DeclareSymbolInHostHandler(rl->locvar, st_hedr, rl->loc_host); - - SgSymbol *sred = rl->redvar_size != 0 ? rl->red_host : rl->redvar; - DeclareSymbolInHostHandler(rl->redvar, st_hedr, sred); - - // generate loop_red_init and loop_red_post function calls - stmt = LoopRedInit_HH(s_loop_ref, nr, sred, rl->locvar); - cur->insertStmtAfter(*stmt, *st_hedr); - cur = stmt; - if (nr == 1) red_init_first = stmt; - stmt = LoopRedPost_HH(s_loop_ref, nr, sred, rl->locvar); - st_end->insertStmtBefore(*stmt, *st_hedr); - - } - number_of_reductions = nr; /* OpenMP */ - } - - // create local variables and it's declarations: - // ,,[],, - - - // - lrank = ParLoopRank(); - SgArrayType *typearray = new SgArrayType(*tdvm); - typearray->addRange(*new SgValueExp(lrank)); - if (addopenmp == 1) { - if (dependency == -1) { /* OpenMP */ - omp_dolist = new SgExprListExp(*new SgExpression(OMP_SCHEDULE, new SgKeywordValExp("static"), NULL, NULL)); /* OpenMP */ - } else { - omp_dolist = new SgExprListExp(*new SgExpression(OMP_SCHEDULE, new SgKeywordValExp("runtime"), NULL, NULL)); /* OpenMP */ - // XXX: 'collapse' clause does not work properly - if ((dependency == 0) && (collapse_loop_count > 1)) { /* OpenMP */ - omp_dolist->append(*new SgExpression(OMP_COLLAPSE, new SgValueExp(collapse_loop_count < lrank ? collapse_loop_count : lrank), NULL, NULL)); /* OpenMP */ - }/* OpenMP */ - } - } - - s_low_bound = s = new SgSymbol(VARIABLE_NAME, "boundsLow", *typearray, *st_hedr); - s_high_bound = new SgSymbol(VARIABLE_NAME, "boundsHigh", *typearray, *st_hedr); - s_step = new SgSymbol(VARIABLE_NAME, "loopSteps", *typearray, *st_hedr); - - stmt = s->makeVarDeclStmt(); - stmt->expr(1)->setType(tdvm); - el = new SgExprListExp(*new SgArrayRefExp(*s_high_bound, *new SgValueExp(lrank))); - el->setRhs(new SgExprListExp(*new SgArrayRefExp(*s_step, *new SgValueExp(lrank)))); - stmt->expr(0)->setRhs(el); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - // - if (!options.isOn(O_HOST)) - DeclareArrayCoefficients(st_hedr); - - // - if ((addopenmp == 1) && (private_list != NULL)) parallellist->append(*new SgExpression(OMP_PRIVATE, &(private_list->copy()), NULL, NULL)); /* OpenMP */ - for (el = private_list; el; el = el->rhs()) - { - SgSymbol *sp = el->lhs()->symbol(); - SgSymbol *sph = isSgArrayType(sp->type()) ? *(SgSymbol **)(el->lhs()->attributeValue(0, PRIVATE_ARRAY)) : sp; - DeclareSymbolInHostHandler(sp, st_hedr, sph); - } - // - SgExprListExp *indexes = NULL; /* OpenMP */ - for (el = dvm_parallel_dir->expr(2); el; el = el->rhs()) - { - if (isPrivate(el->lhs()->symbol())) // is declared as private - continue; - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - if (addopenmp == 1) {/* OpenMP */ - if (indexes != NULL) indexes->append(*el->lhs()); /* OpenMP */ - else indexes = new SgExprListExp(*el->lhs()); /* OpenMP */ - } /* OpenMP */ - } - - if ((addopenmp == 1) && (indexes != NULL)) parallellist->append(*new SgExpression(OMP_PRIVATE, AddListToList(indexes,omp_red_vars), NULL, NULL)); /* OpenMP */ - - // create dummy argument declarations - - for (el = tail; el; el = el->rhs()) - { - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - el = st_hedr->expr(0); - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - de = stmt->expr(0); - //for(el=el->rhs(); el!=baseMem_list && el!=copy_uses_list; el=el->rhs()) - for (el = el->rhs(); el != tail; el = el->rhs()) - { //printf("%s \n",el->lhs()->symbol()->identifier()); - de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); - de = de->rhs(); - } - - // generate IMPLICIT NONE statement - st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); - - // generate USE statements for called module procedures - CreateUseStatements(st_hedr); - - // generate call statement of 'loop_fill_bounds' - stmt = LoopFillBounds_HH(s_loop_ref, s_low_bound, s_high_bound, s_step); - last_decl->insertStmtAfter(*stmt, *st_hedr); - if (cur == last_decl) - cur = stmt; - // copying headers elements to array coefficients - if (!options.isOn(O_HOST)) { - CopyHeaderElems(last_decl); - if (dependency == 0) dvm_ar = NULL; - } - - // inserting parallel loop nest - // first_do_par - first DO statement of parallel loop nest - - // replace loop nest - ReplaceDoNestLabel_Above(LastStatementOfDoNest(first_do_par), first_do_par, GetLabel()); - ReplaceLoopBounds(first_do_par, lrank, s_low_bound, s_high_bound, s_step); - - //stmt = first_do_par->extractStmt(); - if (dependency == 0) firstdopar = stmt = first_do_par->extractStmt(); - else firstdopar = stmt = first_do_par->copyPtr(); - cur->insertStmtAfter(*stmt, *st_hedr); - - - if (addopenmp == 1) { /* OpenMP */ - SgCallStmt *stDvmhstat = NULL; - SgStatement *omp_do = new SgStatement(OMP_DO_DIR); /* OpenMP */ - SgStatement *omp_parallel = new SgStatement(OMP_PARALLEL_DIR); /* OpenMP */ - SgStatement *omp_endparallel = new SgStatement(OMP_END_PARALLEL_DIR); /* OpenMP */ - SgStatement *omp_enddo = new SgStatement(OMP_END_DO_DIR); /* OpenMP */ - SgForStmt *stdo = isSgForStmt(firstdopar); /* OpenMP */ - SgStatement *lastdo=LastStatementOfDoNest(stdo); - cur->insertStmtAfter(*omp_parallel, *st_hedr); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BP],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - cur->insertStmtAfter(*stDvmhstat, *st_hedr); /* OpenMP */ - } - if (omp_red_vars) /* MINLOC/MAXLOC */ /* OpenMP */ - st_end->insertStmtBefore(*omp_endparallel,*st_hedr); /* OpenMP */ - else - lastdo->insertStmtAfter(*omp_endparallel,*st_hedr); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AL],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - lastdo->insertStmtAfter(*stDvmhstat);/* OpenMP */ - }/* OpenMP */ - omp_parallel->setExpression(0, *parallellist);/* OpenMP */ - omp_do->setExpression(0, *omp_dolist);/* OpenMP */ - omp_enddo->setExpression(0, *new SgExprListExp(*new SgExpression(OMP_NOWAIT))); /* OpenMP */ - ass = new SgAssignStmt(*v_lgsc, *LoopGetSlotCount_HH(s_loop_ref)); /* OpenMP */ - if (!dependency) { - omp_parallel->insertStmtAfter(*omp_do); /* OpenMP */ - lastdo->insertStmtAfter(*omp_enddo); /* OpenMP */ - } else if (isSgForStmt(firstdopar->lexNext())) { /* OpenMP */ - int step = 1; /* OpenMP */ - SgSymbol *s_iam = NULL; /* OpenMP */ - SgExpression *e_iam = NULL; /* OpenMP */ - SgSymbol *s_ilimit = NULL; /* OpenMP */ - SgExpression *e_ilimit = NULL; /* OpenMP */ - SgSymbol *s_isync = NULL; /* OpenMP */ - SgExpression *e_isync = NULL; /* OpenMP */ - SgSymbol *omp_get_thread_num = NULL; /* OpenMP */ - SgStatement *vardecl = NULL; /* OpenMP */ - SgExprListExp *exprlist = NULL; /* OpenMP */ - SgForStmt *second_do_par = isSgForStmt(firstdopar->lexNext()); /* OpenMP */ - SgStatement *assign; /* OpenMP */ - SgStatement *allocatablestmt; /* OpenMP */ - ConvertLoopWithLabelToEnddoLoop(firstdopar); /* OpenMP */ - if (dependency == -1) { /* OpenMP */ - SgFunctionCallExp *fmin = new SgFunctionCallExp(*new SgFunctionSymb(FUNCTION_NAME, "min", *SgTypeInt(), *cur_func)); /* OpenMP */ - if (second_do_par->step()) { /* OpenMP */ - if (second_do_par->step()->isInteger()) /* OpenMP */ - step = second_do_par->step()->valueInteger(); /* OpenMP */ - else /* OpenMP */ - step = 0; /* OpenMP */ - } /* OpenMP */ - s_iam = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("iam"), *stdo->symbol()->type(), *st_hedr); /* OpenMP */ - e_iam = new SgVarRefExp(*s_iam); /* OpenMP */ - s_isync = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("isync"), *new SgArrayType(*stdo->symbol()->type()), *st_hedr); /* OpenMP */ - e_isync = new SgVarRefExp(*s_isync); /* OpenMP */ - s_ilimit = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("ilimit"), *stdo->symbol()->type(), *st_hedr); /* OpenMP */ - e_ilimit = new SgVarRefExp(*s_ilimit); /* OpenMP */ - omp_get_thread_num = new SgSymbol(FUNCTION_NAME, "omp_get_thread_num", *tdvm, *st_hedr); /* OpenMP */ - allocatablestmt = new SgStatement(ALLOCATABLE_STMT); /* OpenMP */ - allocatablestmt->setExpression(0, *new SgExprListExp(*new SgArrayRefExp(*s_isync, *new SgExpression(DDOT)))); /* OpenMP */ - allocatablestmt->setlineNumber(-1); /* OpenMP */ - last_decl->insertStmtAfter(*allocatablestmt, *st_hedr); /* OpenMP */ - vardecl = s_isync->makeVarDeclStmt(); /* OpenMP */ - ConstantSubstitutionInTypeSpec(vardecl->expr(1)); - vardecl->setlineNumber(-1); /* OpenMP */ - last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ - vardecl = s_iam->makeVarDeclStmt(); /* OpenMP */ - ConstantSubstitutionInTypeSpec(vardecl->expr(1)); - vardecl->setlineNumber(-1); /* OpenMP */ - last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ - vardecl = s_ilimit->makeVarDeclStmt(); /* OpenMP */ - ConstantSubstitutionInTypeSpec(vardecl->expr(1)); - vardecl->setlineNumber(-1); /* OpenMP */ - last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ - vardecl = omp_get_thread_num->makeVarDeclStmt(); /* OpenMP */ - vardecl->setlineNumber(-1); /* OpenMP */ - last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ - exprlist = new SgExprListExp(*e_iam); /* OpenMP */ - exprlist->append(*e_ilimit); /* OpenMP */ - parallellist->append(*new SgExpression(OMP_PRIVATE, exprlist, NULL, NULL)); /* OpenMP */ - //SgVarRefExp *e_loop = new SgVarRefExp(stdo->symbol()); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AS],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - omp_parallel->insertStmtAfter(*stDvmhstat); /* OpenMP */ - } - omp_parallel->insertStmtAfter(*new SgStatement(OMP_BARRIER_DIR)); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BS],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - omp_parallel->insertStmtAfter(*stDvmhstat); /* OpenMP */ - } - assign = new SgAssignStmt(*new SgArrayRefExp(*s_isync, *e_iam), *new SgValueExp(0)); /* OpenMP */ - assign->setlineNumber(-1); /* OpenMP */ - omp_parallel->insertStmtAfter(*assign); /* OpenMP */ - assign = new SgAssignStmt(*e_iam, *new SgFunctionCallExp(*omp_get_thread_num)); /* OpenMP */ - assign->setlineNumber(-1); /* OpenMP */ - omp_parallel->insertStmtAfter(*assign); /* OpenMP */ - fmin->addArg(*v_lgsc - *new SgValueExp(1)); - if (step > 0) { /* OpenMP */ - if (step == 1) { - fmin->addArg(*second_do_par->end() - *second_do_par->start() /*+ *new SgValueExp(1)*/); - } - else { - SgValueExp *estep = new SgValueExp(step); - fmin->addArg((*second_do_par->end() - *second_do_par->start()) / *estep /*+ *new SgValueExp(1)*/); - } - } - else { /* OpenMP */ - if (step == -1) { - fmin->addArg(*second_do_par->start() - *second_do_par->end() /*+ *new SgValueExp(1)*/); - } - else { - SgValueExp *estep = new SgValueExp(step); - fmin->addArg((*second_do_par->start() - *second_do_par->end()) / *estep /*+ *new SgValueExp(1)*/); - } - } - assign = new SgAssignStmt(*e_ilimit, *fmin); /* OpenMP */ - assign->setlineNumber(-1); /* OpenMP */ - omp_parallel->insertStmtAfter(*assign); /* OpenMP */ - alloc = new SgStatement(DEALLOCATE_STMT); /* OpenMP */ - alloc->setExpression(0, *new SgArrayRefExp(*s_isync)); /* OpenMP */ - alloc->setlineNumber(-1); /* OpenMP */ - omp_endparallel->insertStmtAfter(*alloc, *st_hedr); /* OpenMP */ - alloc = new SgStatement(ALLOCATE_STMT); /* OpenMP */ - alloc->setExpression(0, *new SgArrayRefExp(*s_isync, *new SgExpression(DDOT, new SgValueExp(0), &(*v_lgsc - *new SgValueExp(1)), NULL))); /* OpenMP */ - alloc->setlineNumber(-1); /* OpenMP */ - firstdopar->insertStmtAfter(*omp_do); /* OpenMP */ - omp_do->lexNext()->lastNodeOfStmt()->insertStmtAfter(*omp_enddo); - SgStatement *flushst = new SgStatement(OMP_FLUSH_DIR); - flushst->setExpression(0, *new SgExprListExp(*e_isync)); - SgExpression *e_isynciam = new SgArrayRefExp(*s_isync, *e_iam - *new SgValueExp(1)); - SgWhileStmt *whilest = new SgWhileStmt(SgEqOp(*e_isynciam, *new SgValueExp(0)).copy(), *flushst); - whilest->setlineNumber(-1); /* OpenMP */ - whilest->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ - SgIfStmt *ifstmt = new SgIfStmt(*e_iam > *new SgValueExp(0) && *e_iam <= *e_ilimit, *whilest); - ifstmt->setlineNumber(-1); /* OpenMP */ - ifstmt->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AS],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - firstdopar->insertStmtAfter(*stDvmhstat, *firstdopar); /* OpenMP */ - } - firstdopar->insertStmtAfter(*ifstmt, *firstdopar); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BS],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - firstdopar->insertStmtAfter(*stDvmhstat, *firstdopar); /* OpenMP */ - } - assign = new SgAssignStmt(*e_isynciam, *new SgValueExp(0)); /* OpenMP */ - assign->setlineNumber(-1); /* OpenMP */ - whilest->lastNodeOfStmt()->insertStmtAfter(*assign); /* OpenMP */ - assign->insertStmtAfter(flushst->copy()); /* OpenMP */ - e_isynciam = new SgArrayRefExp(*s_isync, *e_iam); /* OpenMP */ - whilest = new SgWhileStmt(SgEqOp(*e_isynciam, *new SgValueExp(1)).copy(), flushst->copy()); /* OpenMP */ - whilest->setlineNumber(-1); /* OpenMP */ - whilest->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ - ifstmt = new SgIfStmt(*e_iam < *e_ilimit, *whilest); /* OpenMP */ - ifstmt->setlineNumber(-1); /* OpenMP */ - ifstmt->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AS],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - omp_enddo->insertStmtAfter(*stDvmhstat); /* OpenMP */ - } - omp_enddo->insertStmtAfter(*ifstmt); /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BS],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - omp_enddo->insertStmtAfter(*stDvmhstat); /* OpenMP */ - } - assign = new SgAssignStmt(*e_isynciam, *new SgValueExp(1)); /* OpenMP */ - assign->setlineNumber(-1); /* OpenMP */ - whilest->lastNodeOfStmt()->insertStmtAfter(*assign); /* OpenMP */ - assign->insertStmtAfter(flushst->copy()); /* OpenMP */ - } - else { - firstdopar = firstdopar->lexPrev(); /* OpenMP */ - for (int i = 1; i < dependency && firstdopar; i++) { /* OpenMP */ - firstdopar = firstdopar->lexNext(); /* OpenMP */ - } /* OpenMP */ - if (isSgForStmt(firstdopar) || firstdopar->variant() == OMP_PARALLEL_DIR) { /* OpenMP */ - firstdopar->insertStmtAfter(*omp_do); /* OpenMP */ - omp_do->lexNext()->lastNodeOfStmt()->insertStmtAfter(*omp_enddo); /* OpenMP */ - } /* OpenMP */ - } /* OpenMP */ - if (alloc != NULL) cur->insertStmtAfter(*alloc, *st_hedr); /* OpenMP */ - ass->setlineNumber(-1); /* OpenMP */ - } /* OpenMP */ - cur->insertStmtAfter(*ass, *st_hedr); /* OpenMP */ - if (omp_red_vars) { /* OpenMP */ - //transfer of reduction initialization statements in case of maxloc/minloc - int i; /* OpenMP */ - SgStatement *from = red_init_first->lexPrev(); /* OpenMP */ - cur = omp_parallel; /* OpenMP */ - for (i=number_of_reductions-1; i; i--) { /* OpenMP */ - stmt = from->lexNext()->extractStmt(); /* OpenMP */ - cur->insertStmtAfter(*stmt); /* OpenMP */ - cur = stmt; /* OpenMP */ - } /* OpenMP */ - } /* OpenMP */ - if (omp_perf) {/* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BL],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - omp_parallel->insertStmtAfter(*stDvmhstat); /* OpenMP */ - stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AP],*omp_perflist);/* OpenMP */ - stDvmhstat->setlineNumber(-1);/* OpenMP */ - omp_endparallel->insertStmtAfter(*stDvmhstat);/* OpenMP */ - }/* OpenMP */ - - } /* OpenMP */ - - - return(st_hedr); -} - -SgStatement *Create_Host_Sequence_Subroutine(SgSymbol *sHostProc, SgStatement *first_st, SgStatement *last_st) -{ - SgStatement *stmt, *st_end, *st_hedr; - SgExpression *ae, *arg_list, *el, *de, *tail, *baseMem_list; - SgSymbol *s_loop_ref, *sarg, *h_first; - - symb_list *sl; - SgType *tdvm; - int ln, host_ndvm, save_maxdvm; - - //create Host Procedure header and end - st_hedr = CreateHostProcedure(sHostProc); - st_hedr->addComment(Host_SequenceHandlerComment(first_st->lineNumber())); - st_end = st_hedr->lexNext(); - - // create dummy argument list - // loop_ref,,, - tdvm = FortranDvmType(); - - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *tdvm, *st_hedr); - loop_ref_symb = s_loop_ref; //assign to global for function HasLocalElement(), called from ReplaseAssignByIf() - - ae = new SgVarRefExp(s_loop_ref); - arg_list = new SgExprListExp(*ae); - st_hedr->setExpression(0, *arg_list); - - // add dvm-array-header list - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { //printf("%s\n",sl->symb->identifier()); - SgArrayType *typearray = new SgArrayType(*tdvm); - typearray->addRange(*new SgValueExp(Rank(sl->symb) + 2)); - sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); - ae = new SgArrayRefExp(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - } - - // create memory base list and add it to the dummy argument list - baseMem_list = tail = CreateBaseMemoryList(); - AddListToList(arg_list, baseMem_list); - - // add use's list to dummy argument list - if (uses_list) - AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); - if (!tail) - tail = copy_uses_list; - - // create called functions declarations - CreateCalledFunctionDeclarations(st_hedr); - - // create dummy argument declarations - - for (el = tail; el; el = el->rhs()) - { - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - el = st_hedr->expr(0); - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - de = stmt->expr(0); - - for (el = el->rhs(); el && el != tail; el = el->rhs()) - { //printf("%s \n",el->lhs()->symbol()->identifier()); - de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); - de = de->rhs(); - } - - - // inserting sequence of statements - index_array_symb = NULL; - host_ndvm = ndvm; - save_maxdvm = maxdvm; maxdvm = 0; - TransferBlockToHostSubroutine(first_st, last_st, st_end); - dvm_ar = NULL; - - - // declare indexArray if needed for dvm-array references in left part of assign statement - if (index_array_symb) - { - stmt = index_array_symb->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - // declare dvm000 array - if (host_ndvm < maxdvm) - { - stmt = dvm000SymbolForHost(host_ndvm, st_hedr)->makeVarDeclStmt(); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - maxdvm = save_maxdvm; - - // create loop_has_element() / dvmh_loop_has_element() function declaration - int fVariant = INTERFACE_RTS2 ? HAS_ELEMENT_2 : HAS_ELEMENT; - if (fmask[fVariant]) - { - fmask[fVariant] = 0; - stmt = fdvm[fVariant]->makeVarDeclStmt(); - stmt->expr(1)->setType(FortranDvmType()); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - // create tstio() function declaration - if (has_io_stmt) - { - stmt = fdvm[TSTIOP]->makeVarDeclStmt(); - stmt->expr(1)->setType(FortranDvmType()); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - if(options.isOn(IO_RTS)) - { - stmt = fdvm[FTN_CONNECTED]->makeVarDeclStmt(); - stmt->expr(1)->setType(FortranDvmType()); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - } - // generate IMPLICIT NONE statement - st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); - - // generate USE statements for called module procedures - CreateUseStatements(st_hedr); - - return(st_hedr); -} - -SgExpression *FillerDummyArgumentList(symb_list *paramList,SgStatement *st_hedr) -{ - symb_list *sl; - SgExpression *dummy_arg_list=NULL; - - for (sl = paramList; sl; sl = sl->next) - { //printf("%s\n",sl->symb->identifier()); - if(isSgArrayType(sl->symb->type())) - { - SgSymbol *shedr = DummyDvmHeaderSymbol(sl->symb,st_hedr); - SgExpression *ae = new SgArrayRefExp(*shedr); - dummy_arg_list = AddListToList(dummy_arg_list,new SgExprListExp(*ae)); - ae = new SgArrayRefExp(*DummyDvmArraySymbol(sl->symb, shedr)); - dummy_arg_list = AddListToList(dummy_arg_list,new SgExprListExp(*ae)); - } - else - dummy_arg_list = AddListToList(dummy_arg_list,new SgExprListExp(*new SgVarRefExp(sl->symb))); - } - return dummy_arg_list; - -} - -SgStatement * makeSymbolDeclarationWithInit_F90(SgSymbol *s, SgExpression *einit) -{ - SgStatement *st = s->makeVarDeclStmt(); - st->setVariant(VAR_DECL_90); - SgExpression *e = &SgAssignOp(*new SgVarRefExp(s), *einit); - st->setExpression(0, *new SgExprListExp(*e)); - return(st); -} - -SgSymbol *LoopIndex(SgStatement *body, SgStatement *func) -{ - loopIndexCount++; - char *sname = (char *)malloc(6+10+1); - sprintf(sname, "%s%d", "subexp", loopIndexCount); - SgSymbol *si = new SgSymbol(VARIABLE_NAME, sname, *func); - range_index_list = AddToSymbList(range_index_list, si); - return si; -} - -SgStatement *CreateLoopForRange(SgStatement *body, SgExpression *eRange, SgExpression *e, int flag_filler, SgStatement *func) -{ - SgSymbol *s_index = LoopIndex(body,func); - SgStatement *loop = new SgForStmt(*s_index, *eRange->lhs(), *eRange->rhs(), *body); - if(flag_filler) - if(isSgAssignStmt(body) && !e) - ((SgAssignStmt *) body)->replaceRhs(*new SgVarRefExp(*s_index)); - else - e->setLhs(*new SgVarRefExp(*s_index)); - - return loop; -} - -SgStatement *CreateLoopNestForElement(SgStatement *body, SgExpression *edrv, SgExpression *e, int flag_filler, SgStatement *func) -{ - if(isSgArrayRefExp(edrv)) - { - for(SgExpression *el=edrv->lhs(); el; el=el->rhs()) - body = CreateLoopNestForElement(body, el->lhs(), el, flag_filler, func); - } - else if(isSgSubscriptExp(edrv)) - { body = CreateLoopForRange(body, edrv, e, flag_filler, func); - body = CreateLoopNestForElement(body, edrv->lhs(), e, flag_filler, func); - body = CreateLoopNestForElement(body, edrv->rhs(), e, flag_filler, func); - } - else - return body; - - return (body); -} - -SgStatement * CreateBodyForElememt(SgSymbol *s_elemCount,SgSymbol *s_elemBuf,SgSymbol *s_elemIndex, SgExpression *edrv, int flag_filler) -{ - SgExpression *e = flag_filler ? new SgVarRefExp(*s_elemIndex) : new SgVarRefExp(*s_elemCount); - SgStatement *body = new SgAssignStmt(*e,*e + *new SgValueExp(1)); - - if(flag_filler) - { - SgStatement *st = new SgAssignStmt(*new SgArrayRefExp(*s_elemBuf,*new SgVarRefExp(*s_elemIndex)),*edrv); //*DvmType_Ref(edrv)); - st->setLexNext(*body); - body = st; - } - return (body); -} - -SgStatement *CreateLoopBody_Indirect(SgSymbol *s_elemCount,SgSymbol *s_elemBuf,SgSymbol *s_elemIndex,SgExpression *derived_elem_list,int flag_filler) -{ - SgStatement *loop_body = NULL,*current_st=NULL; - for(SgExpression *el=derived_elem_list; el; el=el->rhs()) - { - SgStatement *body = CreateBodyForElememt(s_elemCount,s_elemBuf,s_elemIndex, el->lhs(), flag_filler); - body = CreateLoopNestForElement(body,el->lhs(),NULL,flag_filler,s_elemCount->scope()); - if(loop_body) - current_st -> setLexNext(*body); - else - loop_body = body; - current_st = body; - while(current_st->lexNext()) - current_st = current_st->lexNext(); - } - return (loop_body); -} - -SgStatement *CreateLoopNest_Indirect(SgSymbol *s_low_bound, SgSymbol *s_high_bound, symb_list *dummy_index_list, SgStatement *body) -{ SgStatement *stl = body; - symb_list *sl = dummy_index_list; - int i = 0; - for ( ; sl; sl=sl->next) - i++; - for (sl= dummy_index_list; sl; sl=sl->next,i--) - stl = new SgForStmt(*sl->symb, *new SgArrayRefExp(*s_low_bound,*new SgValueExp(i)), *new SgArrayRefExp(*s_high_bound,*new SgValueExp(i)), *stl); - return (stl); -} - -void CreateProcedureBody_Indirect(SgStatement *after,SgSymbol *s_low_bound,SgSymbol *s_high_bound,symb_list *dummy_index_list,SgSymbol *s_elemBuf,SgSymbol *s_elemCount,SgSymbol *s_elemIndex,SgExpression *derived_elem_list,int flag_filler) -{ - loopIndexCount = 0; - range_index_list = NULL; - after->insertStmtAfter(*CreateLoopNest_Indirect(s_low_bound,s_high_bound,dummy_index_list,CreateLoopBody_Indirect(s_elemCount,s_elemBuf,s_elemIndex,derived_elem_list,flag_filler)),*after->controlParent()); -} - -SgStatement *CreateIndirectDistributionProcedure(SgSymbol *sProc,symb_list *paramList,symb_list *dummy_index_list,SgExpression *derived_elem_list,int flag_filler) -{ - SgSymbol *s; - // create procedure header and end - - SgStatement *st_hedr = CreateHostProcedure(sProc); - SgStatement *st_end = st_hedr->lexNext(); - - // create dummy argument list - // elemCount/elemBuf,boundsLow,boundsHigh - SgType *tdvm = FortranDvmType(); - SgExpression *MD = new SgExpression(DDOT, new SgValueExp(0), new SgKeywordValExp("*"), NULL); - SgArrayType *typearray = new SgArrayType(*tdvm); - typearray->addRange(*MD); - SgSymbol *s_elemBuf = new SgSymbol(VARIABLE_NAME, "elemBuf", *typearray, *st_hedr); - SgSymbol *s_elemCount = new SgSymbol(VARIABLE_NAME, "elemCount", *tdvm, *st_hedr); - - s = flag_filler ? s_elemBuf : s_elemCount; - SgExpression *ae = new SgVarRefExp(s); - SgExpression *arg_list = NULL; //new SgExprListExp(*ae); - - // - - SgExpression *aster_expr = new SgKeywordValExp("*"); - SgArrayType *typearray_1 = new SgArrayType(*tdvm); - typearray_1 -> addRange(* aster_expr); //( * new SgValueExp(lrank)); - SgSymbol *s_low_bound = new SgSymbol(VARIABLE_NAME, "boundsLow", *typearray_1, *st_hedr); - SgSymbol *s_high_bound = new SgSymbol(VARIABLE_NAME, "boundsHigh", *typearray_1, *st_hedr); - - arg_list = AddElementToList(arg_list, new SgArrayRefExp(*s_high_bound)); - arg_list = AddElementToList(arg_list, new SgArrayRefExp(*s_low_bound)); - arg_list = AddElementToList(arg_list,ae); - SgExpression *dummy_list = FillerDummyArgumentList(paramList,st_hedr); - AddListToList(arg_list,dummy_list); - st_hedr->setExpression(0, *arg_list); - SgSymbol *s_elemIndex = new SgSymbol(VARIABLE_NAME, "elemIndex", *tdvm, *st_hedr); - - // make declarations - - SgExpression *el=NULL; - SgStatement *stmt=NULL, *st_cur=st_hedr; - for (el = dummy_list; el; el = el->rhs()) - { - stmt = el->lhs()->symbol()->makeVarDeclStmt(); - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_cur->insertStmtAfter(*stmt, *st_hedr); - st_cur = stmt; - } - stmt = s->makeVarDeclStmt(); - stmt->expr(1)->setType(tdvm); - el = new SgExprListExp(*new SgArrayRefExp(*s_low_bound, *aster_expr)); - el->setRhs(new SgExprListExp(*new SgArrayRefExp(*s_high_bound, *aster_expr))); - stmt->expr(0)->setRhs(el); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - // make declarations of dummy-idexes and s_elemIndex - for(symb_list *sl=dummy_index_list; sl; sl=sl->next) - AddListToList(el,new SgExprListExp(*new SgVarRefExp(*sl->symb))); - - if(flag_filler) - { - stmt = makeSymbolDeclarationWithInit_F90(s_elemIndex,new SgValueExp(0)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - // make procedure body - - SgStatement *cur = st_end->lexPrev(); - CreateProcedureBody_Indirect(cur,s_low_bound,s_high_bound,dummy_index_list,s_elemBuf,s_elemCount,s_elemIndex,derived_elem_list,flag_filler); - - // add range indexes declarations (to declaration statement for dummy indexes) - - for(symb_list *sl=range_index_list; sl; sl=sl->next) - AddListToList(el,new SgExprListExp(*new SgVarRefExp(*sl->symb))); - - return (st_hedr); -} - -SgSymbol *dvm000SymbolForHost(int host_dvm, SgStatement *hedr) -{ - SgArrayType *typearray = new SgArrayType(*FortranDvmType()); - typearray->addRange(*new SgExpression(DDOT, new SgValueExp(host_dvm), new SgValueExp(maxdvm), NULL)); - return(new SgVariableSymb("dvm000", *typearray, *hedr)); - -} - -void ReplaceLoopBounds(SgStatement *first_do, int lrank, SgSymbol *s_low_bound, SgSymbol *s_high_bound, SgSymbol *s_step) -{ - SgStatement *st; - SgForStmt *stdo; - - int i; - // looking through the loop nest - for (st = first_do, i = 0; i < lrank; st = st->lexNext(), i++) - { - stdo = isSgForStmt(st); - if (!stdo) - break; - if (isSgArrayRefExp(stdo->start())) - stdo->setStart(*new SgArrayRefExp(*s_low_bound, *new SgValueExp(1 + i))); - else - { - stdo->start()->setLhs(new SgArrayRefExp(*s_low_bound, *new SgValueExp(1 + i))); - stdo->start()->rhs()->lhs()->lhs()->setLhs(new SgArrayRefExp(*s_low_bound, *new SgValueExp(1 + i))); - } - if (isSgArrayRefExp(stdo->end())) - stdo->setEnd(*new SgArrayRefExp(*s_high_bound, *new SgValueExp(1 + i))); - else - stdo->end()->setLhs(new SgArrayRefExp(*s_high_bound, *new SgValueExp(1 + i))); - if (!stdo->step()) - continue; - int istep = IntStepForHostHandler(stdo->step()); - SgExpression *estep; - if(istep) - estep = new SgValueExp(istep); - else - estep = new SgArrayRefExp(*s_step, *new SgValueExp(1 + i)); - stdo->setStep(*estep); - } -} - -void ReplaceArrayBoundsInDeclaration(SgExpression *e) -{ - SgExpression *el; - for (el = e->lhs(); el; el = el->rhs()) - el->setLhs(CalculateArrayBound(el->lhs(), e->symbol(), 1)); -} - -int fromModule(SgExpression *e) -{ - if(!e) return 0; - - if(isSgVarRefExp(e) || e->variant()==CONST_REF) - { - if(IS_BY_USE(e->symbol()) || e->symbol()->scope()->variant()==MODULE_STMT) - { - Add_Use_Module_Attribute(); - return 1; - } - else - return 0; - } - if(isSgArrayRefExp(e)) - { - if (e->symbol()->type()->variant()==T_ARRAY && e->symbol()->type()->baseType()->variant()==T_DERIVED_TYPE && (IS_BY_USE(e->symbol()->type()->baseType()->symbol()) || IS_BY_USE(e->symbol()))) - { - Add_Use_Module_Attribute(); - return 1; - } - else - return 0; - } - if(isSgRecordRefExp(e)) - { - SgExpression *estr = LeftMostField(e); - - if(IS_BY_USE(estr->symbol()->type()->symbol()) || IS_BY_USE(estr->symbol())) - { - Add_Use_Module_Attribute(); - return 1; - } - else - return 0; - //fromModule(estr); - } - if(isSgSubscriptExp(e)) - return (fromModule(e->lhs()) && fromModule(e->rhs())); - - if((!e->lhs() || fromModule(e->lhs())) && (!e->rhs() || fromModule(e->rhs()))) - return 1; - - return 0; -} - -int fromUsesList(SgExpression *e) -{ - if(!e) return 1; - SgSymbol *s = e->symbol(); - if(s && !isInUsesList(s)) return 0; - return fromUsesList(e->lhs()) && fromUsesList(e->rhs()); -} - -SgSymbol *DeclareSymbolInHostHandler(SgSymbol *var, SgStatement *st_hedr, SgSymbol *loc_var) -{ - SgSymbol *s = var; - if(!var) return s; - if(USE_STATEMENTS_ARE_REQUIRED && IS_BY_USE(var)) - return s; - - if (!loc_var && isSgArrayType(s->type())) - s = ArraySymbolInHostHandler(s, st_hedr); - else if(loc_var) - s = loc_var ; - - SgStatement *stmt = s->makeVarDeclStmt(); - if(IS_POINTER_F90(s)) - stmt->setExpression(2,*new SgExpression(POINTER_OP)); - - ConstantSubstitutionInTypeSpec(stmt->expr(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - return s; -} - -int ExplicitShape(SgExpression *eShape) -{ - SgExpression *el; - SgSubscriptExp *sbe; - for(el=eShape; el; el=el->rhs()) - { - SgExpression *uBound = (sbe=isSgSubscriptExp(el->lhs())) ? sbe->ubound() : el->lhs(); - if(uBound && uBound->variant()!=STAR_RANGE) - continue; - else - return 0; - } - return 1; -} - -int AssumedShape(SgExpression *eShape) -{ - SgExpression *el; - SgSubscriptExp *sbe; - for(el=eShape; el; el=el->rhs()) - { - //SgExpression *uBound = (sbe=isSgSubscriptExp(el->lhs())) ? sbe->ubound() : el->lhs(); - sbe=isSgSubscriptExp(el->lhs()); - if(sbe && !sbe->ubound()) - //if(!uBound) - continue; - else - return 0; - } - return 1; -} - - -int TestArrayShape(SgSymbol *ar) -{ - int i; - SgExpression *esize = NULL; - for(i=1; i<=Rank(ar); i++) - { - //calculating size of i-th dimension - esize = ReplaceParameter(ArrayDimSize(ar, i)); - //if(err && esize && esize->variant()==STAR_RANGE) - // return 0; //Error("Assumed-size array: %s",ar->identifier(),162,stmt); - if(!esize || !esize->isInteger()) - return 0; - } - return 1; -} - -SgSymbol *ArraySymbolInHostHandler(SgSymbol *ar, SgStatement *scope) -{ - SgSymbol *soff; - SgExpression *edim; - int rank, i; - - rank = Rank(ar); - soff = ArraySymbol(ar->identifier(), ar->type()->baseType(), NULL, scope); - if (!options.isOn(C_CUDA) && !ExplicitShape(isSgArrayType(ar->type())->getDimList())) - Error("Illegal array bound of private array %s", ar->identifier(), 442, dvm_parallel_dir); - - for (i = 0; i < rank; i++) - { - edim = ((SgArrayType *)(ar->type()))->sizeInDim(i); - //if( IS_BY_USE(ar) || !fromUsesList(edim) && !fromModule(edim) ) - // edim = CalculateArrayBound(edim, ar, 1); - ((SgArrayType *)(soff->type()))->addRange(edim->copy()); - } - return(soff); -} - -void DeclareArrayCoefficients(SgStatement *after) -{ - symb_list *sl; - SgStatement *dst; - SgExpression *e, *el; - int i, rank; - coeffs *c; - - for (sl = acc_array_list, el = NULL; sl; sl = sl->next) - { - c = AR_COEFFICIENTS(sl->symb); - rank = Rank(sl->symb); - for (i = 2; i <= rank; i++) - { // doAssignTo_After(new SgVarRefExp(*(c->sc[i])), header_ref(sl->symb,i)); - e = new SgExprListExp(*(c->sc[i])->makeDeclExpr()); - e->setRhs(el); - el = e; - } - e = opt_base ? (&(*header_ref(sl->symb, rank + 2) + *new SgVarRefExp(*(c->sc[1])))) : header_ref(sl->symb, rank + 2); - //doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), e); - e = new SgExprListExp(*(c->sc[rank + 2])->makeDeclExpr()); - e->setRhs(el); - el = e; - } - if (el) - { - dst = after->expr(0)->lhs()->symbol()->makeVarDeclStmt(); // creates INTEGER[*8] name, then name is removed - dst->setExpression(0, *el); - after->insertStmtAfter(*dst); - } - -} - -SgExpression *CreateBaseMemoryList() -{ - symb_list *sl; - SgExpression *base_list, *l, *el; - SgValueExp M0(0); - SgExpression *MD = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); - - // create memory base list looking through the acc_array_list - - sl = USE_STATEMENTS_ARE_REQUIRED ? MergeSymbList(acc_array_list_whole, acc_array_list) : acc_array_list; - if (!sl) return(NULL); - base_list = new SgExprListExp(*new SgArrayRefExp(*baseMemory(sl->symb->type()->baseType()))); - - for (sl = sl->next; sl; sl = sl->next) - { - for (l = base_list; l; l = l->rhs()) - { //printf("%d %d\n",sl->symb->type()->baseType()->variant(),l->lhs()->symbol()->type()->baseType()->variant()); - if (baseMemory(sl->symb->type()->baseType()) == l->lhs()->symbol()) - //baseMemory(l->lhs()->symbol()->type()->baseType()) ) - break; - } - - if (!l) - { - el = new SgExprListExp(*new SgArrayRefExp(*baseMemory(sl->symb->type()->baseType()))); - el->setRhs(base_list); - base_list = el; - } - } - - for (l = base_list; l; l = l->rhs()) - { - SgSymbol *sb = &(l->lhs()->symbol()->copy()); - SYMB_SCOPE(sb->thesymb) = cur_in_source->controlParent()->thebif; - SgArrayType *typearray = new SgArrayType(*l->lhs()->symbol()->type()->baseType()); - typearray->addRange(*MD); //Dimension(NULL,1,1); - sb->setType(typearray); - l->lhs()->setSymbol(sb); - } - return(base_list); -} - -SgExpression *CreateArrayAdrList(SgSymbol *header_symb, SgStatement *st_host) -{ - symb_list *sl; - SgExpression *adr_list = NULL; - int i, rank; - SgSymbol *sarg, *hl; - - // create array address list looking through the acc_array_list - sl = acc_array_list; - if (!sl) return(NULL); - adr_list = new SgExprListExp(*new SgArrayRefExp(*DummyDvmArraySymbol(sl->symb, header_symb))); - - for (sl = acc_array_list->next, hl = header_symb->next(); sl; sl = sl->next, hl = hl->next()) - { - SgArrayType *typearray = new SgArrayType(*sl->symb->type()->baseType()); - rank = Rank(sl->symb); - for (i = 1; i < rank; i++) - typearray->addRange(*Dimension(hl, i, rank)); - typearray->addRange(*Dimension(hl, rank, rank)); - - sarg = DummyDvmArraySymbol(sl->symb, hl); - adr_list->setRhs(*new SgExprListExp(*new SgArrayRefExp(*sarg))); - adr_list = adr_list->rhs(); - /* - el = new SgExprListExp(*new SgArrayRefExp(*sarg)); - el->setRhs(adr_list); - adr_list = el; - */ - } - return(adr_list); -} - -SgSymbol *HeaderSymbolForHandler(SgSymbol *ar) -{ - SgSymbol *shead; - if(HEADER_FOR_HANDLER(ar)) - shead = *HEADER_FOR_HANDLER(ar); - else - { - shead = DummyDvmHeaderSymbol(ar,cur_func); - SgSymbol **s_attr = new (SgSymbol *); - *s_attr = shead; - ar->addAttribute(HANDLER_HEADER, (void*)s_attr, sizeof(SgSymbol *)); - } - return (shead); -} - -SgExpression *FirstArrayElementSubscriptsForHandler(SgSymbol *ar) -{//generating reference AR(L1,...,Ln), where Li - lower bound of i-th dimension - // Li = AR_header(rank+2+i) - int i; - SgExpression *esl=NULL, *el=NULL; - SgExpression *bound[MAX_DIMS], *ebound; - - SgSymbol *shead = HeaderSymbolForHandler(ar); - int rank = Rank(ar); - for (i = rank; i; i--) - bound[i-1] = Calculate(LowerBound(ar,i-1)); - for (i = rank; i; i--) { - if(bound[i-1]->isInteger() && !IS_BY_USE(ar)) - ebound = new SgValueExp(bound[i-1]->valueInteger()); - else - ebound = new SgArrayRefExp(*shead,*new SgExprListExp(*new SgValueExp(rank+2+i))); - esl = new SgExprListExp(*ebound); - esl->setRhs(el); - el = esl; - } - return(el); -} - -SgExpression *FirstArrayElementSubscriptsOfPrivateArray(SgSymbol *s) -{//generating reference AR(L1,...,Ln), where Li - lower bound of i-th dimension for kernel in C_Cuda - // Li - is constant or dummy argument reference - SgExpression *elist = NULL, *var; -/* - if (!TestArrayShape(s)) - { - var = ElementOfPrivateList(s); - SgExpression **eatr = (SgExpression **) var->lhs()->attributeValue(0, L_BOUNDS); - SgExpression *ela; - for (ela = *eatr; ela->rhs(); ela = ela->rhs()) - { - SgExpression *ed = new SgVarRefExp(ela->lhs()->lhs()->symbol()); - elist = AddListToList(new SgExprListExp(*ed), elist); - } - } - else - { - for (int i=0; iaddAttribute(NULL_SUBSCRIPTS, (void*)1, 0); - return elist; -} - -SgSymbol *DummyDvmHeaderSymbol(SgSymbol *ar, SgStatement *st_hedr) -{ - SgArrayType *typearray = new SgArrayType(*FortranDvmType()); - typearray->addRange(*new SgValueExp(2*Rank(ar) + 2)); - char *name = options.isOn(O_HOST) ? Header_DummyArgName(ar) : ar->identifier(); - return (new SgSymbol(VARIABLE_NAME, name, *typearray, *st_hedr)); -} - -SgSymbol *DummyDvmArraySymbol(SgSymbol *ar, SgSymbol *header_symb) -{ - SgArrayType *typearray = new SgArrayType(*ar->type()->baseType()); - int i, rank; - rank = Rank(ar); - for (i = 1; i < rank; i++) - typearray->addRange(*Dimension(header_symb, i, rank)); - typearray->addRange(*Dimension(header_symb, rank, rank)); - return(new SgSymbol(VARIABLE_NAME, ar->identifier(), *typearray, *header_symb->scope())); -} - -SgSymbol *DummyDvmBufferSymbol(SgSymbol *ar, SgSymbol *header_symb) -{ - SgArrayType *typearray = new SgArrayType(*ar->type()->baseType()); - typearray->addRange(*Dimension(header_symb, 1, 1)); - return(new SgSymbol(VARIABLE_NAME, ar->identifier(), *typearray, *header_symb->scope())); -} - -SgExpression *Dimension(SgSymbol *hs, int i, int rank) -{ - SgValueExp M0(0), M1(1); - //SgExpression *MD = new SgExpression(DDOT,&M0.copy(),new SgKeywordValExp("*"),NULL); - SgExpression *me; - - - if (i == rank) - return(new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL)); - if (i == 1) - return(new SgExpression(DDOT, &M0.copy(), &(*new SgArrayRefExp(*hs, *new SgValueExp(rank)) - M1), NULL)); - //me = new SgArrayRefExp(*hs,*new SgValueExp(rank)); - //for(j=rank; j>rank-i+2; j--) - //me = &(*me * *new SgArrayRefExp(*hs,*new SgValueExp(j-1)) ); - me = new SgArrayRefExp(*hs, *new SgValueExp(rank - i + 2)); - return(new SgExpression(DDOT, &M0.copy(), &(*new SgArrayRefExp(*hs, *new SgValueExp(rank - i + 1)) / (*me) - M1), NULL)); - -} - -SgExpression *ConstRef_F95(int ic) -{ - SgExpression *kind, *ce; - - ce = new SgValueExp(ic); - if (len_DvmType && !type_with_len_DvmType) - { - type_with_len_DvmType = new SgType(T_INT); - kind = new SgValueExp(len_DvmType); - TYPE_KIND_LEN(type_with_len_DvmType->thetype) = kind->thellnd; - } - if (len_DvmType) - ce->setType(type_with_len_DvmType); - - return(ce); -} - -SgExpression *DvmType_Ref(SgExpression *e) -{ - if (e->variant() == INT_VAL) - return(ConstRef_F95(((SgValueExp *)e)->intValue())); - return( len_DvmType ? TypeFunction(SgTypeInt(),e,new SgValueExp(len_DvmType) ) : e); -} - -SgSymbol *indexArraySymbol(SgSymbol *ar) -{ - if (index_array_symb) - return(index_array_symb); - - //creating new symbol - - index_array_symb = ArraySymbol("indexArray", FortranDvmType(), new SgValueExp(MaxArrayRank()), cur_in_source->controlParent()); - - return(index_array_symb); - -} - -char *Header_DummyArgName(SgSymbol *s) -{ - char *name; - - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); - sprintf(name, "%s_head", s->identifier()); - return(TestAndCorrectName(name)); -} - -int ParLoopRank() -{ - int nloop; - SgExpression *dovar; - - // looking through the do_variables list - - for (dovar = dvm_parallel_dir->expr(2), nloop = 0; dovar; dovar = dovar->rhs()) - nloop++; - return(nloop); -} - -int MaxArrayRank() -{ - symb_list *sl; - int max_rank = 0; - int rank; - for (sl = acc_array_list; sl; sl = sl->next) - { - rank = Rank(sl->symb); - max_rank = (max_rank < rank) ? rank : max_rank; - } - return(max_rank); -} - -int OneSteps(int nl, SgStatement *nest) -{ - int i; - SgExpression *dostep, *ec; - SgStatement *stdo; - // looking through the loop nest - - for (stdo = nest, i = nl; i; stdo = stdo->lexNext(), i--) - { - dostep = ((SgForStmt *)stdo)->step(); - if (!dostep) continue; //by default do_step == 1 - ec = Calculate(dostep); - if (ec->isInteger() && ec->valueInteger() == 1) // do_step == 1 - continue; - break; - } - if (i == 0) //all do_step == 1 - return(1); - else - return(0); -} - -int IConstStep(SgStatement *stdo) -{ - SgExpression *dostep, *ec; - dostep = ((SgForStmt *)stdo)->step(); - if (!dostep) - return(1); //by default do_step == 1 - if (((SgForStmt *)stdo)->start()->variant() == ADD_OP) //redblack scheme - return(1); - if (dostep->variant() == INT_VAL) - return(((SgValueExp *)dostep)->intValue()); //NODE_INT_CST_LOW (dostep->thellnd); - ec = Calculate(dostep); - if (ec->isInteger()) - return(ec->valueInteger()); - if(!options.isOn(NO_BL_INFO)) - err("Non constant do step is not implemented yet", 593, stdo); - return(0); -} - - -int TestParLoopSteps(SgStatement *first_do, int n) -{ - int i; - SgExpression *dostep, *ec; - SgStatement *stdo; - for (i = n, stdo = first_do; i; i--, stdo = stdo->lexNext()) - { - dostep = ((SgForStmt *)stdo)->step(); - if (!dostep) - continue; //by default do_step == 1 - if (((SgForStmt *)stdo)->start()->variant() == ADD_OP) //redblack scheme - continue; - if (dostep->variant() == INT_VAL) - { - if (((SgValueExp *)dostep)->intValue() == 1) - continue; - else - return(0); - } - ec = Calculate(dostep); - if (ec->isInteger()) - { - if (ec->valueInteger() == 1) - continue; - else - return(0); - } - return(0); - } - return(1); -} - -int IntStepForHostHandler(SgExpression *dostep) -{ - SgExpression *ec; - if (!dostep) - return(1); //by default do_step == 1 - ec = Calculate(ReplaceParameter(dostep)); - if (ec->isInteger()) - return(ec->valueInteger()); - return(0); -} - -void ConstantSubstitutionInTypeSpec(SgExpression *e) -{ - SgType *t = e->type(); - if(!TYPE_KIND_LEN(t->thetype)) return; - if(t->selector()->variant()==INT_VAL) return; - SgType *new_t= &(t->copy()); - TYPE_KIND_LEN(new_t->thetype) = ReplaceParameter(new_t->selector())->thellnd; - e->setType(new_t); - return; -} - -char * BoundName(SgSymbol *s, int i, int isLower) -{ - char *name = new char[strlen(s->identifier()) + 13]; - if(isLower) - sprintf(name, "lbound%d_%s", i, s->identifier()); - else - sprintf(name, "ubound%d_%s", i, s->identifier()); - name = TestAndCorrectName(name); - return(name); -} - -SgSymbol *DummyBoundSymbol(SgSymbol *rv, int i, int isLower, SgStatement *st_hedr) -{ - SgExpression *bound; - bound = isLower ? Calculate(LowerBound(rv,i)) : Calculate(UpperBound(rv,i)); - if(bound->isInteger()) - return NULL; - return(new SgVariableSymb(BoundName(rv, i+1, isLower), *SgTypeInt(), *st_hedr)); -} - -SgExpression *CreateDummyBoundListOfArray(SgSymbol *ar, SgSymbol *new_ar, SgStatement *st_hedr) -{ - SgExpression *sl = NULL; - SgSymbol *low_s, *upper_s; - SgExpression *up_bound, *low_bound; - SgArrayType *typearray = isSgArrayType(new_ar->type()); - - for(int i=0; iaddRange(*new SgExpression(DDOT, low_s ? low_bound : Calculate(LowerBound(ar,i)), upper_s ? up_bound : Calculate(UpperBound(ar,i))) -); - } - return sl; -} - -SgExpression * DummyListForReductionArrays(SgStatement *st_hedr) -{ - reduction_operation_list *rl; - SgExpression *dummy_list = NULL; - for (rl = red_struct_list; rl; rl = rl->next) - { - if (rl->redvar_size != 0) - { - SgSymbol *ar = rl->redvar; - SgType *tp = isSgArrayType(ar->type()) ? ar->type()->baseType() : ar->type(); - SgSymbol *new_ar = ArraySymbol(ar->identifier(), tp, NULL, st_hedr); - rl->red_host = new_ar; - dummy_list = AddListToList(dummy_list, CreateDummyBoundListOfArray(ar, new_ar, st_hedr)); - } - if (rl->locvar) - { - SgSymbol *ar = rl->locvar; - SgType *tp = isSgArrayType(ar->type()) ? ar->type()->baseType() : ar->type(); - SgSymbol *new_ar = ArraySymbol(ar->identifier(), tp, NULL, st_hedr); - rl->loc_host = new_ar; - dummy_list = AddListToList(dummy_list, CreateDummyBoundListOfArray(ar, new_ar, st_hedr)); - } - } - return dummy_list; -} - -SgExpression * DummyListForPrivateArrays(SgStatement *st_hedr) -{ - SgExpression *dummy_list = NULL, *pl; - SgSymbol *s; - for (pl=private_list; pl;pl=pl->rhs()) - { - s = pl->lhs()->symbol(); - if (isSgArrayType(s->type())) - { - SgType *tp = s->type()->baseType(); - SgSymbol *new_ar = ArraySymbol(s->identifier(), tp, NULL, st_hedr); - dummy_list = AddListToList(dummy_list, CreateDummyBoundListOfArray(s, new_ar, st_hedr)); - SgSymbol **satr = new (SgSymbol *); - *satr = new_ar; - pl->lhs()->addAttribute(PRIVATE_ARRAY, (void *)satr, sizeof(SgSymbol *) ); - } - } - return dummy_list; -} - -/***************************************************************************************/ -/*ACC*/ -/* Creating and Inserting New Statement in the Program */ -/* (Fortran Language, .cuf file) */ -/***************************************************************************************/ - -SgSymbol *SyncthreadsSymbol() -{ - if (sync_proc_symb) - return(sync_proc_symb); - if (options.isOn(C_CUDA)) - sync_proc_symb = new SgSymbol(PROCEDURE_NAME, "__syncthreads", *mod_gpu); - else - sync_proc_symb = new SgSymbol(PROCEDURE_NAME, "syncthreads", *mod_gpu); - return(sync_proc_symb); -} - -void CudaVars() -{ - if (s_threadidx) - return; - s_threadidx = new SgVariableSymb("threadIdx", *t_dim3, *mod_gpu); - s_blockidx = new SgVariableSymb("blockIdx", *t_dim3, *mod_gpu); - s_blockdim = new SgVariableSymb("blockDim", *t_dim3, *mod_gpu); - s_griddim = new SgVariableSymb("gridDim", *t_dim3, *mod_gpu); - s_warpsize = new SgVariableSymb("warpSize", *SgTypeInt(), *mod_gpu); -} - -void SymbolOfCudaOffsetType() -{ - s_offset_type = new SgVariableSymb("symb_offset", *CudaOffsetType(), *mod_gpu); -} - -void SymbolOfCudaIndexType() -{ - s_of_cudaindex_type = new SgVariableSymb("symb_cudaindex", *CudaIndexType(), *mod_gpu); -} - -void KernelWorkSymbols() -{ - char *name; - - if (s_ibof) return; - name = TestAndCorrectName("ibof"); - s_ibof = new SgVariableSymb(name, *SgTypeInt(), *mod_gpu); - if (s_blockDims) return; - name = TestAndCorrectName("blockDims"); - s_blockDims = new SgVariableSymb(name, *SgTypeInt(), *mod_gpu); - return; -} - - -void KernelBloksSymbol() -{ - SgValueExp M1(1), M0(0); - SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), &M1.copy(), NULL); - - if (s_blocks_k) return; - - if (options.isOn(C_CUDA)) - { - s_CudaIndexType_k = new SgSymbol(TYPE_NAME, "CudaIndexType", *mod_gpu); - CudaIndexType_k = C_Derived_Type(s_CudaIndexType_k); - s_blocks_k = ArraySymbol(TestAndCorrectName("blocks"), CudaIndexType_k, (SgExpression *)&M0, mod_gpu); - s_rest_blocks = new SgVariableSymb(TestAndCorrectName("rest_blocks"), CudaIndexType_k, mod_gpu); - s_cur_blocks = new SgVariableSymb(TestAndCorrectName("cur_blocks"), CudaIndexType_k, mod_gpu); - s_add_blocks = new SgVariableSymb(TestAndCorrectName("add_blocks"), CudaIndexType_k, mod_gpu); - } - else - { - s_blocks_k = ArraySymbol(TestAndCorrectName("blocks"), CudaIndexType(), M01, mod_gpu); - s_rest_blocks = new SgVariableSymb(TestAndCorrectName("rest_blocks"), CudaIndexType(), mod_gpu); - s_cur_blocks = new SgVariableSymb(TestAndCorrectName("cur_blocks"), CudaIndexType(), mod_gpu); - s_add_blocks = new SgVariableSymb(TestAndCorrectName("add_blocks"), CudaIndexType(), mod_gpu); - } - return; -} - -void KernelBaseMemorySymbols() -{ - SgValueExp M1(1), M0(0); - SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), &M1.copy(), NULL); - //SgArrayType *typearray; - - Imem_k = ArraySymbol("i0000m", SgTypeInt(), M01, mod_gpu); - Rmem_k = ArraySymbol("r0000m", SgTypeFloat(), M01, mod_gpu); - Dmem_k = ArraySymbol("d0000m", SgTypeDouble(), M01, mod_gpu); - - Lmem_k = ArraySymbol("l0000m", SgTypeBool(), M01, mod_gpu); - Cmem_k = ArraySymbol("c0000m", SgTypeComplex(current_file), M01, mod_gpu); - DCmem_k = ArraySymbol("dc000m", SgTypeDoubleComplex(current_file), M01, mod_gpu); - Chmem_k = ArraySymbol("ch000m", SgTypeChar(), M01, mod_gpu); -} - -SgSymbol *FormalLocationSymbol(SgSymbol *locvar, int i) -{ - SgType *type; - char *name; - - name = (char *)malloc((unsigned)(strlen(locvar->identifier()) + 6)); - sprintf(name, "%s__%d", locvar->identifier(), i); - type = isSgArrayType(locvar->type()) ? (locvar->type()->baseType()) : locvar->type(); - if (options.isOn(C_CUDA)) - type = C_Type(type); - return(new SgVariableSymb(name, *type, *kernel_st)); -} - -SgSymbol *FormalDimSizeSymbol(SgSymbol *var, int i) -{ - SgType *type; - - type = options.isOn(C_CUDA) ? C_DvmType() : FortranDvmType(); - return(new SgVariableSymb(DimSizeName(var, i), *type, *kernel_st)); -} - -SgSymbol *FormalLowBoundSymbol(SgSymbol *var, int i) -{ - SgType *type; - - type = options.isOn(C_CUDA) ? C_DvmType() : FortranDvmType(); - return(new SgVariableSymb(BoundName(var, i, 1), *type, *kernel_st)); -} - -SgType *Type_For_Red_Loc(SgSymbol *redsym, SgSymbol *locsym, SgType *redtype, SgType *loctype) -{ - char *tname; - tname = (char *)malloc((unsigned)(strlen(redsym->identifier()) + (strlen(locsym->identifier()) + 7))); - sprintf(tname, "%s_%s_type", redsym->identifier(), locsym->identifier()); - - SgSymbol *stype = new SgSymbol(TYPE_NAME, tname, *kernel_st); - SgFieldSymb *sred = new SgFieldSymb(redsym->identifier(), *redtype, *stype); - SgFieldSymb *sloc = new SgFieldSymb(locsym->identifier(), *loctype, *stype); - - SYMB_NEXT_FIELD(sred->thesymb) = sloc->thesymb; - - SYMB_NEXT_FIELD(sloc->thesymb) = NULL; - - SgType *tstr = new SgType(T_STRUCT); - TYPE_COLL_FIRST_FIELD(tstr->thetype) = sred->thesymb; - stype->setType(tstr); - - SgType *td = new SgType(T_DERIVED_TYPE); - TYPE_SYMB_DERIVE(td->thetype) = stype->thesymb; - TYPE_SYMB(td->thetype) = stype->thesymb; - - return(td); -} - -SgSymbol *RedBlockSymbolInKernel(SgSymbol *s, SgType *type) -{ - char *name; - SgSymbol *sb; - SgValueExp M0(0); - SgExpression *MD = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); - SgArrayType *typearray; - SgType *tp; - int i = 1; - if (!type) - { - tp = s->type()->baseType(); - if (options.isOn(C_CUDA)) - tp = C_Type(tp); - typearray = new SgArrayType(*tp); - } - else if (isSgArrayType(type)) - typearray = (SgArrayType *)&(type->copy()); - else - typearray = new SgArrayType(*type); - - if (!options.isOn(C_CUDA)) - typearray->addRange(*MD); - else - typearray->addDimension(NULL); - - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 8)); - - sprintf(name, "%s_block", s->identifier()); - - while (isSameNameShared(name)) - sprintf(name, "%s_block%d", s->identifier(), i++); - - sb = new SgVariableSymb(name, *typearray, *kernel_st); // scope may be mod_gpu - shared_list = AddToSymbList(shared_list, sb); - - return(sb); -} - -SgSymbol *RedFunctionSymbolInKernel(char *name) -{ - return(new SgFunctionSymb(FUNCTION_NAME, name, *SgTypeInt(), *kernel_st)); -} - -SgSymbol *isSameNameShared(char *name) -{ - symb_list *sl; - for (sl = shared_list; sl; sl = sl->next) - { - if (!strcmp(sl->symb->identifier(), name)) - return(sl->symb); - } - return(NULL); -} - - -SgSymbol *IndVarInKernel(SgSymbol *s) -{ - char *name; - SgSymbol *soff; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 4)); - sprintf(name, "%s__1", s->identifier()); - soff = new SgVariableSymb(name, *IndexType(), *kernel_st); - return(soff); -} - -SgSymbol *IndexSymbolForRedVarInKernel(int i) -{ - char *name = new char[10]; - SgSymbol *soff; - - sprintf(name, "k_k%d", i); - soff = new SgVariableSymb(TestAndCorrectName(name), *IndexType(), *kernel_st); - return(soff); -} - -SgSymbol *RemoteAccessBufferInKernel(SgSymbol *ar, int rank) -{ - int i = 1; - int j; - int *index = new int; - char *name; - SgSymbol *sn; - SgArrayType *typearray; - - SgExpression *rnk = new SgValueExp(rank + DELTA); - name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 4 + 3 + 1)); - sprintf(name, "%s_rma", ar->identifier()); - typearray = new SgArrayType(*ar->type()->baseType()); - for (j = rank; j; j--) - typearray->addRange(*rnk); - while (isSameNameBuffer(name, rma->rml)) - sprintf(name, "%s_rma%d", ar->identifier(), i++); - sn = new SgVariableSymb(name, *typearray, *mod_gpu); - - *index = 1; - // adding the attribute (ARRAY_HEADER) to buffer symbol - sn->addAttribute(ARRAY_HEADER, (void*)index, sizeof(int)); - - return(sn); -} - -SgSymbol *DummyReplicatedArray(SgSymbol *ar, int rank) -{//int i = 1; - int j; - int *index = new int; - char *name; - SgSymbol *sn; - SgArrayType *typearray; - coeffs *scoef = new coeffs; - - SgExpression *rnk = new SgValueExp(rank + DELTA); - name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 1)); - sprintf(name, "%s", ar->identifier()); - typearray = new SgArrayType(*ar->type()->baseType()); - for (j = rank; j; j--) - typearray->addRange(*rnk); - sn = new SgVariableSymb(name, *typearray, *mod_gpu); - - *index = 1; - // adding the attribute (ARRAY_HEADER) to buffer symbol - sn->addAttribute(ARRAY_HEADER, (void*)index, sizeof(int)); - // creating variables used for optimisation buffer references in parallel loop - CreateCoeffs(scoef, ar); - - // adding the attribute (ARRAY_COEF) to buffer symbol - sn->addAttribute(ARRAY_COEF, (void*)scoef, sizeof(coeffs)); - - return(sn); -} - - -SgSymbol *isSameNameBuffer(char *name, SgExpression *rml) -{ - SgExpression *el; - rem_var *remv; - for (el = rml; el; el = el->rhs()) - { - remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); - if (remv && remv->buffer && !strcmp(remv->buffer->identifier(), name)) - return(remv->buffer); - } - return(NULL); -} -/* -coeffs *BufferCoeffs(SgSymbol *sbuf,SgSymbol *ar) -{int i,r,i0; -char *name; -coeffs *scoef = new coeffs; -r=Rank(ar); -i0 = opt_base ? 1 : 2; -//if(opt_loop_range) i0=0; -for(i=i0;i<=r+2;i++) -{ name = new char[80]; -sprintf(name,"%s%s%d",sbuf->identifier(),"000",i); -scoef->sc[i] = new SgVariableSymb(name, *SgTypeInt(), *cur_func); -//printf("%s",(scoef->sc[i])->identifier()); -} -scoef->use = 0; -return(scoef); -} -*/ - -SgSymbol *RedGridSymbolInKernel(SgSymbol *s, int n, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs, int is_red_or_loc_var) -{ - char *name; - SgSymbol *soff; - SgType *type; - SgValueExp M1(1), M0(0); - SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); - - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); - sprintf(name, "%s_grid", s->identifier()); - type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); - if (options.isOn(C_CUDA)) - type = C_Type(type); //C_PointerType(C_Type(type)); - if (is_red_or_loc_var == 1) // for reduction variable - { - if (n > 0) - { - if (options.isOn(C_CUDA)) - soff = ArraySymbol(name, type, (SgExpression *)&M0, kernel_st); - else - { - soff = ArraySymbol(name, type, new SgExpression(DDOT, &M0.copy(), &(*new SgVarRefExp(s_overall_blocks) - M1.copy()), NULL), kernel_st); - ((SgArrayType *)(soff->type()))->addRange(*new SgValueExp(n)); - } - } - else if (n < 0) - { - if (options.isOn(C_CUDA)) - soff = ArraySymbol(name, type, (SgExpression *)&M0, kernel_st); - else - { - SgExpression *sl, *bl; - soff = ArraySymbol(name, type, new SgExpression(DDOT, &M0.copy(), &(*new SgVarRefExp(s_overall_blocks) - M1.copy()), NULL), kernel_st); - ArrayTypeForRedVariableInKernel(s, soff->type(), dimSizeArgs, lowBoundArgs); - } - } - else - soff = options.isOn(C_CUDA) ? ArraySymbol(name, type, (SgExpression *)&M0, kernel_st) : ArraySymbol(name, type, M01, kernel_st); - } - else //for location variable - { - if (options.isOn(C_CUDA)) - soff = ArraySymbol(name, type, (SgExpression *)&M0, kernel_st); - else - { - soff = ArraySymbol(name, type, new SgValueExp(n), kernel_st); - ((SgArrayType *)(soff->type()))->addRange(*M01); - } - } - - return(soff); -} - -SgExpression * RangeOfRedArray(SgSymbol *s, SgExpression *lowBound, SgExpression *dimSize, int i) -{ - SgExpression *edim = ((SgArrayType *) s->type())->sizeInDim(i); - - if(edim->variant() != DDOT) - { - edim = Calculate(edim); - if (edim->variant() == INT_VAL) - return (edim); - else - return (&dimSize->copy()); - } - else - { - edim = new SgExpression(DDOT); - edim->setLhs(lowBound->copy()); - edim->setRhs(dimSize->copy()+lowBound->copy()-*new SgValueExp(1)); - return (edim); - } - -} - -void ArrayTypeForRedVariableInKernel(SgSymbol *s, SgType *type, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs) -{ - SgExpression *sl, *bl; - int i; - - for (sl = dimSizeArgs, bl = lowBoundArgs, i = 0; sl; sl = sl->rhs(), bl = bl->rhs(), i++) - ((SgArrayType *) type)->addRange(*RangeOfRedArray(s, bl->lhs(), sl->lhs(), i )); -} - -SgSymbol *RedInitValSymbolInKernel(SgSymbol *s, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs) -{ - char *name; - SgSymbol *soff; - SgType *type; - SgExpression *sl; - - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); - sprintf(name, "%s_init", s->identifier()); - type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); - //if (options.isOn(C_CUDA)) - // type = C_PointerType(C_Type(type)); - - soff = ArraySymbol(name, type, NULL, kernel_st); - ArrayTypeForRedVariableInKernel(s, soff->type(), dimSizeArgs, lowBoundArgs); - - return(soff); -} - -SgSymbol *RedVariableSymbolInKernel(SgSymbol *s, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs) -{ - char *name; - SgSymbol *soff; - SgType *type; - SgExpression *edim; - int i, rank; - rank = Rank(s); - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 1)); - sprintf(name, "%s", s->identifier()); - type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); - if (options.isOn(C_CUDA)) - type = C_Type(type); - if (rank > 0) - { - if (options.isOn(C_CUDA)) - { - type = C_PointerType(type); - return(new SgVariableSymb(name, *type, *kernel_st)); - } - soff = ArraySymbol(name, type, NULL, kernel_st); - } - else - return(new SgVariableSymb(name, *type, *kernel_st)); - if (!dimSizeArgs) - { - if (!options.isOn(C_CUDA)) - { - for (i = 0; i < rank; i++) - { - edim = ((SgArrayType *)(s->type()))->sizeInDim(i); - edim = CalculateArrayBound(edim, s, 0); - if (edim) - ((SgArrayType *)(soff->type()))->addRange(edim->copy()); - } - } - else - { - for (i = rank - 1; i >= 0; i--) - { - edim = ((SgArrayType *)(s->type()))->sizeInDim(i); - edim = CalculateArrayBound(edim, s, 0); - if (edim) - ((SgArrayType *)(soff->type()))->addRange(edim->copy()); - } - } - } - else - ArrayTypeForRedVariableInKernel(s, soff->type(), dimSizeArgs, lowBoundArgs); - - return(soff); -} - -SgSymbol *LocRedVariableSymbolInKernel(reduction_operation_list *rsl) -{ - SgType *declT; - - if (isSgArrayType(rsl->locvar->type())) - { - SgArrayType *arrT = new SgArrayType(*C_Type(rsl->locvar->type())); - arrT->addDimension(new SgValueExp(rsl->number)); - declT = arrT; - } - else - declT = C_Type(rsl->locvar->type()); - return (new SgVariableSymb(rsl->locvar->identifier(), *declT, *kernel_st)); -} - -SgSymbol *SymbolInKernel(SgSymbol *s) -{ - char *name; - SgSymbol *soff; - SgType *type; - SgExpression *edim; - int i, rank; - - if (!isSgArrayType(s->type())) //scalar variable - { - if (!options.isOn(C_CUDA)) - return s; - else - return new SgVariableSymb(s->identifier(), *C_Type(s->type()), *kernel_st); - } - rank = Rank(s); - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 1)); - sprintf(name, "%s", s->identifier()); - type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); - if (options.isOn(C_CUDA)) - type = C_Type(type); - soff = ArraySymbol(name, type, NULL, kernel_st); - if (!options.isOn(C_CUDA)) - for (i = 0; i < rank; i++) - { - edim = ((SgArrayType *)(s->type()))->sizeInDim(i); - edim = CalculateArrayBound(edim, s, 1); - if (edim) - ((SgArrayType *)(soff->type()))->addRange(edim->copy()); - } - else - for (i = rank - 1; i >= 0; i--) - { - edim = ((SgArrayType *)(s->type()))->sizeInDim(i); - edim = CalculateArrayBound(edim, s, 1); - if (edim) - ((SgArrayType *)(soff->type()))->addRange(edim->copy()); - } - - return(soff); -} - -SgExpression *CalculateArrayBound(SgExpression *edim, SgSymbol *ar, int flag_private) -{ - SgSubscriptExp *sbe; - SgExpression *low; - if (!edim && flag_private) - { - // Error("Illegal array bound of private/reduction array %s", ar->identifier(), 442, dvm_parallel_dir); - return (edim); - } - if ((sbe = isSgSubscriptExp(edim)) != NULL){ //DDOT - - if (!sbe->ubound() && flag_private) - { - // Error("Illegal array bound of private/reduction array %s", ar->identifier(), 442, dvm_parallel_dir); - return(edim); - } - - if (options.isOn(C_CUDA) && for_kernel) - { - low = CalculateArrayBound(sbe->lbound(), ar, flag_private); - if (!low) - low = new SgValueExp(1); - edim = CalculateArrayBound(&((sbe->ubound()->copy()) - (low->copy()) + *new SgValueExp(1)), ar, flag_private); - return(edim); - } - else - { - edim = new SgExpression(DDOT); - edim->setLhs(CalculateArrayBound(sbe->lbound(), ar, flag_private)); - edim->setRhs(CalculateArrayBound(sbe->ubound(), ar, flag_private)); - return(edim); - } - } - else - { - edim = Calculate(edim); - // if (edim->variant() != INT_VAL && flag_private ) - // Error("Illegal array bound of private/reduction array %s", ar->identifier(), 442, dvm_parallel_dir); - return (edim); - } -} - - -SgSymbol *LocalPartSymbolInKernel(SgSymbol *ar) -{ - char *name; - SgSymbol *s_part; - SgValueExp M0(0); - SgExpression *M2R = new SgExpression(DDOT, &M0.copy(), new SgValueExp(2 * Rank(ar) - 1), NULL); - name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 6)); - sprintf(name, "%s_part", ar->identifier()); - - s_part = ArraySymbol(name, CudaIndexType(), M2R, kernel_st); - return(s_part); -} - - -SgSymbol *LocalPartArray(SgSymbol *ar) -{ - local_part_list *pl; - for (pl = lpart_list; pl; pl = pl->next) - if (pl->dvm_array == ar) - return(pl->local_part); - //creating local part array - pl = new local_part_list; - pl->dvm_array = ar; - pl->local_part = LocalPartSymbolInKernel(ar); - pl->next = lpart_list; - lpart_list = pl; - return(pl->local_part); -} - -SgExpression *LocalityConditionInKernel(SgSymbol *ar, SgExpression *ei[]) -{ - SgExpression *cond; - int N, i; - SgSymbol *part; - - N = Rank(ar); - - // ar_part(0) .le. ei[N-1] .and. ar_part(1) .ge. ei[N-1] - // .and. ar_part(2) .le. ei[N-2] .and. ar_part(3) .ge. ei[N-2] - // . . . - // .and. ar_part(2*N-2) .le. ei[0] .and. ar_part(2*N-1) .ge. ei[0] - - part = LocalPartArray(ar); - - cond = &operator && (operator <= (*VECTOR_REF(part, 0), *ei[N - 1]), operator >= (*VECTOR_REF(part, 1), *ei[N - 1])); - for (i = 1; i < N; i++) - cond = &operator && (*cond, operator && (operator <= (*VECTOR_REF(part, 2 * i), *ei[N - 1 - i]), operator >= (*VECTOR_REF(part, 2 * i + 1), *ei[N - 1 - i]))); - - return(cond); - -} - -void InsertInKernel_NewStatementAfter(SgStatement *stat, SgStatement *current, SgStatement *cp) -{ - SgStatement *st; - - st = current; - if (current->variant() == LOGIF_NODE) // Logical IF - st = current->lexNext(); - if (cp->variant() == LOGIF_NODE) - LogIf_to_IfThen(cp); - st->insertStmtAfter(*stat, *cp); - cur_in_kernel = stat; -} - -SgExpression *ConditionForRedBlack(SgExpression *erb) -{ - return(&SgEqOp(*IandFunction(erb, new SgValueExp(1)), *new SgValueExp(0))); -} - -SgExpression *KernelCondition(SgSymbol *sind, SgSymbol *sblock, int level) -{ - SgExpression *cond; - int N; - // i .le. blocks(ibof + N), N = 1 + 2*level - - N = 1 + 2 * level; - cond = &operator <= (*new SgVarRefExp(sind), *blocksRef(sblock, N)); // *new SgArrayRefExp(*base, (*new SgVarRefExp(s_ibof)+(*new SgValueExp(N))) ) ); - return(cond); -} - -SgExpression *KernelCondition2(SgStatement *dost, int level) -{ - SgExpression *cond = NULL; - SgSymbol *sind = NULL; - int istep; - // .le. end_ - - sind = dost->symbol(); - istep = IConstStep(dost); - if (istep > 0) - cond = &operator <= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); - else if (istep < 0) - cond = &operator >= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); - else - { - SgExpression *eStepLt0 = &operator < (*new SgVarRefExp(s_loopStep[level - 1]), *new SgValueExp(0)); - SgExpression *eStepGt0 = &operator > (*new SgVarRefExp(s_loopStep[level - 1]), *new SgValueExp(0)); - SgExpression *eIndLeEnd = &operator <= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); - SgExpression *eIndGeEnd = &operator >= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); - - cond = &operator || (operator && (*eStepLt0,*eIndGeEnd), operator && (*eStepGt0,*eIndLeEnd)); - } - - return(cond); -} - -SgExpression *KernelConditionWithDoStep(SgStatement *stdo, SgSymbol *sblock, int level) -{ - SgExpression *cond = NULL; - SgSymbol *sind = stdo->symbol(); - int N, istep; - - // i .le. blocks(ibof + N), N = 1 + 2*level , do-step is literal constant > 0 - // i .ge. blocks(ibof + N), N = 1 + 2*level , do-step is literal constant < 0 - // ( .gt.0 and i .le. blocks(ibof+N)) .or. ( .lt.0 and i .ge. blocks(ibof+N)), otherwise - - N = 1 + 2 * level; - //do_step = ((SgForStmt *)stdo)->step(); - istep = IConstStep(stdo); - if (istep >= 0) - cond = &operator <= (*new SgVarRefExp(sind), *blocksRef(sblock, N)); - else if (istep < 0) - cond = &operator >= (*new SgVarRefExp(sind), *blocksRef(sblock, N)); - //else !!! not implemented - - return(cond); -} - - -SgStatement *doIfThenConstrForKernel(SgExpression *cond, SgStatement *if_st) -{ - SgStatement *if_res = NULL; - // SgExpression *ea; - // creating - // IF ( ) THEN - // - // ENDIF - // - - if_res = new SgIfStmt(*cond, *if_st); - - // ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(if_res); -} - - -void CreateGPUModule() -{ - SgStatement *fileHeaderSt = NULL; - SgStatement *st_mod = NULL, *st_end = NULL; - - fileHeaderSt = current_file->firstStatement(); - if (mod_gpu_symb) - return; - - mod_gpu_symb = GPUModuleSymb(fileHeaderSt); - - st_mod = new SgStatement(MODULE_STMT); - st_mod->setSymbol(*mod_gpu_symb); - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*mod_gpu_symb); - fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); - st_mod->insertStmtAfter(*st_end, *st_mod); - //!!!st_use = new SgStatement(USE_STMT); - //!!!st_use->setSymbol(*CudaforSymb(fileHeaderSt)); - //!!!st_mod->insertStmtAfter(*st_use,*st_mod); - if (options.isOn(C_CUDA)) - st_mod->insertStmtAfter(*new SgStatement(COMMENT_STAT), *st_mod); - else - st_mod->insertStmtAfter(*new SgStatement(CONTAINS_STMT), *st_mod); - mod_gpu = st_mod; - cur_in_mod = st_mod->lexNext(); - //cur_in_mod = options.isOn(C_CUDA) ? st_mod : st_mod->lexNext(); // contains statement or module statement - mod_gpu_end = st_end; // end of module - - CudaVars(); - SymbolOfCudaIndexType(); - - KernelBaseMemorySymbols(); - KernelBloksSymbol(); - KernelWorkSymbols(); - return; -} - -//--------------------------------------------------------------------------------- -// create CUDA kernel -SgStatement *CreateLoopKernel(SgSymbol *skernel, SgType *indexTypeInKernel) -{ - int nloop; - SgStatement *st = NULL, *st_end = NULL; - SgExpression *fe = NULL; - SgSymbol *s_red_count_k = NULL; - - if (!skernel) - return(NULL); - nloop = ParLoopRank(); - - // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda - // creating Header and End Statement of Kernel - if (options.isOn(C_CUDA)) - { - kernel_st = Create_C_Kernel_Function(skernel); - fe = kernel_st->expr(0); - } - else - kernel_st = CreateKernelProcedure(skernel); - - kernel_st->addComment(LoopKernelComment()); - st_end = kernel_st->lexNext(); - cur_in_kernel = st = kernel_st; - - // creating variables and making structures for reductions - CompleteStructuresForReductionInKernel(); - - if (red_list) - s_red_count_k = RedCountSymbol(kernel_st); - - if (options.isOn(NO_BL_INFO)) - { - BeginEndBlocksSymbols(nloop); - } - - // create dummy argument list of kernel: - if (options.isOn(C_CUDA)) - fe->setLhs(CreateKernelDummyList(NULL, indexTypeInKernel)); - else - // create dummy argument list and add it to kernel header statement (Fortran-Cuda) - kernel_st->setExpression(0, *CreateKernelDummyList(s_red_count_k, indexTypeInKernel)); - - // generating block of index variables calculation - if (!options.isOn(NO_BL_INFO)) - { - st = Assign_To_ibof(nloop); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - } - - // generating assign statements for MAXLOC, MINLOC reduction operations and array reduction operations - if (red_list) - Do_Assign_For_Loc_Arrays(); //the statements are inserted after kernel_st - - - // looking through the loop nest - // generate block to calculate values of thread's loop variables - //vl = stmt->expr(2); // do_variables list - CreateBlockForCalculationThreadLoopVariables(); - - for_kernel = 1; - - // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables - { - SgStatement *stk, *last, *block, *st; - SaveLineNumbers(loop_body); - block = CreateIfForRedBlack(loop_body, nloop); - last = cur_in_kernel->lexNext(); - - cur_in_kernel->insertStmtAfter(*block, *cur_in_kernel); //cur_in_kernel is innermost IF statement - if (options.isOn(C_CUDA)) - block->addComment("// Loop body"); - else - block->addComment("! Loop body\n"); - - // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) - stk = (block != loop_body) ? last->lexPrev()->lexPrev() : last->lexPrev(); - - if (stk->variant() == CONTROL_END) - { - if (stk->hasLabel() || stk == loop_body) // when body of DO_ENDDO loop is empty, stk == loop_body - stk->setVariant(CONT_STAT); - else - { - st = stk->lexPrev(); - stk->extractStmt(); - stk = st; - } - } - ReplaceExitCycleGoto(block, stk); - - last = cur_st; - - TranslateBlock(cur_in_kernel); - - if (options.isOn(C_CUDA)) - { - swapDimentionsInprivateList(); - std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); - Translate_Fortran_To_C(cur_in_kernel, cur_in_kernel->lastNodeOfStmt(), zero, 0); - } - - cur_st = last; - } - - // generating reduction calculation blocks - if (red_list) - CreateReductionBlocks(st_end, nloop, red_list, s_red_count_k); - - // make declarations - if (options.isOn(C_CUDA)) - MakeDeclarationsForKernel_On_C(indexTypeInKernel); - else // Fortran-Cuda - MakeDeclarationsForKernel(s_red_count_k, indexTypeInKernel); - - // inserting IMPLICIT NONE - if (!options.isOn(C_CUDA)) // Fortran-Cuda - kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(kernel_st, skernel, 1); - for_kernel = 0; - - return kernel_st; -} - -SgExpression *CreateKernelDummyList(SgSymbol *s_red_count_k, std::vector &lowI, std::vector &highI, std::vector &stepI) -{ - SgExpression *arg_list, *ae; - //SgExpression *eln = new SgExprListExp(); - //int pl_rank = ParLoopRank(); - - arg_list = NULL; - - arg_list = AddListToList(CreateArrayDummyList(), CreateRedDummyList()); - // base_ref + ... - // + [+red_var_2+...+red_var_M] + _grid [ + ...] - - if (s_red_count_k) //[+ 'red_count'] - { - ae = new SgExprListExp(*new SgVarRefExp(s_red_count_k)); - arg_list = AddListToList(arg_list, ae); - } - //[+ 'overall_blocks'] - if (s_overall_blocks) - { - ae = new SgExprListExp(*new SgVarRefExp(s_overall_blocks)); - arg_list = AddListToList(arg_list, ae); - } - if (uses_list) - arg_list = AddListToList(arg_list, CreateUsesDummyList()); //[+ ] - if (private_list) - arg_list = AddListToList(arg_list, CreatePrivateDummyList()); //[+ dummys for private arrays ] - for (size_t i = 0; i < lowI.size(); ++i) - { - ae = new SgExprListExp(*new SgVarRefExp(lowI[i])); - arg_list = AddListToList(arg_list, ae); - ae = new SgExprListExp(*new SgVarRefExp(highI[i])); - arg_list = AddListToList(arg_list, ae); - ae = new SgExprListExp(*new SgVarRefExp(stepI[i])); - arg_list = AddListToList(arg_list, ae); - } - return(arg_list); -} - -void MakeDeclarationsForKernelGpuO1(SgSymbol *red_count_symb, SgType *idxTypeInKernel) -{ - SgExpression *var; - SgStatement *st; - - // declare called functions - DeclareCalledFunctions(); - - // declare index variablex for reduction array - for (var = kernel_index_var_list; var; var = var->rhs()) - { - st = var->lhs()->symbol()->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*st); - } - - // declare do_variables - DeclareDoVars(); - - // declare private(local in kernel) variables - DeclarePrivateVars(idxTypeInKernel); - - // declare dummy arguments: - // declare reduction dummy arguments - DeclareDummyArgumentsForReductions(red_count_symb, idxTypeInKernel); - - // declare array coefficients - //TODO: add type - DeclareArrayCoeffsInKernel(NULL); - - // declare bases for arrays - DeclareArrayBases(); - - // declare variables, used in loop - DeclareUsedVars(); -} - -void MakeDeclarationsForKernel_On_C_GpuO1() -{ - // declare do_variables - DeclareDoVars(); - - // declare private(local in kernel) variables - DeclarePrivateVars(); - - // declare variables, used in loop and passed by reference: - // & = *p_; - DeclareUsedVars(); -} - -// TODO: replace type CudaIndexType by __indexTypeInt and __indexTypeLLong -SgStatement *CreateLoopKernel(SgSymbol *skernel, AnalyzeReturnGpuO1 &infoGpuO1, SgType *idxTypeInKernel) // create CUDA kernel with gpuO1 -{ - int nloop; - SgStatement *st, *st_end; - SgExpression *fe = NULL; - SgSymbol *s_red_count_k = NULL; - - if (!skernel) - return(NULL); - nloop = ParLoopRank(); - - // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda - // creating Header and End Statement of Kernel - if (options.isOn(C_CUDA)) - { - kernel_st = Create_C_Kernel_Function(skernel); - fe = kernel_st->expr(0); - } - else - kernel_st = CreateKernelProcedure(skernel); - - kernel_st->addComment(LoopKernelComment()); - st_end = kernel_st->lexNext(); - cur_in_kernel = st = kernel_st; - - // creating variables and making structures for reductions - CompleteStructuresForReductionInKernel(); - - if (red_list) - s_red_count_k = RedCountSymbol(kernel_st); - - std::vector idxs; - SgExpression *expr = dvm_parallel_dir->expr(2); - while (expr) - { - idxs.push_back(expr->lhs()->symbol()); - expr = expr->rhs(); - } - int InternalPosition = -1; - for (size_t i = 0; i < infoGpuO1.allArrayGroup.size(); ++i) - { - for (size_t k = 0; k < infoGpuO1.allArrayGroup[i].allGroups.size(); ++k) - { - if (infoGpuO1.allArrayGroup[i].allGroups[k].tableNewVars.size() != 0) - { - InternalPosition = infoGpuO1.allArrayGroup[i].allGroups[k].position; - break; - } - } - } - // generating if block of index variables - SgIfStmt *beforeIf = NULL; - SgIfStmt *inIf = NULL; - SgIfStmt *afterIf = NULL; - SgForStmt *doSt = NULL; - - SgStatement *st3 = new SgStatement(IF_NODE); - SgStatement *st4 = new SgStatement(IF_NODE); - SgStatement *st5 = new SgStatement(IF_NODE); - SgStatement *st6 = new SgStatement(IF_NODE); - - std::vector stepI; - std::vector lowI; - std::vector highI; - const char *cuda_block[3] = { "z", "y", "x" }; - - { - SgIfStmt *ifSt = NULL; - for (int i = 0, k = 0; i < nloop; ++i) - { - char *bufStep = new char[strlen(idxs[i]->identifier()) + 16]; - char *bufLow = new char[strlen(idxs[i]->identifier()) + 16]; - char *bufHigh = new char[strlen(idxs[i]->identifier()) + 16]; - - bufStep[0] = bufLow[0] = bufHigh[0] = '\0'; - strcat(bufStep, idxs[i]->identifier()); - strcat(bufStep, "_step"); - strcat(bufLow, idxs[i]->identifier()); - strcat(bufLow, "_low"); - strcat(bufHigh, idxs[i]->identifier()); - strcat(bufHigh, "_high"); - - if (options.isOn(C_CUDA)) - { - stepI.push_back(new SgSymbol(VARIABLE_NAME, bufStep, *C_DvmType(), *kernel_st)); - lowI.push_back(new SgSymbol(VARIABLE_NAME, bufLow, *C_DvmType(), *kernel_st)); - highI.push_back(new SgSymbol(VARIABLE_NAME, bufHigh, *C_DvmType(), *kernel_st)); - } - else - { - stepI.push_back(new SgSymbol(VARIABLE_NAME, bufStep)); - lowI.push_back(new SgSymbol(VARIABLE_NAME, bufLow)); - highI.push_back(new SgSymbol(VARIABLE_NAME, bufHigh)); - } - - if (i != nloop - 1 - InternalPosition) - { - if (k == 0) - { - ifSt = new SgIfStmt(IF_NODE); - ifSt->setExpression(0, *new SgVarRefExp(*idxs[i]) <= *new SgVarRefExp(*highI[i])); - st = ifSt; - k++; - } - else - ifSt = new SgIfStmt(*new SgVarRefExp(*idxs[i]) <= *new SgVarRefExp(*highI[i]), *ifSt); - } - } - cur_in_kernel->insertStmtAfter(*ifSt, *kernel_st); - cur_in_kernel = st; - - SgStatement *keyAssign = AssignStatement(new SgVarRefExp(idxs[nloop - 1 - InternalPosition]), new SgVarRefExp(lowI[nloop - 1 - InternalPosition])); - - for (int i = 0, k = 0; i < nloop; ++i, ++k) - { - if (i != nloop - 1 - InternalPosition) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgVarRefExp(*idxs[i]), &(*new SgVarRefExp(*stepI[i]) * ((*new SgRecordRefExp(*s_blockidx, cuda_block[k])) * - *new SgRecordRefExp(*s_blockdim, cuda_block[k]) + *new SgRecordRefExp(*s_threadidx, cuda_block[k])) + - *new SgVarRefExp(*lowI[i]))); - else - st = AssignStatement(new SgVarRefExp(*idxs[i]), &(*new SgVarRefExp(*stepI[i]) * ((*new SgRecordRefExp(*s_blockidx, cuda_block[k]) - *new SgValueExp(1)) * - *new SgRecordRefExp(*s_blockdim, cuda_block[k]) + *new SgRecordRefExp(*s_threadidx, cuda_block[k]) - *new SgValueExp(1)) + - *new SgVarRefExp(*lowI[i]))); - ifSt->insertStmtBefore(*st, *kernel_st); - } - } - - st = new SgStatement(IF_NODE); - doSt = new SgForStmt(*idxs[nloop - 1 - InternalPosition], *new SgVarRefExp(*lowI[nloop - 1 - InternalPosition]), *new SgVarRefExp(*highI[nloop - 1 - InternalPosition]), *new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]), *st); - cur_in_kernel->insertStmtAfter(*doSt); - cur_in_kernel = doSt; - st->deleteStmt(); - - SgStatement *st1 = new SgStatement(IF_NODE); - SgStatement *st2 = new SgStatement(IF_NODE); - beforeIf = new SgIfStmt(*new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]) > *new SgValueExp(0), *st1, *st2); - inIf = new SgIfStmt(*new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]) > *new SgValueExp(0), *st3, *st4); - afterIf = new SgIfStmt(*new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]) > *new SgValueExp(0), *st5, *st6); - - for (size_t i = 0; i < infoGpuO1.allArrayGroup.size(); ++i) - { - for (size_t k = 0; k < infoGpuO1.allArrayGroup[i].allGroups.size(); ++k) - { - if (infoGpuO1.allArrayGroup[i].allGroups[k].position == InternalPosition) - { - for (size_t m = 0; m < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr.size(); ++m) - { - for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforePlus.size(); ++p) - beforeIf->insertStmtAfter(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforePlus[p]->copyPtr()); - for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforeMinus.size(); ++p) - beforeIf->falseBody()->insertStmtBefore(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforeMinus[p]->copyPtr()); - - for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForPlus.size(); ++p) - inIf->insertStmtAfter(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForPlus[p]); - for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForMinus.size(); ++p) - inIf->falseBody()->insertStmtBefore(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForMinus[p]); - - size_t sizeP = infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsDown.size() - 1; - for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsDown.size(); ++p) - afterIf->insertStmtAfter(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsDown[sizeP - p]); - for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsUp.size(); ++p) - afterIf->falseBody()->insertStmtBefore(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsUp[p]); - } - } - } - } - doSt->insertStmtBefore(*beforeIf); - st1->deleteStmt(); - st2->deleteStmt(); - beforeIf->insertStmtBefore(*keyAssign); - } - - // create dummy argument list of kernel: - if (options.isOn(C_CUDA)) - fe->setLhs(CreateKernelDummyList(NULL, lowI, highI, stepI)); - else // create dummy argument list and add it to kernel header statement (Fortran-Cuda) - kernel_st->setExpression(0, *CreateKernelDummyList(s_red_count_k, lowI, highI, stepI)); - - // generating assign statements for MAXLOC, MINLOC reduction operations and array reduction operations - if (red_list) - Do_Assign_For_Loc_Arrays(); //the statements are inserted after kernel_st - - //CreateBlockForCalculationThreadLoopVariables(); - - for_kernel = 1; - - // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables - - { - SgStatement *stk, *last, *block, *st; - SaveLineNumbers(loop_body); - block = CreateIfForRedBlack(loop_body, nloop); - last = cur_in_kernel->lexNext(); - - cur_in_kernel->insertStmtAfter(*block, *cur_in_kernel); //cur_in_kernel is innermost IF statement - if (options.isOn(C_CUDA)) - block->addComment("// Loop body"); - else - block->addComment("! Loop body\n"); - - // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) - stk = (block != loop_body) ? last->lexPrev()->lexPrev() : last->lexPrev(); - - if (stk->variant() == CONTROL_END) - { - if (stk->hasLabel()) - stk->setVariant(CONT_STAT); - else - { - st = stk->lexPrev(); - stk->extractStmt(); - stk = st; - } - } - - ReplaceExitCycleGoto(block, stk); - - last = cur_st; - - doSt->insertStmtAfter(*inIf, *doSt); - doSt->lastExecutable()->insertStmtAfter(*afterIf, *doSt); - st3->deleteStmt(); - st4->deleteStmt(); - st5->deleteStmt(); - st6->deleteStmt(); - - cur_in_kernel = beforeIf; - TranslateBlock(cur_in_kernel); - TranslateBlock(doSt); - - if (options.isOn(C_CUDA)) - { - swapDimentionsInprivateList(); - std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); - Translate_Fortran_To_C(cur_in_kernel->controlParent(), cur_in_kernel->controlParent()->lastNodeOfStmt(), zero, 0); - } - - cur_st = last; - } - - // generating reduction calculation blocks - if (red_list) - CreateReductionBlocks(st_end, nloop, red_list, s_red_count_k); - - // make declarations - if (options.isOn(C_CUDA)) - MakeDeclarationsForKernel_On_C_GpuO1(); - else // Fortran-Cuda - MakeDeclarationsForKernelGpuO1(s_red_count_k, idxTypeInKernel); - - if (!options.isOn(C_CUDA)) - { - for (size_t i = 0; i < lowI.size(); ++i) - { - if (i == 0) - { - st = lowI[i]->makeVarDeclStmt(); - st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); - kernel_st->insertStmtAfter(*st); - } - else - addDeclExpList(lowI[i], st->expr(0)); - } - - for (size_t i = 0; i < highI.size(); ++i) - { - if (i == 0) - { - st = highI[i]->makeVarDeclStmt(); - st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); - kernel_st->insertStmtAfter(*st); - } - else - addDeclExpList(highI[i], st->expr(0)); - } - - for (size_t i = 0; i < stepI.size(); ++i) - { - if (i == 0) - { - st = stepI[i]->makeVarDeclStmt(); - st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); - kernel_st->insertStmtAfter(*st); - } - else - addDeclExpList(stepI[i], st->expr(0)); - } - } - // inserting IMPLICIT NONE - if (!options.isOn(C_CUDA)) // Fortran-Cuda - kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); - - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(kernel_st, skernel, 1); - - for_kernel = 0; - - return(kernel_st); -} - -void ReplaceExitCycleGoto(SgStatement *block, SgStatement *stk) -{ - SgStatement *stmt, *last, *new_st; - - SgLabel *last_lab = NULL; - SgLabel *lb; - stmt_list *labeled_list = NULL; - int label_flag = 0; - int i, pl_rank; - - pl_rank = ParLoopRank(); - last = stk->lexNext(); - for (stmt = block; stmt != last; stmt = stmt->lexNext()) - { // do list of statement with label - if (stmt->hasLabel()) - labeled_list = addToStmtList(labeled_list, stmt); - - } - for (stmt = block; stmt != last; stmt = stmt->lexNext()) - { - if (isSgGotoStmt(stmt) && !IsInLabelList(((SgGotoStmt *)stmt)->branchLabel(), labeled_list) || isSgCycleStmt(stmt) && !isInLoop(stmt) || isSgExitStmt(stmt) && !isInLoop(stmt)) - { - label_flag = 1; break; - } - - if (isSgArithIfStmt(stmt)) - { - SgExpression *lbe = stmt->expr(1); - for (i = 0; lbe; lbe = lbe->rhs(), i++) - { - lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); - if (!IsInLabelList(lb, labeled_list)) - { - label_flag = 1; break; - } - } - } - if (isSgAssignedGotoStmt(stmt) || isSgComputedGotoStmt(stmt)) - { - SgExpression *lbe = stmt->expr(0); - for (i = 0; lbe; lbe = lbe->rhs(), i++) - { - lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); - if (!IsInLabelList(lb, labeled_list)) - { - label_flag = 1; break; - } - } - } - - } - - if (!label_flag) return; - if (stk->variant() == CONT_STAT && stk->hasLabel()) - last_lab = stk->label(); - else - { - last_lab = GetLabel(); - if (stk->variant() == CONT_STAT) - stk->setLabel(*last_lab); - else - { - new_st = new SgStatement(CONT_STAT); - stk->insertStmtAfter(*new_st, *last->controlParent()); - new_st->setLabel(*last_lab); - } - } - - for (stmt = block; stmt != last; stmt = stmt->lexNext()) - { - if (isSgGotoStmt(stmt) && !IsInLabelList((lb = ((SgGotoStmt *)stmt)->branchLabel()), labeled_list)) - { - if (testLabelUse(lb, pl_rank, stmt)) - stmt->setExpression(2, *new SgLabelRefExp(*last_lab)); - continue; - } - if (isSgCycleStmt(stmt) && !isInLoop(stmt) || isSgExitStmt(stmt) && !isInLoop(stmt)) - { - new_st = new SgGotoStmt(*last_lab); - (stmt->lexPrev())->insertStmtAfter(*new_st, *stmt->controlParent()); - if (stmt->hasLabel()) - new_st->setLabel(*stmt->label()); - if (stmt->comments()) - new_st->setComments(stmt->comments()); - stmt->extractStmt(); - stmt = new_st; - continue; - } - - if (isSgArithIfStmt(stmt)) - { - SgExpression *lbe = stmt->expr(1); - for (i = 0; lbe; lbe = lbe->rhs(), i++) - { - lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); - if (!IsInLabelList(lb, labeled_list) && testLabelUse(lb, pl_rank, stmt)) - lbe->setLhs(new SgLabelRefExp(*last_lab)); - } - continue; - } - if (isSgAssignedGotoStmt(stmt) || isSgComputedGotoStmt(stmt)) - { - SgExpression *lbe = stmt->expr(0); - for (i = 0; lbe; lbe = lbe->rhs(), i++) - { - lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); - if (!IsInLabelList(lb, labeled_list) && testLabelUse(lb, pl_rank, stmt)) - lbe->setLhs(new SgLabelRefExp(*last_lab)); - } - continue; - } - } - -} - -int IsParDoLabel(SgLabel *lab, int pl_rank) -{ - SgStatement *stmt; - int i; - for (i = pl_rank, stmt = first_do_par; i; i--, stmt = stmt->lexNext()) - if (((SgForStmt *)stmt)->endOfLoop() == lab) - return(1); - return(0); -} - -int IsInLabelList(SgLabel *lab, stmt_list *labeled_list) -{ - stmt_list *stl; - for (stl = labeled_list; stl; stl = stl->next) - if (stl->st->label() == lab) - return(1); - return(0); -} - -int isInLoop(SgStatement *stmt) -{ - SgStatement *parent = stmt->controlParent(); - while (parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) - if (parent == current_file->firstStatement()) - return(0); - else - parent = parent->controlParent(); - return(1); - -} - -int testLabelUse(SgLabel *lb, int pl_rank, SgStatement *stmt) -{ - char buf[5]; - if (!IsParDoLabel(lb, pl_rank)) - { - sprintf(buf, "%d", (int)LABEL_STMTNO(lb->thelabel)); - Error("Label %s out of parallel loop range", buf, 38, stmt); - return 0; - } - return 1; -} - -SgStatement *CreateKernelProcedure(SgSymbol *skernel) -{ - SgStatement *st, *st_end; - SgExpression *e; - - st = new SgStatement(PROC_HEDR); - st->setSymbol(*skernel); - e = new SgExpression(ACC_ATTRIBUTES_OP, new SgExpression(ACC_GLOBAL_OP), NULL, NULL); - //e ->setRhs(new SgExpression(ACC_GLOBAL_OP)); - st->setExpression(2, *e); - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*skernel); - - cur_in_mod->insertStmtAfter(*st, *mod_gpu); - st->insertStmtAfter(*st_end, *st); - st->setVariant(PROS_HEDR); - - cur_in_mod = st_end; - - return(st); -} - -SgStatement * CreateKernel_ForSequence(SgSymbol *kernel_symb, SgStatement *first_st, SgStatement *last_st, SgType *idxTypeInKernel) -{ - SgStatement *block_copy; - SgExpression *arg_list; - kernel_st = (!options.isOn(C_CUDA)) ? CreateKernelProcedure(kernel_symb) : Create_C_Kernel_Function(kernel_symb); - kernel_st->addComment(SequenceKernelComment(first_st->lineNumber())); - - // transferring sequence of statements in kernel - block_copy = CopyBlockToKernel(first_st, last_st); - - lpart_list = NULL; - - TranslateBlock(kernel_st); - - if (options.isOn(C_CUDA)) - { - swapDimentionsInprivateList(); - std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); - Translate_Fortran_To_C(kernel_st, kernel_st->lastNodeOfStmt(), zero, 0); - } - - // create dummy argument list and add it to kernel header statement - arg_list = CreateKernelDummyList_ForSequence(idxTypeInKernel); - if (arg_list) - { - if (options.isOn(C_CUDA)) - kernel_st->expr(0)->setLhs(arg_list); - else - kernel_st->setExpression(0, *arg_list); - } - - // make declarations - MakeDeclarationsInKernel_ForSequence(idxTypeInKernel); - - - if (!options.isOn(C_CUDA)) // Fortran-Cuda - // inserting IMPLICIT NONE - kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(kernel_st, kernel_symb, 1); - return(kernel_st); -} - - -SgExpression *IsRedBlack(int nloop) -{ - SgExpression *erb; - SgStatement *st; - int ndo; - // looking through the loop nest for redblack scheme - erb = NULL; - for (st = first_do_par, ndo = 0; ndo < nloop; st = ((SgForStmt *)st)->body(), ndo++) - { - if (((SgForStmt *)st)->start()->variant() == ADD_OP) //redblack scheme - { - return(((SgForStmt *)st)->start()->rhs()->lhs()->lhs()->rhs()); - } - - } - - return(NULL); - -} - -void CreateBlockForCalculationThreadLoopVariables() -{ - int nloop, i, i1; - SgStatement *if_st = NULL, *dost = NULL, *ass = NULL, *stmt = NULL; - nloop = ParLoopRank(); - - - if (!options.isOn(NO_BL_INFO)) - { - if (options.isOn(C_CUDA)) - cur_in_kernel->addComment("// Calculate each thread's loop variables' values"); - else - cur_in_kernel->addComment("! Calculate each thread's loop variables' values\n"); - - for (i = 0; iinsertStmtAfter(*ass, *kernel_st); - cur_in_kernel = ass; - } - i1 = i; - if_st = new SgStatement(CONT_STAT); - i = nloop; - while (i>i1) - { - dost = DoStmt(first_do_par, i); //sind = Do_Var(i,vl); - if_st = new SgIfStmt(*KernelConditionWithDoStep(dost, s_blocks_k, i - 1), *if_st); //new SgIfStmt( *KernelCondition(dost->symbol(),s_blocks_k,i-1), *if_st); - i--; - } - cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); - cur_in_kernel = if_st; - - i = i1; - //dost = first_do_par; - while (i < nloop) - { - ass = Assign_To_IndVar(dost, i, nloop, s_blocks_k); - if_st->insertStmtBefore(*ass, *if_st->controlParent()); - if_st = if_st->lexNext(); - dost = dost->lexNext(); - i++; - } - - //dost = dost->controlParent(); - cur_in_kernel = ass->lexNext(); //innermost IF statement - cur_in_kernel->lexNext()->extractStmt(); //extracting CONTINUE statement - return; - } - - //without_blocks_info - cur_in_kernel = stmt = kernel_st->lastNodeOfStmt()->lexPrev(); - - if_st = new SgStatement(CONT_STAT); - i = nloop; - while (i) - { - dost = DoStmt(first_do_par, i); - if_st = new SgIfStmt(*KernelCondition2(dost, i), *if_st); - i--; - } - cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); - cur_in_kernel = if_st; - - dost = first_do_par; - i = 1; - while (i <= nloop) - { - ass = Assign_To_rest_blocks(i - 1); - if_st->insertStmtBefore(*ass, *if_st->controlParent()); - ass = Assign_To_cur_blocks(i - 1, nloop); - if_st->insertStmtBefore(*ass, *if_st->controlParent()); - ass = Assign_To_IndVar2(dost, i, nloop); - if_st->insertStmtBefore(*ass, *if_st->controlParent()); - if_st = if_st->lexNext(); - dost = dost->lexNext(); - i++; - } - - if (options.isOn(C_CUDA)) - stmt->lexNext()->addComment("// Calculate each thread's loop variables' values"); - else - stmt->lexNext()->addComment("! Calculate each thread's loop variables' values\n"); - - cur_in_kernel = ass->lexNext(); //innermost IF statement - cur_in_kernel->lexNext()->extractStmt(); //extracting CONTINUE statement - - return; -} - -SgStatement *CreateIfForRedBlack(SgStatement *loop_body, int nloop) -{ - SgExpression *erb; - SgStatement *st; - int ndo; - // looking through the loop nest for redblack scheme - erb = NULL; - for (st = first_do_par, ndo = 0; ndo < nloop; st = ((SgForStmt *)st)->body()) - { //!printf("---line number: %d, %d\n",st->lineNumber(),((SgForStmt *)st)->body()->lineNumber()); - if (((SgForStmt *)st)->start()->variant() == ADD_OP) //redblack scheme - { - erb = ((SgForStmt *)st)->start()->rhs(); // MOD function call (after replacing for dvm realisation) - erb = &(erb->lhs()->lhs()->copy()); //first argument of MOD function call - erb->setLhs(new SgVarRefExp(st->symbol())); - } - ndo++; - } - //!!!printf("line number of st: %d, %d\n",st->lineNumber(), st); - - if (erb) - { - st = new SgIfStmt(*ConditionForRedBlack(erb), *loop_body); - return(st); - } - else - return(loop_body); - -} - -SgExpression *CreateKernelDummyList(SgSymbol *s_red_count_k, SgType *idxTypeInKernel) -{ - SgExpression *arg_list, *ae; - SgExpression *eln = new SgExprListExp(); - int pl_rank = ParLoopRank(); - int i; - arg_list = NULL; - - arg_list = AddListToList(CreateArrayDummyList(idxTypeInKernel), CreateRedDummyList()); - // base_ref + ... - // + [+red_var_2+...+red_var_M] + _grid [ + ...] - - // + 'blocks' [ or begin_1, end_1,...,begin_,end_,blocks_1,...,blocks_,add_blocks ] - if (!options.isOn(NO_BL_INFO)) - { - SgArrayType *tmpType = new SgArrayType(*idxTypeInKernel); - SgSymbol *copy_s_blocks_k = new SgSymbol(s_blocks_k->variant(), s_blocks_k->identifier(), tmpType, s_blocks_k->scope()); - - ae = options.isOn(C_CUDA) ? new SgExprListExp(*new SgArrayRefExp(*copy_s_blocks_k, *eln)) : new SgExprListExp(*new SgArrayRefExp(*copy_s_blocks_k)); // + 'blocks' - //ae = options.isOn(C_CUDA) ? new SgExprListExp(*new SgPointerDerefExp(*new SgVarRefExp(copy_s_blocks_k))) : new SgExprListExp(*new SgVarRefExp(copy_s_blocks_k)); - arg_list = AddListToList(arg_list, ae); - - } - else //without blocks_info - { - SgSymbol *copy_s_begin, *copy_s_end, *copy_s_step, *copy_s_blocks, *copy_s_add_blocks; - for (i = 0; i < pl_rank; i++) - { - copy_s_begin = new SgSymbol(s_begin[i]->variant(), s_begin[i]->identifier(), idxTypeInKernel, s_begin[i]->scope()); - ae = new SgVarRefExp(*copy_s_begin); - ae = new SgExprListExp(*ae); - if (i == 0) - indexing_info_list = ae; - arg_list = AddListToList(arg_list, ae); - - copy_s_end = new SgSymbol(s_end[i]->variant(), s_end[i]->identifier(), idxTypeInKernel, s_end[i]->scope()); - ae = new SgVarRefExp(*copy_s_end); - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - if (!IConstStep(DoStmt(first_do_par, i + 1))) - { - copy_s_step = new SgSymbol(s_loopStep[i]->variant(), s_loopStep[i]->identifier(), idxTypeInKernel, s_loopStep[i]->scope()); - ae = new SgVarRefExp(*copy_s_step); - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - } - } - - for (i = 0; i < pl_rank - 1; i++) - { - copy_s_blocks = new SgSymbol(s_blocksS_k[i]->variant(), s_blocksS_k[i]->identifier(), idxTypeInKernel, s_blocksS_k[i]->scope()); - ae = new SgVarRefExp(*copy_s_blocks); - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - } - - copy_s_add_blocks = new SgSymbol(s_add_blocks->variant(), s_add_blocks->identifier(), idxTypeInKernel, s_add_blocks->scope()); - ae = new SgVarRefExp(*copy_s_add_blocks); - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - - indexing_info_list = &(indexing_info_list->copy()); - } - if (s_red_count_k) //[+ 'red_count'] - { - ae = new SgExprListExp(*new SgVarRefExp(s_red_count_k)); - arg_list = AddListToList(arg_list, ae); - } - //[+ 'overall_blocks'] - if (s_overall_blocks) - { - SgSymbol *copy_overall = new SgSymbol(s_overall_blocks->variant(), s_overall_blocks->identifier(), idxTypeInKernel, s_overall_blocks->scope()); - ae = new SgExprListExp(*new SgVarRefExp(copy_overall)); - arg_list = AddListToList(arg_list, ae); - } - if (uses_list) - arg_list = AddListToList(arg_list, CreateUsesDummyList()); //[+ ] - if (private_list) - arg_list = AddListToList(arg_list, CreatePrivateDummyList()); //[+ dummys for private arrays ] - - return arg_list; -} - - -SgExpression *CreateKernelDummyList_ForSequence(SgType *idxTypeInKernel) -{ - SgExpression *arg_list; - - arg_list = NULL; - - arg_list = AddListToList(CreateArrayDummyList(idxTypeInKernel), CreateLocalPartList(idxTypeInKernel)); - // base_ref + ... - // + ... - - if (uses_list) - arg_list = AddListToList(arg_list, CreateUsesDummyList()); // [ ] - return(arg_list); - -} - -SgSymbol *KernelDummyArray(SgSymbol *s) -{ - SgArrayType *typearray; - SgType *type; - //SgExpression *MD = new SgExpression(DDOT,new SgValueExp(0),new SgValueExp(1),NULL); - - type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); - - //if(options.isOn(C_CUDA)) - //{ type = C_PointerType(C_Type(type)); - - //} - //else - if (options.isOn(C_CUDA)) - type = C_Type(type); - typearray = new SgArrayType(*type); - typearray->addDimension(NULL); - type = typearray; - - return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); - -} - -SgSymbol *KernelDummyVar(SgSymbol *s) -{ - SgType *type; - type = options.isOn(C_CUDA) ? C_Type(s->type()) : s->type(); - return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); -} - - -SgSymbol *KernelDummyPointerVar(SgSymbol *s) -{ - char *name; - SgSymbol *sp; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 2 + 1)); - sprintf(name, "p_%s", s->identifier()); - sp = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name), *C_PointerType(C_Type(s->type())), *kernel_st); - - // adding the attribute DUMMY_ARG to symbol of user program - if (!DUMMY_ARG(s)) - { - SgSymbol **dummy = new (SgSymbol *); - *dummy = sp; - s->addAttribute(DUMMY_ARGUMENT, (void*)dummy, sizeof(SgSymbol *)); - } - return(sp); - -} - -SgExpression * dvm_coef(SgSymbol *ar, int i) -{ //coeffs *c; - //c = AR_COEFFICIENTS(ar); - if (options.isOn(C_CUDA)) - { - SgSymbol *s_dummy_coef = new SgSymbol(VARIABLE_NAME, AR_COEFFICIENTS(ar)->sc[i]->identifier(), *CudaIndexType_k, *kernel_st); - return(new SgVarRefExp(*s_dummy_coef)); - } - - return(new SgVarRefExp(*(AR_COEFFICIENTS(ar)->sc[i]))); - -} - -SgSymbol *KernelDummyLocalPart(SgSymbol *s) -{ - SgArrayType *typearray; - SgType *type; - - // for C_Cuda - typearray = new SgArrayType(*CudaIndexType_k); - typearray->addDimension(NULL); - type = typearray; - - return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); - -} - - -SgExpression *CreateArrayDummyList() -{ - symb_list *sl; - SgExpression *ae, *coef_list, *edim; - int n, d; - SgExpression *arg_list = NULL; - - edim = new SgExprListExp(); // [] dimension - - for (sl = acc_array_list; sl; sl = sl->next) // + base_ref + - { - SgSymbol *s_dummy; - s_dummy = KernelDummyArray(sl->symb); - if (options.isOn(C_CUDA)) - ae = new SgArrayRefExp(*s_dummy, *edim); // new SgPointerDerefExp(* new SgVarRefExp(s_dummy)); - else - ae = new SgArrayRefExp(*s_dummy); - ae->setType(s_dummy->type()); //for C_Cuda - ae = new SgExprListExp(*ae); - // ae = new SgPointerDerefExp(*ae); // ae->setLhs(*edim); - arg_list = AddListToList(arg_list, ae); - coef_list = NULL; - if (Rank(sl->symb) == 0) //remote_access buffer may be of rank 0 - continue; - d = options.isOn(AUTO_TFM) ? 0 : 1; //inparloop ? 0 : 1; - for (n = Rank(sl->symb) - d; n > 0; n--) - { - ae = new SgExprListExp(*dvm_coef(sl->symb, n + 1)); - coef_list = AddListToList(coef_list, ae); - } - - arg_list = AddListToList(arg_list, coef_list); - } - return(arg_list); - -} - -SgExpression *CreateUsesDummyList() -{ - SgSymbol *s_dummy, *s; - SgExpression *el, *ae; - SgExpression *arg_list = NULL; - - for (el = uses_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (options.isOn(C_CUDA) && !isByValue(s)) - { - s_dummy = KernelDummyPointerVar(s); - ae = new SgPointerDerefExp(*new SgVarRefExp(*s_dummy)); - } - else - { - s_dummy = KernelDummyVar(s); - ae = new SgVarRefExp(*s_dummy); - } - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - } - return(arg_list); -} - -SgExpression *CreatePrivateDummyList() -{ - SgSymbol *s_dummy, *s; - SgExpression *el, *ae; - SgExpression *arg_list = NULL; - if (!options.isOn(C_CUDA) || !PrivateArrayClassUse(sizeOfPrivateArraysInBytes())) // !sizeOfPrivateArraysInBytes()) - return NULL; - for (el = private_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (!IS_ARRAY(s)) - continue; - s_dummy = ArraySymbol(PointerNameForPrivateArray(s), C_Type(s->type()->baseType()), NULL, kernel_st); - ae = new SgArrayRefExp(*s_dummy, *new SgExprListExp()); - ae->setType(s_dummy->type()); - arg_list = AddListToList(arg_list, new SgExprListExp(*ae)); - SgSymbol **satr = new (SgSymbol *); - *satr = s_dummy; - el->lhs()->addAttribute(PRIVATE_POINTER, (void *)satr, sizeof(SgSymbol *) ); - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela; ela=ela->rhs()) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); //AddListToList(arg_list, &(ela->copy())); - - eatr = (SgExpression **) el->lhs()->attributeValue(0, L_BOUNDS); - for (ela = *eatr; ela; ela=ela->rhs()) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); //AddListToList(arg_list, &(ela->copy())); - } - } - - return(arg_list); -} - -SgExpression *CreateRedDummyList() -{ - reduction_operation_list *rsl; - SgExpression *ae, *arg_list, *loc_list; - arg_list = NULL; - - for (rsl = red_struct_list; rsl; rsl = rsl->next) // + [+red_var_2+...+red_var_M] + _grid [ + ...] [ + _grid> ] - { - if (rsl->locvar) - { - //ae = C_Cuda ? new SgExprListExp(*new SgPointerDerefExp(*new SgVarRefExp(rsl->loc_grid))) : new SgExprListExp(*new SgVarRefExp(rsl->loc_grid)); - if (options.isOn(C_CUDA)) - { - ae = new SgArrayRefExp(*rsl->loc_grid, *new SgExprListExp()); - ae->setType(rsl->loc_grid->type()); - } - else - ae = new SgVarRefExp(rsl->loc_grid); - ae = new SgExprListExp(*ae); - loc_list = AddListToList(&(rsl->formal_arg->copy()), ae); - } - else - loc_list = NULL; - if (rsl->redvar_size > 0) // reduction array of known size (constant bounds) - arg_list = AddListToList(arg_list, &(rsl->value_arg->copy())); - else if (rsl->redvar_size == 0) - { - ae = new SgExprListExp(*new SgVarRefExp(KernelDummyVar(rsl->redvar))); - arg_list = AddListToList(arg_list, ae); - } - else // reduction array of unknown size - { - arg_list = AddListToList(arg_list, &(rsl->dimSize_arg->copy())); - arg_list = AddListToList(arg_list, &(rsl->lowBound_arg->copy())); - } - if (options.isOn(C_CUDA)) - { - ae = new SgArrayRefExp(*rsl->red_grid, *new SgExprListExp()); - ae->setType(rsl->red_grid->type()); - } - else - ae = new SgVarRefExp(rsl->red_grid); - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - if (rsl->redvar_size < 0) - { - if (options.isOn(C_CUDA)) - { - ae = new SgArrayRefExp(*rsl->red_init, *new SgExprListExp()); - //XXX use correct type from red_grid, changed reduction scheme to atomic, Kolganov 06.02.2020 - ae->setType(rsl->red_grid->type()); - ae = new SgExprListExp(*ae); - } - else - ae = new SgExprListExp(*new SgVarRefExp(rsl->red_init)); - arg_list = AddListToList(arg_list, ae); - } - arg_list = AddListToList(arg_list, loc_list); - } - return(arg_list); -} - -SgExpression* CreateRedDummyList(SgType* indeTypeInKernel) -{ - SgExpression* arg_list = CreateRedDummyList(); - - if (ACROSS_MOD_IN_KERNEL) - { - for (reduction_operation_list* rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (rsl->redvar_size > 0) - { - SgSymbol* overAll = OverallBlocksSymbol(); - if(options.isOn(C_CUDA)) - overAll->setType(indeTypeInKernel); - - arg_list = AddListToList(new SgExprListExp(*new SgVarRefExp(overAll)), arg_list); - break; - } - } - } - return arg_list; -} - -SgExpression *CreateLocalPartList() -{ - local_part_list *pl; - SgExpression *ae; - SgExpression *arg_list = NULL; - for (pl = lpart_list; pl; pl = pl->next) // + - { - if (options.isOn(C_CUDA)) - ae = new SgExprListExp(*new SgArrayRefExp(*KernelDummyLocalPart(pl->local_part), *new SgExprListExp())); //[] - else - ae = new SgExprListExp(*new SgArrayRefExp(*pl->local_part)); - arg_list = AddListToList(arg_list, ae); - } - return(arg_list); - -} - - -SgExpression *CoefficientList() -{ - symb_list *sl; - SgExpression *ae; - int n, d; - SgExpression *coef_list = NULL; - for (sl = acc_array_list; sl; sl = sl->next) - { - if (Rank(sl->symb) == 0) //remote_access buffer may be of rank 0 - continue; - d = options.isOn(AUTO_TFM) ? 0 : 1; //inparloop ? 0 : 1; - for (n = Rank(sl->symb) - d; n > 0; n--) - { - ae = new SgExprListExp(*dvm_coef(sl->symb, n + 1)); - coef_list = AddListToList(coef_list, ae); - } - - } - return(coef_list); - -} - -SgExpression *ArrayRefList() -{ - symb_list *sl; - SgExpression *ae; - SgExpression *ar_list = NULL; - - for (sl = acc_array_list; sl; sl = sl->next) - { - ae = new SgExprListExp(*new SgArrayRefExp(*sl->symb)); - ar_list = AddListToList(ar_list, ae); - } - return(ar_list); -} - -void MakeDeclarationsForKernel(SgSymbol *red_count_symb, SgType *idxTypeInKernel) -{ - SgExpression *var, *eatr, *edev; - SgStatement *st; - - // declare called functions - DeclareCalledFunctions(); - - // declare index variablex for reduction array - for (var = kernel_index_var_list; var; var = var->rhs()) - { - st = var->lhs()->symbol()->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*st); - } - - // declare variable 'ibof' or cur_blocks,rest_blocks (without blocks_info) - if (!options.isOn(NO_BL_INFO)) - st = s_ibof->makeVarDeclStmt(); - - else // without_blocks_info - { - SgSymbol *copy_s_rest_blocks = new SgSymbol(s_rest_blocks->variant(), s_rest_blocks->identifier(), idxTypeInKernel, s_rest_blocks->scope()); - st = copy_s_rest_blocks->makeVarDeclStmt(); - st->expr(0)->setRhs(new SgExprListExp(*new SgVarRefExp(s_cur_blocks))); - } - kernel_st->insertStmtAfter(*st); - - // declare do_variables - DeclareDoVars(); - - // declare private(local in kernel) variables - DeclarePrivateVars(idxTypeInKernel); - - // declare dummy arguments: - eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); - edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); - - // declare reduction dummy arguments - DeclareDummyArgumentsForReductions(red_count_symb, idxTypeInKernel); - - if (!options.isOn(NO_BL_INFO)) - { - // declare blocks variable (see CudaIndexType type in util.h) - SgSymbol *copy_s_blocks_k = ArraySymbol(s_blocks_k->identifier(), idxTypeInKernel, new SgExpression(DDOT, new SgValueExp(0), new SgKeywordValExp("*"), NULL), s_blocks_k->scope()); - st = copy_s_blocks_k->makeVarDeclStmt(); // of CudaIndexType - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - st->addComment("! Loop bounds array\n"); - } - else // without_blocks_info - { - // declare begin_k,end_k,blocks_k variables (see CudaIndexType type in util.h) - SgSymbol *copy_s_blocks_k = new SgSymbol(s_blocks_k->variant(), s_blocks_k->identifier(), idxTypeInKernel, s_blocks_k->scope()); - st = copy_s_blocks_k->makeVarDeclStmt(); // of CudaIndexType - st->setExpression(2, *eatr); - st->setExpression(0, *indexing_info_list); - kernel_st->insertStmtAfter(*st); - st->addComment("! Indexing info\n"); - } - - // declare array coefficients - DeclareArrayCoeffsInKernel(idxTypeInKernel); - - // declare bases for arrays - DeclareArrayBases(); - - // declare variables, used in loop - DeclareUsedVars(); -} - -void MakeDeclarationsForKernel_On_C(SgType *idxTypeInKernel) -{ - SgStatement *st; - - // declare variable 'ibof' or cur_blocks,rest_blocks (without blocks_info) - if (!options.isOn(NO_BL_INFO)) - st = Declaration_Statement(s_ibof); - else // without_blocks_info - { - SgSymbol *copy_symb; - - copy_symb = new SgSymbol(s_rest_blocks->variant(), s_rest_blocks->identifier(), idxTypeInKernel, s_rest_blocks->scope()); - st = Declaration_Statement(copy_symb); - - copy_symb = new SgSymbol(s_cur_blocks->variant(), s_cur_blocks->identifier(), idxTypeInKernel, s_cur_blocks->scope()); - addDeclExpList(copy_symb, st->expr(0)); - } - kernel_st->insertStmtAfter(*st); - - // declare do_variables - DeclareDoVars(idxTypeInKernel); - - // declare private(local in kernel) variables - DeclarePrivateVars(idxTypeInKernel); - - // declare variables, used in loop and passed by reference: - // & = *p_; - DeclareUsedVars(); -} - -void MakeDeclarationsInKernel_ForSequence(SgType *idxTypeInKernel) -{ - if (options.isOn(C_CUDA)) - { - DeclareUsedVars(); - DeclareInternalPrivateVars(); - } - else - { - // in Fortran-Cuda language - // declare called functions - DeclareCalledFunctions(); - - // declaring dummy arguments - // declare array coefficients - DeclareArrayCoeffsInKernel(idxTypeInKernel); - - // declare bases for arrays - DeclareArrayBases(); - - // declare local part variables - DeclareLocalPartVars(idxTypeInKernel); - - // declare variables, used in sequence - DeclareUsedVars(); - } -} - -void DeclareCalledFunctions() -{ - SgStatement *st = NULL; - symb_list *sl; - // declare called functions in Fortran_Cuda kernel - for (sl = acc_call_list; sl; sl = sl->next) - if (sl->symb->variant() == FUNCTION_NAME && !IS_BY_USE(sl->symb)) - { - st = sl->symb->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*st, *kernel_st); - } - if (st) - st->addComment("! Called functions\n"); - -} - - -// declare DO cariables of parallel loop nest in kernel -void DeclareDoVars() -{ - SgExpression *el; - SgStatement *st; - SgSymbol *s; - // declare do_variables of parallel loop nest - for (el=dvm_parallel_dir->expr(2); el; el=el->rhs()) - { - s = el->lhs()->symbol(); - if (options.isOn(C_CUDA)) - s = new SgVariableSymb(s->identifier(), *C_Type(s->type()), *kernel_st); - st = Declaration_Statement(s); - kernel_st->insertStmtAfter(*st); - } - if (options.isOn(C_CUDA)) - st->addComment("// Local needs"); - else - st->addComment("! Local needs\n"); - -} - -void DeclareLocalPartVars(SgType *idxTypeInKernel) -{ - SgExpression *edev = NULL; - local_part_list *pl = NULL; - SgStatement *st = NULL; - - edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); - - // declare local-part variables - for (pl = lpart_list; pl; pl = pl->next) - { - st = pl->local_part->makeVarDeclStmt(); - st->expr(1)->setType(idxTypeInKernel); - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - } - if (lpart_list) - st->addComment("! Local parts of arrays\n"); -} - -void DeclareLocalPartVars() -{ - SgExpression *edev = NULL; - local_part_list *pl = NULL; - SgStatement *st = NULL; - - edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); - - // declare local-part variables - for (pl = lpart_list; pl; pl = pl->next) - { - st = pl->local_part->makeVarDeclStmt(); - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - } - if (lpart_list) - st->addComment("! Local parts of arrays\n"); -} - -void DeclareArrayCoeffsInKernel(SgType *idxTypeInKernel) -{ // declare array coefficients - SgExpression *el = NULL, *eatr = NULL; - SgStatement *st = NULL; - - if (acc_array_list && (el = CoefficientList())) - { - eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); - st = idxTypeInKernel->symbol()->makeVarDeclStmt(); // of CudaIndexType - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - st->addComment("! Array coefficients\n"); - st->setExpression(0, *el); - } -} - -void DeclareArrayBases() -{ - // declare bases for arrays - if (acc_array_list) - { - SgStatement *st = NULL; - SgExpression *array_list = NULL, *alist = NULL, *edim = NULL, *edev = NULL; - SgSymbol *ar = NULL; - //SgSymbol *baseMem = NULL; - - // make attribute DIMENSION(0:*) - edim = new SgExpression(DIMENSION_OP); - edim->setLhs(new SgExpression(DDOT, new SgValueExp(0), new SgKeywordValExp("*"), NULL, NULL)); - edim = new SgExprListExp(*edim); - // make attribute DEVICE - edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); - - array_list = ArrayRefList(); - while (array_list) - { - ar = array_list->lhs()->symbol(); - //baseMem = baseMemory(ar->type()->baseType()); - st = ar->makeVarDeclStmt(); - edim->setRhs(edev); - st->setExpression(2, *edim); - kernel_st->insertStmtAfter(*st); - alist = array_list; - st->setExpression(0, *alist); - //while (alist->rhs() && baseMemory(alist->rhs()->lhs()->symbol()->type()->baseType()) == baseMem) - // alist = alist->rhs(); - array_list = array_list->rhs(); - alist->setRhs(NULL); - } - st->addComment("! Bases for arrays\n"); - } -} - -void DeclareInternalPrivateVars() -{ - SgStatement *st = NULL; - for (unsigned i = 0; i < newVars.size(); ++i) - { - SgVarRefExp *e = new SgVarRefExp(*newVars[i]); - if (!(isParDoIndexVar(e->symbol()))) - { - st = Declaration_Statement(SymbolInKernel(e->symbol())); - kernel_st->insertStmtAfter(*st); - } - - } - - if (st) - { - if (options.isOn(C_CUDA)) - st->addComment("// Internal private variables"); - else - st->addComment("! Internal private variables\n"); - } -} - -SgStatement *makeClassObjectDeclaration(SgSymbol *s, SgSymbol *sp, SgStatement *header_st, SgType *idxType, SgExpression *dim_list, int flag_true) -{ - SgStatement *st = new SgStatement(VAR_DECL); - SgSymbol *s_new = & s->copy(); - SYMB_SCOPE(s_new->thesymb) = header_st->thebif; - SgExpression *e = new SgExprListExp(*new SgTypeRefExp(*C_Type(s_new->type()))); - SgDerivedTemplateType *tp = new SgDerivedTemplateType(e, private_array_class); - tp->addArg(new SgValueExp(Rank(s))); - s_new->setType(tp); - SgFunctionCallExp *efc = new SgFunctionCallExp(*s_new); - efc->setType(tp); - st->setExpression(0, *new SgExprListExp(*efc)); - header_st->insertStmtAfter(*st); - - SgSymbol *s_dims=NULL; - SgStatement *st_dims = NULL; - if (Rank(s)>1) - { - char *name = new char[strlen(s->identifier())+7]; - sprintf(name, "_%s_dims", s->identifier()); - s_dims = ArraySymbol(name, idxType, new SgValueExp(Rank(s)-1), header_st); - SgExpression *einit = new SgExpression(INIT_LIST); -/* SgExpression *elist = NULL; - - if (for_kernel && !TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) var->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela->rhs(); ela = ela->rhs()) - { - SgExpression *ed = new SgVarRefExp(ela->lhs()->lhs()->symbol()); - elist = AddListToList(new SgExprListExp(*ed), elist); - } - } - else - { - for (int i=Rank(s)-1; i; i--) - elist = AddListToList(elist, new SgExprListExp(*Calculate(ArrayDimSize(s,i)))); - } - - einit->setLhs(elist); -*/ - einit->setLhs(dim_list); - SgStatement *st_dims = makeSymbolDeclarationWithInit(s_dims, einit); - header_st->insertStmtAfter(*st_dims); - //st_first = st_dims; - } - if (s_dims) - efc->addArg(*new SgVarRefExp(s_dims)); - - //SgSymbol **satr = (SgSymbol **) var->lhs()->attributeValue(0, PRIVATE_POINTER); - if (sp) - // { - // SgSymbol *sp = *satr; - efc->addArg(*new SgVarRefExp(sp)); - // } - if (flag_true) - efc->addArg(*new SgKeywordValExp("true")); - return (st_dims ? st_dims : st); -} - -void DeclarePrivateVars() -{ - DeclarePrivateVars(C_UnsignedLongLongType()); -} - -void DeclarePrivateVars(SgType *idxTypeInKernel) -{ - SgStatement *st = NULL, *st_first=NULL; - SgExpression *var = NULL, *e; - SgSymbol *s; - - if(!private_list) return; - - SgExpression *e_all_private_size = sizeOfPrivateArraysInBytes(); - //SgSymbol *class_name = new SgSymbol(TYPE_NAME, "PrivateArray"); - - // declare private variables - for (var = private_list; var; var = var->rhs()) - { - s = var->lhs()->symbol(); - if (isParDoIndexVar(s)) continue; // declared as index variable of parallel loop - //if (HEADER(var->lhs()->symbol())) continue; // dvm-array declared as dummy argument - if (!options.isOn(C_CUDA) || !IS_ARRAY(s) || !PrivateArrayClassUse(e_all_private_size)) - { - st = Declaration_Statement(SymbolInKernel(s)); - kernel_st->insertStmtAfter(*st); - st_first = st; - } - else - { - SgStatement *st = new SgStatement(VAR_DECL); - SgSymbol *s_new = & s->copy(); - SYMB_SCOPE(s_new->thesymb) = kernel_st->thebif; - e = new SgExprListExp(*new SgTypeRefExp(*C_Type(s_new->type()))); - SgDerivedTemplateType *tp = new SgDerivedTemplateType(e, private_array_class); - tp->addArg(new SgValueExp(Rank(s))); - s_new->setType(tp); - SgFunctionCallExp *efc = new SgFunctionCallExp(*s_new); - efc->setType(tp); - st->setExpression(0, *new SgExprListExp(*efc)); - kernel_st->insertStmtAfter(*st); - st_first = st; - SgSymbol *s_dims=NULL; - if (Rank(s)>1) - { - char *name = new char[strlen(s->identifier())+7]; - sprintf(name, "_%s_dims", s->identifier()); - s_dims = ArraySymbol(name, idxTypeInKernel, new SgValueExp(Rank(s)-1), kernel_st); - SgExpression *einit = new SgExpression(INIT_LIST); - SgExpression *elist = NULL; - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) var->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela->rhs(); ela = ela->rhs()) - { - SgExpression *ed = new SgVarRefExp(ela->lhs()->lhs()->symbol()); - elist = AddListToList(new SgExprListExp(*ed), elist); - } - } - else - { - for (int i=Rank(s)-1; i; i--) - elist = AddListToList(elist, new SgExprListExp(*Calculate(ArrayDimSize(s,i)))); - } - einit->setLhs(elist); - SgStatement *st_dims = makeSymbolDeclarationWithInit(s_dims, einit);//Declaration_Statement(s_dims); - kernel_st->insertStmtAfter(*st_dims); - st_first = st_dims; - } - if (s_dims) - { - efc->addArg(*new SgVarRefExp(s_dims)); - } - SgSymbol **satr = (SgSymbol **) var->lhs()->attributeValue(0, PRIVATE_POINTER); - if (satr) - { - SgSymbol *sp = *satr; - efc->addArg(*new SgVarRefExp(sp)); - } - } - } - - if (!st_first) - return; - - if (options.isOn(C_CUDA)) - st_first->addComment("// Private variables"); - else - st_first->addComment("! Private variables\n"); -} - -void DeclareUsedVars() -{ - SgSymbol *s = NULL, *sn = NULL; - SgExpression *var = NULL, *eatr = NULL, *edev = NULL; - SgStatement *st = NULL; - - if (options.isOn(C_CUDA)) - - { - for (var = uses_list; var; var = var->rhs()) - { - s = var->lhs()->symbol(); - if (!isByValue(s)) // passing argument by reference - // & = *p_; - { - sn = new SgSymbol(VARIABLE_NAME, s->identifier(), C_ReferenceType(C_Type(s->type())), kernel_st); - st = makeSymbolDeclarationWithInit(sn, &SgDerefOp(*new SgVarRefExp(**DUMMY_ARG(s)))); - kernel_st->insertStmtAfter(*st); - } - } - if (st) - st->addComment("// Used values"); - return; - } - - // Fortran-Cuda - - eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); - edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); - for (var = uses_list; var; var = var->rhs()) - { - s = var->lhs()->symbol(); - if (!isByValue(s)) // passing argument by reference - { - st = s->makeVarDeclStmt(); - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - continue; - } - if (s->variant() == CONST_NAME) - s = new SgSymbol(VARIABLE_NAME, s->identifier(), s->type(), kernel_st); - st = s->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - } - - if (st) - st->addComment("! Used values\n"); -} - -void DeclareDummyArgumentsForReductions(SgSymbol *red_count_symb, SgType *idxTypeInKernel) - -// declare reduction dummy arguments - -{ - reduction_operation_list *rsl = NULL; - SgExpression *eatr = NULL, *edev = NULL, *el = NULL; - SgStatement *st = NULL; - - eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); - edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); - - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - for (el = rsl->formal_arg; el; el = el->rhs()) // location array values for MAXLOC/MINLOC - { - st = el->lhs()->symbol()->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - } - - for (el = rsl->value_arg; el; el = el->rhs()) // reduction variable is array of known size - { - st = el->lhs()->symbol()->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - } - if (rsl->redvar_size == 0) // reduction variable is scalar - { - st = rsl->redvar->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - } - - if (rsl->redvar_size < 0) // reduction variable is array of unknown size - { - st = rsl->red_init->makeVarDeclStmt(); - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - } - - } - if (red_struct_list) - st->addComment("! Initial reduction values\n"); - - st = NULL; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - for (el = rsl->dimSize_arg; el; el = el->rhs()) // reduction variable is array of unknown size - { - st = el->lhs()->symbol()->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - } - for (el = rsl->lowBound_arg; el; el = el->rhs()) // reduction variable is array of unknown size - { - st = el->lhs()->symbol()->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - } - } - if (st) - st->addComment("! Bounds of reduction arrays \n"); - - - // declare red_count variable - if (red_count_symb) - { - st = red_count_symb->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - st->addComment("! Number of threads to perform reduction\n"); - } - - // declare overall_blocks variable - if (s_overall_blocks) - { - SgSymbol *copy_overall = new SgSymbol(s_overall_blocks->variant(), s_overall_blocks->identifier(), idxTypeInKernel, s_overall_blocks->scope()); - st = copy_overall->makeVarDeclStmt(); - st->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*st); - st->addComment("! Number of blocks to perform reduction \n"); - } - - // declare arrays to collect reduction values - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (rsl->loc_grid) - { - st = rsl->loc_grid->makeVarDeclStmt(); - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - } - - st = rsl->red_grid->makeVarDeclStmt(); - st->setExpression(2, *edev); - kernel_st->insertStmtAfter(*st); - } - if (red_struct_list) - st->addComment("! Array to collect reduction values\n"); -} - - -SgStatement *AssignStatement(SgExpression *le, SgExpression *re) -{ - SgStatement *ass = NULL; - if (options.isOn(C_CUDA)) // in C Language - ass = new SgCExpStmt(SgAssignOp(*le, *re)); - else // in Fortan Language - ass = new SgAssignStmt(*le, *re); - return(ass); -} - -SgStatement *FunctionCallStatement(SgSymbol *sf) -{ - SgStatement *stmt = NULL; - if (options.isOn(C_CUDA)) // in C Language - stmt = new SgCExpStmt(*new SgFunctionCallExp(*sf)); - else // in Fortan Language - stmt = new SgCallStmt(*sf); - return(stmt); -} - -SgStatement *Declaration_Statement(SgSymbol *s) -{ - SgStatement *stmt = NULL; - if (options.isOn(C_CUDA)) // in C Language - stmt = makeSymbolDeclaration(s); - else // in Fortan Language - stmt = s->makeVarDeclStmt(); - return(stmt); -} - -SgStatement *Assign_To_ibof(int rank) -{ - SgStatement *ass = NULL; - // ibof = (blockIdx%x - 1) * for Fortran-Cuda - // or - // ibof = blockIdx%x * for C_Cuda - ass = AssignStatement(new SgVarRefExp(s_ibof), ExpressionForIbof(rank)); - return(ass); -} - -SgExpression *ExpressionForIbof(int rank) -{ - if (options.isOn(C_CUDA)) - // blockIdx%x * - return(& - ((*new SgRecordRefExp(*s_blockidx, "x")) * (*new SgValueExp(rank * 2)))); - else - // (blockIdx%x - 1) * - return(& - ((*new SgRecordRefExp(*s_blockidx, "x") - (*new SgValueExp(1))) * (*new SgValueExp(rank * 2)))); -} - -SgStatement *Assign_To_rest_blocks(int i) -{ - SgStatement *ass = NULL; - SgExpression *e = NULL; - // if i=0 - // rest_blocks = blockIdx%x - 1 for Fortran-Cuda - // or - // rest_blocks = blockIdx%x for C_Cuda - //if i>0 - // rest_blocks=rest_blocks - cur_blocks*blocks_i - if (i == 0) - { - e = &(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, "x")); - e = options.isOn(C_CUDA) ? e : &(*e - *new SgValueExp(1)); - } - else - e = &(*new SgVarRefExp(s_rest_blocks) - *new SgVarRefExp(s_cur_blocks) * (*new SgVarRefExp(s_blocksS_k[i - 1]))); - - ass = AssignStatement(new SgVarRefExp(s_rest_blocks), e); - return(ass); -} - -SgStatement *Assign_To_cur_blocks(int i, int nloop) -{ - SgStatement *ass = NULL; - SgExpression *e = NULL; - // cur_blocks = rest_blocks / blocks_i i=0,1,2,...nloop-2 - // or - // cur_blocks = rest_blocks i = nloop-1 - e = i != nloop - 1 ? &(*new SgVarRefExp(s_rest_blocks) / *new SgVarRefExp(s_blocksS_k[i])) : new SgVarRefExp(s_rest_blocks); - ass = AssignStatement(new SgVarRefExp(s_cur_blocks), e); - return(ass); -} - - -SgStatement *Assign_To_IndVar(SgStatement *dost, int il, int nloop, SgSymbol *sblock) -{ - SgExpression *thr = NULL, *re = NULL; - SgSymbol *indvar = NULL; - SgStatement *ass = NULL; - int H, ist; - // H == 2 - // = blocks(ibof + <2*il>) + (threadIdx%x - 1) [ * ] , il=0,1,2 - // or for C_Cuda - // = blocks(ibof + <2*il>) + threadIdx%x [ * ] , il=0,1,2 - - H = 2; - if (il == nloop - 1) - thr = new SgRecordRefExp(*s_threadidx, "x"); - else if (il == (nloop - 2)) - thr = new SgRecordRefExp(*s_threadidx, "y"); - else if (il == nloop - 3) - thr = new SgRecordRefExp(*s_threadidx, "z"); - indvar = dost->symbol(); - if (il >= nloop - 3) - { - re = options.isOn(C_CUDA) ? thr : &(*thr - (*new SgValueExp(1))); - //estep=((SgForStmt *)dost)->step(); - //if( estep && ( ist=IConstStep(estep)) != 1 ) - if ((ist = IConstStep(dost)) != 1) - *re = *re * (*new SgValueExp(ist)); - *re = (*blocksRef(sblock, H*il)) + (*re); - } - else - re = blocksRef(sblock, H*il); - - ass = AssignStatement(new SgVarRefExp(indvar), re); - return(ass); -} - -SgStatement *Assign_To_IndVar2(SgStatement *dost, int i, int nloop) -{ - SgStatement *ass = NULL; - SgExpression *e = NULL, *step_e = NULL, *eth = NULL, *es = NULL; - - int ist; - // i = 1,...,nloop - - e = new SgVarRefExp(s_begin[i - 1]); - - if ((ist = IConstStep(dost)) == 0) - step_e = new SgVarRefExp(s_loopStep[i-1]); // step is not constant - else if (ist != 1 ) // step is constant other than 1 - step_e = new SgValueExp(ist); - - if (i == nloop) - // ind_i = begin_i + (cur_blocks*blockDim%x + threadIdx%x [- 1]) [ * step_i ] - { - eth = ThreadIdxRefExpr("x"); - if (currentLoop && currentLoop->irregularAnalysisIsOn()) - es = &((*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "x") + *eth) / *new SgVarRefExp(s_warpsize)); - else - es = &(*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "x") + *eth); - es = step_e == NULL ? es : &(*es * *step_e); - e = &(*e + *es); - } - else if (i == nloop - 1) - // ind_i = begin_i + (cur_blocks*blockDim%y + threadIdx%y [- 1]) [ * step_i ] - { - eth = ThreadIdxRefExpr("y"); - es = &(*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "y") + *eth); - es = step_e == NULL ? es : &(*es * *step_e); - e = &(*e + *es); - } - else if (i == nloop - 2) - // ind_i = begin_i + (cur_blocks*blockDim%z + threadIdx%z [- 1]) [ * step_i ] - { - eth = ThreadIdxRefExpr("z"); - es = &(*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "z") + *eth); - es = step_e == NULL ? es : &(*es * *step_e); - e = &(*e + *es); - } - else // 1 <= i <= nloop - 3 - // ind_i = begin_i + cur_blocks [ * step_i ] - { - es = new SgVarRefExp(s_cur_blocks); - es = step_e == NULL ? es : &(*es * *step_e); - e = &(*e + *es); - } - ass = AssignStatement(new SgVarRefExp(dost->symbol()), e); - return(ass); - -} - -SgExpression *IbaseRef(SgSymbol *base, int ind) -{ - return(new SgArrayRefExp(*base, (*new SgVarRefExp(s_ibof) + (*new SgValueExp(ind))))); -} - -SgExpression *blocksRef(SgSymbol *sblock, int ind) -{ - return(new SgArrayRefExp(*sblock, (*new SgVarRefExp(s_ibof) + (*new SgValueExp(ind))))); -} - -/*!!! -void InsertDoWhileForRedCount(SgStatement *cp) -{ // inserting after statement cp (DO_WHILE) the block for red_count calculation: -// red_count = 1 -// do while (red_count * 2 .lt. threads%x * threads%y * threads%z) -// red_count = red_count * 2 -// end do - -SgStatement *st_while, *ass; -SgExpression *cond; - -RedCountSymbol(); - -// red_count * 2 .lt. threads%x * threads%y * threads%z -cond= & operator < ( *new SgVarRefExp(red_count_symb) * (*new SgValueExp(2)), *ThreadsGridSize(s_threads)); -// insert do while loop -ass = new SgAssignStmt(*new SgVarRefExp(red_count_symb), (*new SgVarRefExp(red_count_symb))*(*new SgValueExp(2))); -st_while = new SgWhileStmt(*cond,*ass); -cp->insertStmtAfter(*st_while,*cp); -// insert: red_count = 1 -ass = new SgAssignStmt(*new SgVarRefExp(red_count_symb), *new SgValueExp(1)); -cp->insertStmtAfter(*ass,*cp); -} -*/ - -SgExpression *ThreadIdxRefExpr(char *xyz) -{ - if (options.isOn(C_CUDA)) - return(new SgRecordRefExp(*s_threadidx, xyz)); - else - return(&(*new SgRecordRefExp(*s_threadidx, xyz) - *new SgValueExp(1))); -} - -SgExpression *ThreadIdxRefExpr(const char *xyz) -{ - if (options.isOn(C_CUDA)) - return(new SgRecordRefExp(*s_threadidx, xyz)); - else - return(&(*new SgRecordRefExp(*s_threadidx, xyz) - *new SgValueExp(1))); -} - -SgExpression *BlockIdxRefExpr(char *xyz) -{ - if (!options.isOn(NO_BL_INFO)) - { - if (options.isOn(C_CUDA)) - return(new SgRecordRefExp(*s_blockidx, xyz)); - else - return(&(*new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); - } - // without blocks_info - if (options.isOn(C_CUDA)) - return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz))); - else - return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); -} - -SgExpression *BlockIdxRefExpr(const char *xyz) -{ - if (!options.isOn(NO_BL_INFO)) - { - if (options.isOn(C_CUDA)) - return(new SgRecordRefExp(*s_blockidx, xyz)); - else - return(&(*new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); - } - // without blocks_info - if (options.isOn(C_CUDA)) - return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz))); - else - return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); -} - -void CreateReductionBlocks(SgStatement *stat, int nloop, SgExpression *red_op_list, SgSymbol *red_count_symb) -{ - SgStatement *newst = NULL, *ass = NULL, *dost = NULL; - SgExpression *er = NULL, *re = NULL; - SgSymbol *i_var = NULL, *j_var = NULL; - reduction_operation_list *rsl = NULL; - int n = 0; - - formal_red_grid_list = NULL; - - // index variables - dost = DoStmt(first_do_par, nloop); - i_var = dost->symbol(); - - if (!options.isOn(C_CUDA)) - { - if (nloop > 1) - j_var = dost->controlParent()->symbol(); - else - { - j_var = IndVarInKernel(i_var); - newst = Declaration_Statement(j_var); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - } - - // declare '_block' array for each reduction var - // = threadIdx%x -1 + [ (threadIdx%y - 1) * blockDim%x [ + (threadIdx%z - 1) * blockDim%x * blockDim%y ] ] - // or C_Cuda - // = threadIdx%x + [ threadIdx%y * blockDim%x [ + threadIdx%z * blockDim%x * blockDim%y ] ] - - //re = & ( *new SgRecordRefExp(*s_threadidx,"x") - *new SgValueExp(1) ); - re = ThreadIdxRefExpr("x"); - if (options.isOn(C_CUDA)) - { - re = &(*re + (*ThreadIdxRefExpr("y")) * (*new SgRecordRefExp(*s_blockdim, "x"))); - re = &(*re + (*ThreadIdxRefExpr("z")) * (*new SgRecordRefExp(*s_blockdim, "x") * (*new SgRecordRefExp(*s_blockdim, "y")))); - } - else - { - if (nloop > 1) - //re = &( *re + ((*new SgRecordRefExp(*s_threadidx,"y")) - (*new SgValueExp(1))) * (*new SgRecordRefExp(*s_blockdim,"x"))); - re = &(*re + (*ThreadIdxRefExpr("y")) * (*new SgRecordRefExp(*s_blockdim, "x"))); - if (nloop > 2) - //re = &( *re + ((*new SgRecordRefExp(*s_threadidx,"z")) - (*new SgValueExp(1))) * (*new SgRecordRefExp(*s_blockdim,"x") * (*new SgRecordRefExp(*s_blockdim,"y")))); - re = &(*re + (*ThreadIdxRefExpr("z")) * (*new SgRecordRefExp(*s_blockdim, "x") * (*new SgRecordRefExp(*s_blockdim, "y")))); - } - ass = AssignStatement(new SgVarRefExp(i_var), re); - - if (options.isOn(C_CUDA)) - ass->addComment("// Reduction"); - else - ass->addComment("! Reduction\n"); - - //looking through the reduction_op_list - - SgIfStmt *if_st = NULL; - SgIfStmt *if_del = NULL; - SgIfStmt *if_new = NULL; - int declArrayVars = 1; - - if (options.isOn(C_CUDA)) - if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var) % *new SgVarRefExp(s_warpsize), *new SgValueExp(0))); - - bool assInserted = false; - for (er = red_op_list, rsl = red_struct_list, n = 1; er; er = er->rhs(), rsl = rsl->next, n++) - { - if (rsl->redvar_size < 0 && options.isOn(C_CUDA)) // array of [UNknown size] or arrays that have [ > 16 elems] - continue; - - if (!assInserted) - { - stat->insertStmtBefore(*ass, *stat->controlParent()); - assInserted = true; - } - - if (options.isOn(C_CUDA)) - ReductionBlockInKernel_On_C_Cuda(stat, i_var, er->lhs(), rsl, if_st, if_del, if_new, declArrayVars); - else - ReductionBlockInKernel(stat, nloop, i_var, j_var, er->lhs(), rsl, red_count_symb, n); - } - - - if (options.isOn(C_CUDA) && assInserted) - stat->insertStmtBefore(*if_st, *stat->controlParent()); -} - -char* getMultipleTypeName(SgType *base, int num) -{ - char dnum = '0' + num; - char *ret = new char[32]; - ret[0] = '\0'; - - if (base->variant() == SgTypeChar()->variant()) - strcat(ret, "char"); - else if (base->variant() == SgTypeInt()->variant()) - strcat(ret, "int"); - else if (base->variant() == SgTypeDouble()->variant()) - strcat(ret, "double"); - else if (base->variant() == SgTypeFloat()->variant()) - strcat(ret, "float"); - - int len = strlen(ret); - if (len != 0 && num > 0) - { - ret[len] = dnum; - ret[len + 1] = '\0'; - } - return ret; -} - -void ReductionBlockInKernel_On_C_Cuda(SgStatement *stat, SgSymbol *i_var, SgExpression *ered, reduction_operation_list *rsl, - SgIfStmt *if_st, SgIfStmt *&delIf, SgIfStmt *&newIf, int &declArrayVars, bool withGridReduction, bool across) -{ - SgStatement *newst; - SgFunctionCallExp *fun_ref = NULL; - - SgExpression *ex = &(*new SgVarRefExp(i_var) / *new SgVarRefExp(s_warpsize)); - // blockDim.x * blockDim.y * blockDim.z / warpSize - SgExpression *ex1 = &(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z") / *new SgVarRefExp(s_warpsize)); - // blockDim.x * blockDim.y * blockDim.z - SgExpression *ex2 = &(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z")); - - if (rsl->redvar_size != 0) // array reduction - { - if (rsl->redvar_size > 0) // array of known size - { - char *funcName = new char[256]; - - //declare red_var variable - if (rsl->array_red_size > 0) - { - SgSymbol *s = rsl->redvar; - SgArrayType *arrT = new SgArrayType(*C_Type(s->type()->baseType())); - arrT->addRange(*new SgValueExp(rsl->array_red_size)); - SgSymbol *forDecl = new SgVariableSymb(rsl->redvar->identifier(), *arrT, *kernel_st); - newst = Declaration_Statement(forDecl); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - else - { - newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->redvar, NULL, NULL)); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - - funcName[0] = '\0'; - strcat(funcName, RedFunctionInKernelC((const int)RedFuncNumber(ered->lhs()), rsl->redvar_size, 0)); - SgExpression *tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), new SgValueExp(rsl->redvar_size), NULL); - - fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel(funcName)); - fun_ref->addArg(*new SgVarRefExp(rsl->redvar)); - fun_ref->setRhs(tmplArgs); - stat->insertStmtBefore(*new SgCExpStmt(*fun_ref), *stat->controlParent()); - - int idx = 0; - for (int k = 0; k < rsl->redvar_size; ++k) - { - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgVarRefExp(s_overall_blocks) * *new SgValueExp(idx) - + *BlockIdxRefExpr("x") * *ex1 + *ex), new SgArrayRefExp(*rsl->redvar, *new SgValueExp(idx))); - idx++; - if_st->lastExecutable()->insertStmtAfter(*newst); - } - } - else // array of [UNknown size] or arrays that have [ > 16 elems] - { - int rank = Rank(rsl->redvar); - - if (rsl->array_red_size < 1) - { - char *newN = new char[strlen(rsl->redvar->identifier()) + 9]; - newN[0] = '\0'; - strcat(newN, "__addr_"); - strcat(newN, rsl->redvar->identifier()); - SgSymbol *tmp = new SgSymbol(VARIABLE_NAME, newN, C_DvmType(), kernel_st); - newst = Declaration_Statement(tmp); - newst->addDeclSpec(BIT_CUDA_SHARED); - kernel_st->insertStmtAfter(*newst, *kernel_st); - - // insert IF-block with new stmts - SgArrayType *arr = new SgArrayType(*C_Type(rsl->redvar->type()->baseType())); - SgExpression *dims = RedVarUpperBound(rsl->dimSize_arg, 1); - for (int i = 2; i <= rank; ++i) - dims = &(*dims * *RedVarUpperBound(rsl->dimSize_arg, i)); - // new type[ num * blockDims] - arr->addDimension(&(*dims * *new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z"))); - SgNewExp *newEx = new SgNewExp(*arr); - - if (newIf) - newIf->lastExecutable()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *newEx))); - else - { - // i = threadIdx.x + threadIdx.y * blockDim.x + threadIdx.z * (blockDim.x * blockDim.y); - SgStatement *idx = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(i_var), - *new SgRecordRefExp(*s_threadidx, "x") + *new SgRecordRefExp(*s_threadidx, "y") * *new SgRecordRefExp(*s_blockdim, "x") + *new SgRecordRefExp(*s_threadidx, "z") * *new SgRecordRefExp(*s_blockdim, "x")* *new SgRecordRefExp(*s_blockdim, "y"))); - newIf = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var), *new SgValueExp(0)), *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *newEx))); - - kernel_st->lexNext()->insertStmtAfter(*FunctionCallStatement(SyncthreadsSymbol())); - kernel_st->lexNext()->insertStmtAfter(*newIf); - kernel_st->lexNext()->insertStmtAfter(*idx); - idx->addComment(" // Allocate memory for reduction"); - } - - SgPointerType *pointer = new SgPointerType(*C_Type(rsl->redvar->type()->baseType())); - SgReferenceType *ref = new SgReferenceType(*C_DvmType()); - newIf->lastExecutable()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(tmp), *new SgCastExp(*ref, *new SgVarRefExp(rsl->redvar))))); - newIf->lastNodeOfStmt()->lexNext()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *new SgVarRefExp(rsl->redvar) + *new SgVarRefExp(i_var)))); - newIf->lastNodeOfStmt()->lexNext()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *new SgCastExp(*pointer, *new SgVarRefExp(tmp))))); - - - // insert IF-block with delete stmts - SgDeleteExp *delEx = new SgDeleteExp(*new SgVarRefExp(rsl->redvar)); - if (delIf) - delIf->lastExecutable()->insertStmtAfter(*new SgCExpStmt(*delEx)); - else - { - delIf = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var), *new SgValueExp(0)), *new SgCExpStmt(*delEx)); - newst = FunctionCallStatement(SyncthreadsSymbol()); - - if_st->lastNodeOfStmt()->insertStmtAfter(*delIf); - if_st->lastNodeOfStmt()->insertStmtAfter(*newst); - newst->addComment(" // Deallocate memory for reduction"); - } - } - - //declare red_var variable - if (rsl->array_red_size > 0) - { - SgSymbol *s = rsl->redvar; - SgArrayType *arrT = new SgArrayType(*C_Type(s->type()->baseType())); - arrT->addRange(*new SgValueExp(rsl->array_red_size)); - SgSymbol *forDecl = new SgVariableSymb(rsl->redvar->identifier(), *arrT, *kernel_st); - newst = Declaration_Statement(forDecl); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - else - { - newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->redvar, NULL, NULL)); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - - for (int i = declArrayVars; i <= rank; ++i) - { - newst = Declaration_Statement(IndexLoopVar(i)); //declare red_varIDX variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - declArrayVars = MAX(declArrayVars, rank); - - - char *funcName = new char[256]; - SgExpression *tmplArgs; - - funcName[0] = '\0'; - strcat(funcName, RedFunctionInKernelC((const int)RedFuncNumber(ered->lhs()), rsl->array_red_size, 0)); - if (rsl->array_red_size > 1) - tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), new SgValueExp(rsl->array_red_size), NULL); - else - tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), RedVarUpperBound(rsl->dimSize_arg, 1), NULL); - - fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel(funcName)); - fun_ref->addArg(*new SgVarRefExp(rsl->redvar)); - if (rsl->array_red_size > 0) - fun_ref->setRhs(tmplArgs); - else - { - // blockDims - fun_ref->addArg(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z")); - SgExpression *dims = RedVarUpperBound(rsl->dimSize_arg, 1); - for (int i = 2; i <= rank; ++i) - dims = &(*dims * *RedVarUpperBound(rsl->dimSize_arg, i)); - fun_ref->addArg(*dims); - } - stat->insertStmtBefore(*new SgCExpStmt(*fun_ref), *stat->controlParent()); - - if (rsl->array_red_size > 1) - { - int idx = 0; - for (int k = 0; k < rsl->array_red_size; ++k) - { - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgVarRefExp(s_overall_blocks) * *new SgValueExp(idx) - + *BlockIdxRefExpr("x") * *ex1 + *ex), new SgArrayRefExp(*rsl->redvar, *new SgValueExp(idx))); - idx++; - if_st->lastExecutable()->insertStmtAfter(*newst); - } - } - else - { - SgExpression *linearIdx = new SgVarRefExp(IndexLoopVar(1)); - for (int i = 2; i <= rank; ++i) - { - SgExpression *dims = RedVarUpperBound(rsl->dimSize_arg, 1); - for (int k = 2; k < i; ++k) - dims = &(*dims * *RedVarUpperBound(rsl->dimSize_arg, k)); - linearIdx = &(*linearIdx + *new SgVarRefExp(IndexLoopVar(i)) * *dims); - } - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgVarRefExp(s_overall_blocks) * *linearIdx - + *BlockIdxRefExpr("x") * *ex1 + *ex), new SgArrayRefExp(*rsl->redvar, *linearIdx * *ex2)); - if_st->lastExecutable()->insertStmtAfter(*doLoopNestForReductionArray(rsl, newst)); - } - } - } - else if (rsl->locvar) // maxloc/minloc reduction scalar - { - newst = Declaration_Statement(LocRedVariableSymbolInKernel(rsl)); //declare location variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - - // __dvmh_blockReduceLoc(, ) - fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel((char *)RedFunctionInKernelC((const int)RedFuncNumber(ered->lhs()), 1, rsl->number))); - fun_ref->addArg(*new SgVarRefExp(*rsl->redvar)); - if (rsl->number == 1) - fun_ref->addArg(SgAddrOp(*new SgVarRefExp(*rsl->locvar))); - else - fun_ref->addArg(*new SgVarRefExp(*rsl->locvar)); - - SgExpression *tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), - new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->locvar->type())), new SgValueExp(rsl->number), NULL), NULL); - fun_ref->setRhs(tmplArgs); - - stat->insertStmtBefore(*new SgCExpStmt(*fun_ref), *stat->controlParent()); - - if (across) - { - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *ex), new SgVarRefExp(rsl->redvar)); - - SgExpression* cond = if_st->conditional(); - int redVar = RedFuncNumber(ered->lhs()); - if (redVar == 9) // maxloc - cond = &(*cond && (*new SgVarRefExp(rsl->redvar) > *new SgArrayRefExp(*rsl->red_grid, *ex))); - else if (redVar == 10) // minloc - cond = &(*cond && (*new SgVarRefExp(rsl->redvar) < *new SgArrayRefExp(*rsl->red_grid, *ex))); - - if_st->setConditional(cond); - } - else - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x") * *ex1 + *ex), new SgVarRefExp(rsl->redvar)); - - if_st->insertStmtAfter(*newst); - - if (rsl->number > 1) - { - for (int i = 0; i < rsl->number; ++i) - { - if (across) - newst = AssignStatement(new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(rsl->number) * *ex + *new SgValueExp(i)), new SgArrayRefExp(*rsl->locvar, *new SgValueExp(i))); - else - newst = AssignStatement(new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(rsl->number) * (*BlockIdxRefExpr("x") * *ex1 + *ex) + *new SgValueExp(i)), new SgArrayRefExp(*rsl->locvar, *new SgValueExp(i))); - if_st->lastExecutable()->insertStmtAfter(*newst); - } - } - else - { - if (across) - newst = AssignStatement(new SgArrayRefExp(*rsl->loc_grid, *ex), new SgVarRefExp(*rsl->locvar)); - else - newst = AssignStatement(new SgArrayRefExp(*rsl->loc_grid, *BlockIdxRefExpr("x") * *ex1 + *ex), new SgVarRefExp(*rsl->locvar)); - if_st->lastExecutable()->insertStmtAfter(*newst); - } - - } - else // scalar reduction - { - // = __dvmh_blockReduce() - fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel((char *)RedFunctionInKernelC(RedFuncNumber(ered->lhs()), 1, 0))); - fun_ref->addArg(*new SgVarRefExp(*rsl->redvar)); - newst = AssignStatement(new SgVarRefExp(*rsl->redvar), fun_ref); - stat->insertStmtBefore(*newst, *stat->controlParent()); - - if (withGridReduction) - { - SgExpression* gridRef = NULL; - if (across) - gridRef = new SgArrayRefExp(*rsl->red_grid, *ex); - else - gridRef = new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x") * *ex1 + *ex); - - SgExpression* redRef = new SgVarRefExp(rsl->redvar); - int redVar = RedFuncNumber(ered->lhs()); - if (redVar == 1) // sum - newst = AssignStatement(gridRef, &(gridRef->copy() + *redRef)); - if (redVar == 2) // product - newst = AssignStatement(gridRef, &(gridRef->copy() * *redRef)); - if (redVar == 3) // max - { - SgFunctionCallExp* fCall = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "max")); - fCall->addArg(gridRef->copy()); - fCall->addArg(*redRef); - newst = AssignStatement(gridRef, fCall); - } - if (redVar == 4) // min - { - SgFunctionCallExp* fCall = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "min")); - fCall->addArg(gridRef->copy()); - fCall->addArg(*redRef); - newst = AssignStatement(gridRef, fCall); - } - if (redVar == 5) // and - newst = AssignStatement(gridRef, new SgExpression(BITAND_OP, &gridRef->copy(), redRef)); - if (redVar == 6) // or - newst = AssignStatement(gridRef, new SgExpression(BITOR_OP, &gridRef->copy(), redRef)); - -#ifdef INTEL_LOGICAL_TYPE - if (redVar == 7) // neqv - newst = AssignStatement(gridRef, new SgExpression(XOR_OP, &gridRef->copy(), redRef)); - if (redVar == 8) // eqv - newst = AssignStatement(gridRef, new SgExpression(BIT_COMPLEMENT_OP, new SgExpression(XOR_OP, &gridRef->copy(), redRef), NULL)); -#else - if (redVar == 7) // neqv - newst = AssignStatement(gridRef, &(gridRef->copy() != *redRef)); - if (redVar == 8) // eqv - newst = AssignStatement(gridRef, &(gridRef->copy() == *redRef)); -#endif - } - else - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x") * *ex1 + *ex), new SgVarRefExp(rsl->redvar)); - if_st->insertStmtAfter(*newst); - } -} - -void ReductionBlockInKernel(SgStatement *stat, int nloop, SgSymbol *i_var, SgSymbol *j_var, SgExpression *ered, reduction_operation_list *rsl, SgSymbol *red_count_symb, int n) -{ - SgStatement *ass = NULL, *newst = NULL, *current = NULL, *if_st = NULL, *while_st = NULL, *typedecl = NULL, *st = NULL, *do_st = NULL; - SgExpression *le = NULL, *re = NULL, *eatr = NULL, *cond = NULL, *ev = NULL, *subscript_list = NULL; - SgSymbol *red_var = NULL, *red_var_k = NULL, *s_block = NULL, *loc_var = NULL, *sf = NULL; - SgType *rtype = NULL; - int i, ind; - loc_el_num = 0; - - //call syncthreads() for second, third,... reduction operation (n>1) - if (n > 1) - { - newst = FunctionCallStatement(SyncthreadsSymbol()); - stat->insertStmtBefore(*newst, *stat->controlParent()); - } - // analys of reduction operation - // ered - reduction operation (variant==ARRAY_OP) - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - if (isSgExprListExp(ev)) // for MAXLOC,MINLOC - { - loc_var = ev->rhs()->lhs()->symbol(); //location array reference - ev = ev->lhs(); // reduction variable reference - } - else - loc_var = NULL; - - // _block([ k,] i) = [k=LowerBound:UpperBound] - // or for MAXLOC,MINLOC - // _block(i)% = - // _block(i)%(1) = (1) - // [_block(i)%(2) = (2) ] - // . . . - // create and declare array '_block' - red_var = ev->symbol(); - - if (rsl->locvar) - { - newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->locvar, NULL, NULL)); //declare location variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - //SymbolChange_InBlock(new SgSymbol(VARIABLE_NAME,"aaaa",rsl->locvar->type(),kernel_st),rsl->locvar,cur_in_kernel,cur_in_kernel->lastNodeOfStmt()); - } - - if (rsl->redvar_size != 0) - { - red_var_k = RedVariableSymbolInKernel(rsl->redvar, rsl->dimSize_arg, rsl->lowBound_arg); - newst = Declaration_Statement(red_var_k); //declare reduction variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - if(rsl->locvar) - Error("Reduction variable %s is array (array element), not implemented yet for GPU", ered->rhs()->rhs()->lhs()->symbol()->identifier(), 597, dvm_parallel_dir); - } - rtype = (rsl->redvar_size == 0) ? TypeOfRedBlockSymbol(ered) : red_var_k->type(); - - s_block = RedBlockSymbolInKernel(red_var, rtype); - - newst = Declaration_Statement(s_block); - - if (options.isOn(C_CUDA)) // in C Language - newst->addDeclSpec(BIT_CUDA_SHARED | BIT_EXTERN); - else // in Fortran Language - { - eatr = new SgExprListExp(*new SgExpression(ACC_SHARED_OP)); - newst->setExpression(2, *eatr); - } - - kernel_st->insertStmtAfter(*newst, *kernel_st); - - // create assign statement[s] - if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC - { - typedecl = MakeStructDecl(rtype->symbol()); - kernel_st->insertStmtAfter(*typedecl, *kernel_st); - sf = RedVarFieldSymb(s_block); - le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgVarRefExp((sf))); - re = new SgVarRefExp(red_var); - ass = AssignStatement(le, re); - stat->insertStmtBefore(*ass, *stat->controlParent()); - for (i = 1; i <= rsl->number; i++) - { - ind = options.isOn(C_CUDA) ? i - 1 : i; - le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); - if (isSgArrayType(rsl->locvar->type())) - re = new SgArrayRefExp(*(rsl->locvar), *LocVarIndex(rsl->locvar, i)); - else - re = new SgVarRefExp(*(rsl->locvar)); - ass = AssignStatement(le, re); - stat->insertStmtBefore(*ass, *stat->controlParent()); - } - } - else if (rsl->redvar_size > 0) //reduction variable is array of known size - - for (i = 0; i < rsl->redvar_size; i++) - { - SgExpression *red_ind; - red_ind = RedVarIndex(red_var, i); - le = RedVar_Block_2D_Ref(s_block, i_var, red_ind); - re = new SgArrayRefExp(*red_var, *red_ind); - ass = AssignStatement(le, re); - stat->insertStmtBefore(*ass, *stat->controlParent()); - } - - else if (rsl->redvar_size == 0) //reduction variable is scalar - { - le = RedVar_Block_Ref(s_block, i_var); - re = new SgVarRefExp(red_var); - ass = AssignStatement(le, re); - stat->insertStmtBefore(*ass, *stat->controlParent()); - } - else //reduction variable is array of unknown size - { - subscript_list = SubscriptListOfRedArray(rsl->redvar); - le = RedArray_Block_Ref(s_block, i_var, &subscript_list->copy()); - re = new SgArrayRefExp(*rsl->redvar, subscript_list->copy()); - ass = AssignStatement(le, re); - // create loop nest and insert it before 'stat' - do_st = doLoopNestForReductionArray(rsl, ass); - stat->insertStmtBefore(*do_st, *stat->controlParent()); - while (do_st->variant() == FOR_NODE) - do_st = do_st->lexNext(); - stat = do_st->lexNext(); // CONTROL_END of innermost loop - } - - //call syncthreads() - newst = FunctionCallStatement(SyncthreadsSymbol()); - stat->insertStmtBefore(*newst, *stat->controlParent()); - - // [if (i .lt. red_count) then ] // for last reduction of loop /*24.10.12*/ - // if (i + red_count .lt. blockDim%x [* blockDim%y [* blockDim%z]]) then - // _block([ k,] i) = (_block([ k,] i), _block([ k,] i + red_count)) [k=LowerBound:UpperBound] - // end if - // [ endif ] - - // or for MAXLOC,MINLOC - // [if (i .lt. red_count) then ] // for last reduction of loop /*24.10.12*/ - // if (i + red_count .lt. blockDim%x [* blockDim%y [* blockDim%z]]) then - // if(_block(i + red_count)% .gt. _block(i)%) then//MAXLOC - // _block(i)% = _block(i + red_count)% - // _block(i)%(1) = _block(i + red_count)%(1) - // [_block(i)%(2) = _block(i + red_count)%(2) ] - // . . . - // endif - // endif - // [ endif ] - re = new SgRecordRefExp(*s_blockdim, "x"); - if (nloop > 1) - re = &(*re * (*new SgRecordRefExp(*s_blockdim, "y"))); - if (nloop > 2) - re = &(*re * (*new SgRecordRefExp(*s_blockdim, "z"))); - cond = &operator < ((*new SgVarRefExp(i_var) + *new SgVarRefExp(red_count_symb)), *re); - - if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC - newst = RedOp_If(i_var, s_block, ered, red_count_symb, rsl->number); - else - newst = RedOp_Assign(i_var, s_block, ered, red_count_symb, 0, rsl->redvar_size < 0 ? &subscript_list->copy() : NULL); - if_st = new SgIfStmt(*cond, *newst); - if (rsl->redvar_size > 0) - for (i = 1; i < rsl->redvar_size; i++) - { - newst->insertStmtAfter(*(ass = RedOp_Assign(i_var, s_block, ered, red_count_symb, i, NULL)), *if_st); - newst = ass; - } - if (!rsl->next && rsl->redvar_size >= 0) //last reduction of loop, not array of unknown size - { - cond = &operator < (*new SgVarRefExp(i_var), *new SgVarRefExp(red_count_symb)); - newst = new SgIfStmt(*cond, *if_st); - stat->insertStmtBefore(*newst, *stat->controlParent()); - } - else - stat->insertStmtBefore(*if_st, *stat->controlParent()); - - // j = red_count / 2 - ass = AssignStatement(new SgVarRefExp(j_var), &(*new SgVarRefExp(red_count_symb) / *new SgValueExp(2))); - if (!rsl->next && rsl->redvar_size >= 0) //last reduction of loop, not array of unknown size - if_st->insertStmtAfter(*ass, *newst); - //!!!if_st->insertStmtAfter(*ass,*stat->controlParent()); //!!!if_st->insertStmtAfter(*ass,*newst); - else - stat->insertStmtBefore(*ass, *stat->controlParent()); - current = ass; - //!!!last = ass->lexNext(); - - // if (i .eq. 0) then - // _grid( blockIdx%x - 1,[ m]) = _block([ k,] 0) [k=LowerBound:UpperBound, m=1,...] - // endif - // - // or for MAXLOC,MINLOC - // - // if (i .eq. 0) then - // _grid (blockIdx%x [ - 1 ] ) = _block(0)% - // _grid(1, blockIdx%x - 1 ) = _block(0)%(1) or if C_Cuda _grid[(L-1)*blockIdx%x] = _block(0)%[0] - // _grid(2, blockIdx%x - 1 ) = _block(0)%(2) or if C_Cuda _grid[(L-1)*blockIdx%x + 1] = _block(0)%[1] - // . . . - // - // endif - - cond = &SgEqOp(*new SgVarRefExp(i_var), *new SgValueExp(0)); - if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC - //newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) ) ,RedLocVar_Block_Ref(s_block,NULL,NULL,new SgVarRefExp((sf)))); - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x")), RedLocVar_Block_Ref(s_block, NULL, NULL, new SgVarRefExp((sf)))); - else - { - if (rsl->redvar_size > 0) - //newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) , *new SgValueExp(1)) , new SgArrayRefExp(*s_block, *RedVarIndex(red_var,0),*new SgValueExp(0))); - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x"), *new SgValueExp(1)), new SgArrayRefExp(*s_block, *RedVarIndex(red_var, 0), *new SgValueExp(0))); - else if (rsl->redvar_size == 0) - //newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) ) , new SgArrayRefExp(*s_block, *new SgValueExp(0))); - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x")), new SgArrayRefExp(*s_block, *new SgValueExp(0))); - else - newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *AddListToList(new SgExprListExp(*BlockIdxRefExpr("x")), &subscript_list->copy())), new SgArrayRefExp(*s_block, *AddListToList( &subscript_list->copy(), new SgValueExp(0))) ); - } - - if_st = new SgIfStmt(*cond, *newst); - if (rsl->redvar_size > 0) - for (i = 1; i < rsl->redvar_size; i++) - { - //ass = AssignStatement(new SgArrayRefExp(*rsl->red_grid,*new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1), *new SgValueExp(i+1) ) , new SgArrayRefExp(*s_block, *RedVarIndex(red_var,i),*new SgValueExp(0))); - ass = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x"), *new SgValueExp(i + 1)), new SgArrayRefExp(*s_block, *RedVarIndex(red_var, i), *new SgValueExp(0))); - newst->insertStmtAfter(*ass, *if_st); - newst = ass; - } - current->insertStmtAfter(*if_st, *current->controlParent()); - if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC - { - st = newst; - for (i = 1; i <= rsl->number; i++) - { - ind = options.isOn(C_CUDA) ? i - 1 : i; - re = RedLocVar_Block_Ref(s_block, NULL, NULL, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); - //le = new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(ind), *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) ); - if (options.isOn(C_CUDA)) - le = new SgArrayRefExp(*rsl->loc_grid, *LinearIndex(ind, rsl->number)); - else - le = new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(ind), *BlockIdxRefExpr("x")); - ass = AssignStatement(le, re); - st->insertStmtAfter(*ass, *if_st); - st = ass; - } - } - - // do while(j .ge. 1) - // call syncthreads() - // if (i .lt. j) then - // - // _block([ k,] i) = (_block([ k,] i), _block([ k,] i + j)) - // - // or for MAXLOC,MINLOC - // - // if(_block(i + j)% .gt. _block(i)%) then //MAXLOC - // _block(i)% = _block(i + j)% - // _block(i)%(1) = _block(i + j)%(1) - // [_block(i)%(2) = _block(i + j)%(2) ] - // . . . - // endif - - // end if - // end do - - cond = &operator >=(*new SgVarRefExp(j_var), *new SgValueExp(1)); - newst = FunctionCallStatement(SyncthreadsSymbol()); - while_st = new SgWhileStmt(*cond, *newst); - current->insertStmtAfter(*while_st, *current->controlParent()); - current = newst; - ass = AssignStatement(new SgVarRefExp(j_var), &(*new SgVarRefExp(j_var) / *new SgValueExp(2))); - current->insertStmtAfter(*ass, *while_st); - cond = &operator < (*new SgVarRefExp(i_var), *new SgVarRefExp(j_var)); - if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC - newst = RedOp_If(i_var, s_block, ered, j_var, rsl->number); - else - newst = RedOp_Assign(i_var, s_block, ered, j_var, 0, rsl->redvar_size < 0 ? &subscript_list->copy() : NULL); - - //!ass = RedOp_Assign(i_var,s_block,ered,j_var); - if_st = new SgIfStmt(*cond, *newst); - if (rsl->redvar_size > 0) // reduction variable is array - for (i = 1; i < rsl->redvar_size; i++) - { - newst->insertStmtAfter(*(ass = RedOp_Assign(i_var, s_block, ered, j_var, i, NULL)), *if_st); - newst = ass; - } - - current->insertStmtAfter(*if_st, *while_st); - -} - -SgExpression * LinearIndex(int ind, int L) -{ - SgExpression * e; - if (L != 1) - e = &(*new SgValueExp(L) * *BlockIdxRefExpr("x")); - else - e = BlockIdxRefExpr("x"); - if (ind) - e = &(*e + *new SgValueExp(ind)); - return(e); -} - -SgExpression *Red_grid_index(SgSymbol *sind) -{ - SgExpression *e1, *e2; - e1 = new SgRecordRefExp(*s_blockidx, "x"); - e2 = &(*new SgVarRefExp(s_blockDims) / *new SgVarRefExp(s_warpsize)); - e1 = &(*e1 * *e2); - e2 = &(*new SgVarRefExp(sind) / *new SgVarRefExp(s_warpsize)); - e1 = &(*e1 + *e2); - return(e1); -} - -SgType *TypeOfRedBlockSymbol(SgExpression *ered) -{ - SgExpression *ev, *el, *en, *ec; - SgType *type, *loc_type; - SgArrayType *typearray; - int num_el = 0; - ev = ered->rhs(); - if (!isSgExprListExp(ev)) - return(options.isOn(C_CUDA) ? C_Type(ev->symbol()->type()) : ev->symbol()->type()); - // MAXLOC,MINLOC - el = ev->rhs()->lhs(); - en = ev->rhs()->rhs()->lhs(); - // calculation number of location array, assign to global variable 'loc_el_num' - ec = Calculate(en); - if (ec->isInteger()) - loc_el_num = num_el = ec->valueInteger(); - else - Error("Can not calculate number of elements in array %s", el->symbol()->identifier(), 595, dvm_parallel_dir); - - ev = ev->lhs(); // reduction variable reference - type = ev->symbol()->type(); - if (isSgArrayType(type)) - type = type->baseType(); - if (options.isOn(C_CUDA)) - type = C_Type(type); - loc_type = el->symbol()->type(); - if (isSgArrayType(loc_type)) - loc_type = loc_type->baseType(); - if (options.isOn(C_CUDA)) - loc_type = C_Type(loc_type); - - typearray = new SgArrayType(*loc_type); - - typearray->addRange(*new SgValueExp(num_el)); - - return(Type_For_Red_Loc(ev->symbol(), el->symbol(), type, typearray)); - -} - -const char* RedFunctionInKernelC(const int num_red, const unsigned num_E = 1, const unsigned num_IE = 1) -{ - const char *retVal = NULL; - - if (num_red == 1) // sum - { - if (num_E == 1) - retVal = red_kernel_func_names[red_SUM]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_SUM_N]; - } - else if (num_red == 2) // product - { - if (num_E == 1) - retVal = red_kernel_func_names[red_PROD]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_PROD_N]; - } - else if (num_red == 3) // max - { - if (num_E == 1) - retVal = red_kernel_func_names[red_MAX]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_MAX_N]; - } - else if (num_red == 4) // min - { - if (num_E == 1) - retVal = red_kernel_func_names[red_MIN]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_MIN_N]; - } - else if (num_red == 5) // and - { - if (num_E == 1) - retVal = red_kernel_func_names[red_AND]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_AND_N]; - } - else if (num_red == 6) // or - { - if (num_E == 1) - retVal = red_kernel_func_names[red_OR]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_OR_N]; - } - else if (num_red == 7) // neqv - { - if (num_E == 1) - retVal = red_kernel_func_names[red_NEQ]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_NEQ_N]; - } - else if (num_red == 8) // eqv - { - if (num_E == 1) - retVal = red_kernel_func_names[red_EQ]; - else if (num_E > 1) - retVal = red_kernel_func_names[red_EQ_N]; - } - else if (num_red == 9) // maxloc - { - if (num_E == 1) - { - if (num_IE >= 1) - retVal = red_kernel_func_names[red_MAXL]; - } - else if (num_E > 1) - { - retVal = red_kernel_func_names[red_MAXL]; - err("Reduction variable is array, not implemented yet for GPU", 597, dvm_parallel_dir); - } - - } - else if (num_red == 10) // minloc - { - if (num_E == 1) - { - if (num_IE >= 1) - retVal = red_kernel_func_names[red_MINL]; - } - else if (num_E > 1) - { - retVal = red_kernel_func_names[red_MINL]; - err("Reduction variable is array, not implemented yet for GPU", 597, dvm_parallel_dir); - } - - } - - return retVal; -} - -SgStatement *RedOp_Assign(SgSymbol *i_var, SgSymbol *s_block, SgExpression *ered, SgSymbol *d, int k, SgExpression *ind_list) -{ - SgExpression *le = NULL, *re = NULL, *op1 = NULL, *op2 = NULL, *eind = NULL, *red_ind = NULL; - int num_red; - // _block([ k,] i) = (_block([ k,] i), _block([ k,] i + d)) - // k = LowerBound:UpperBound - if (Rank(s_block) == 1) - { - red_ind = NULL; le = RedVar_Block_Ref(s_block, i_var); - } - else if(ind_list) - { - red_ind = &ind_list->copy(); le = RedArray_Block_Ref(s_block, i_var, red_ind); - } - else - { - red_ind = RedVarIndex(s_block, k); le = RedVar_Block_2D_Ref(s_block, i_var, red_ind); - } - num_red = RedFuncNumber(ered->lhs()); - if (num_red > 8) // MAXLOC => 9,MINLOC =>10 - num_red -= 6; // MAX => 3,MIN =>4 - op1 = &(le->copy()); //RedVar_Block_Ref(s_block,i_var); - - eind = &(*new SgVarRefExp(i_var) + *new SgVarRefExp(d)); - - if(ind_list) - op2 = new SgArrayRefExp(*s_block, *AddListToList(&ind_list->copy(),new SgExprListExp(*eind))); - else - op2 = red_ind ? new SgArrayRefExp(*s_block, *red_ind, *eind) : new SgArrayRefExp(*s_block, *eind); - - switch (num_red) { - case(1) : //sum - re = &(*op1 + *op2); - break; - case(2) : //product - re = &(*op1 * *op2); - break; - case(3) : //max - re = MaxFunction(op1, op2); - break; - case(4) : //min - re = MinFunction(op1, op2); - break; - case(5) : //and - if (options.isOn(C_CUDA)) - re = new SgExpression(BITAND_OP, op1, op2, NULL); - else - re = new SgExpression(AND_OP, op1, op2, NULL); - break; - case(6) : //or - if (options.isOn(C_CUDA)) - re = new SgExpression(BITOR_OP, op1, op2, NULL); - else - re = new SgExpression(OR_OP, op1, op2, NULL); - break; - case(7) : //neqv - if (options.isOn(C_CUDA)) - re = new SgExpression(XOR_OP, op1, op2, NULL); - else - re = new SgExpression(NEQV_OP, op1, op2, NULL); - break; - case(8) : //eqv - if (options.isOn(C_CUDA)) - re = new SgUnaryExp(BIT_COMPLEMENT_OP, *new SgExpression(XOR_OP, op1, op2, NULL)); - else - re = new SgExpression(EQV_OP, op1, op2, NULL); - break; - default: - break; - } - return(AssignStatement(le, re)); -} - -SgStatement * GenRedOpAssignStatement(int num_red, SgExpression *op1, SgExpression *op2, SgExpression *le) -{ - SgExpression *re = NULL; - switch (num_red) { - case(1) : //sum - re = &(*op1 + *op2); - break; - case(2) : //product - re = &(*op1 * *op2); - break; - case(3) : //max - re = MaxFunction(op1, op2); - break; - case(4) : //min - re = MinFunction(op1, op2); - break; - case(5) : //and - re = new SgExpression(AND_OP, op1, op2, NULL); - break; - case(6) : //or - re = new SgExpression(OR_OP, op1, op2, NULL); - break; - case(7) : //neqv - re = new SgExpression(NEQV_OP, op1, op2, NULL); - break; - case(8) : //eqv - re = new SgExpression(EQV_OP, op1, op2, NULL); - break; - default: - break; - } - return(new SgAssignStmt(*le, *re)); -} - -SgStatement *RedOp_If(SgSymbol *i_var, SgSymbol *s_block, SgExpression *ered, SgSymbol *d, int num) -{ - SgExpression *cond = NULL, *le = NULL, *re = NULL; - SgSymbol *sf = NULL; - SgStatement *ass = NULL, *if_st = NULL, *st = NULL; - int num_red, i, ind; - - sf = RedVarFieldSymb(s_block); - re = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgVarRefExp((sf))); - le = RedLocVar_Block_Ref(s_block, i_var, d, new SgVarRefExp((sf))); - - num_red = RedFuncNumber(ered->lhs()); - if (num_red == 9) // MAXLOC => 9 - cond = &operator > (*le, *re); - else if (num_red == 10) // MINLOC =>10 - cond = &operator < (*le, *re); - le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgVarRefExp((sf))); - re = RedLocVar_Block_Ref(s_block, i_var, d, new SgVarRefExp((sf))); - ass = AssignStatement(le, re); - if_st = new SgIfStmt(*cond, *ass); - st = ass; - - for (i = 0; i < num; i++) - { - ind = options.isOn(C_CUDA) ? i : i + 1; - le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); - re = RedLocVar_Block_Ref(s_block, i_var, d, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); - ass = AssignStatement(le, re); - st->insertStmtAfter(*ass, *if_st); - st = ass; - } - - return(if_st); -} - -SgExpression *RedVar_Block_Ref(SgSymbol *sblock, SgSymbol *sind) -{ // _block(i) - //if(sblock->type()->baseType()->variant() != T_DERIVED_TYPE) - - return(new SgArrayRefExp(*sblock, *new SgVarRefExp(sind))); -} - - -SgExpression *RedVar_Block_2D_Ref(SgSymbol *sblock, SgSymbol *sind, SgExpression *redind) -{ // _block(k,i) if reduction variable is array - - SgExpression *eind; - eind = new SgExprListExp(*redind); - eind->setRhs(new SgExprListExp(*new SgVarRefExp(sind))); - - return(new SgArrayRefExp(*sblock, *eind)); -} - -SgExpression *RedArray_Block_Ref(SgSymbol *sblock, SgSymbol *sind, SgExpression *ind_list) -{ // _block(k1,k2,...,i) if reduction variable is array - - SgExpression *eind = AddListToList(ind_list, new SgExprListExp(*new SgVarRefExp(sind))); - return(new SgArrayRefExp(*sblock, *eind)); -} - -SgExpression *RedLocVar_Block_Ref(SgSymbol *sblock, SgSymbol *sind, SgSymbol *d, SgExpression *field) -{ // _block(i+d)% or _block(0)% - SgExpression *se, *rref; - if (!d && !sind) // index = 1 - se = new SgArrayRefExp(*sblock, *new SgValueExp(0)); - else if (!d) - se = new SgArrayRefExp(*sblock, *new SgVarRefExp(sind)); - else - se = new SgArrayRefExp(*sblock, *new SgVarRefExp(sind) + *new SgVarRefExp(d)); - rref = new SgExpression(RECORD_REF); - - NODE_OPERAND0(rref->thellnd) = se->thellnd; - NODE_OPERAND1(rref->thellnd) = field->thellnd; - NODE_TYPE(rref->thellnd) = field->type()->thetype; - return(rref); - //return( new SgRecordRefExp(*new SgArrayRefExp(*sblock, *new SgVarRefExp(sind)),*field)); -} - -SgSymbol *RedVarFieldSymb(SgSymbol *s_block) -{ - return(FirstTypeField(s_block->type()->baseType()->symbol()->type())); - -} - -void Do_Assign_For_Loc_Arrays() -{ - reduction_operation_list *rl; - int i; - SgExpression *eind, *el; - SgStatement *curst, *ass, *dost; - - if (!red_list) return; - ass = NULL; - curst = kernel_st; - for (rl = red_struct_list; rl; rl = rl->next) - { - if (!rl->locvar && rl->redvar_size == 0) - continue; - if (rl->redvar_size > 0) - for (i = 0, el = rl->value_arg; i < rl->redvar_size && el; i++, el = el->rhs()) - { - eind = !options.isOn(C_CUDA) ? &(*new SgValueExp(i) + (*LowerBound(rl->redvar, 0))) : new SgValueExp(i); - eind = Calculate(eind); - //ass = new SgAssignStmt( *new SgArrayRefExp( *rl->redvar,*eind), el->lhs()->copy() ); - ass = AssignStatement(new SgArrayRefExp(*rl->redvar, *eind), &(el->lhs()->copy())); - curst->insertStmtAfter(*ass, *kernel_st); - curst = ass; - } - - if (rl->redvar_size < 0) - { - if (options.isOn(C_CUDA)) - { - //XXX changed reduction scheme to atomic, Kolganov 06.02.2020 - //eind = LinearFormForRedArray(rl->redvar, SubscriptListOfRedArray(rl->redvar), rl); - //ass = AssignStatement(new SgArrayRefExp(*rl->redvar, *eind), new SgArrayRefExp(*rl->red_init, *eind)); - } - else - { - ass = AssignStatement(new SgArrayRefExp(*rl->redvar, *SubscriptListOfRedArray(rl->redvar)), new SgArrayRefExp(*rl->red_init, *SubscriptListOfRedArray(rl->redvar))); - - //XXX move this block to this condition, Kolganov 06.02.2020 - dost = doLoopNestForReductionArray(rl, ass); - curst->insertStmtAfter(*dost, *kernel_st); - curst = dost->lastNodeOfStmt(); - } - } - - if (rl->locvar) - { - for (i = 0, el = rl->formal_arg; i < rl->number && el; i++, el = el->rhs()) - { - if (isSgArrayType(rl->locvar->type())) - { - if (options.isOn(C_CUDA)) // in C Language - eind = new SgValueExp(i); - else // in Fortran Language - eind = Calculate(&(*new SgValueExp(i) + (*LowerBound(rl->locvar, 0)))); - // ass = new SgAssignStmt( *new SgArrayRefExp( *rl->locvar,*eind), el->lhs()->copy() ); - ass = AssignStatement(new SgArrayRefExp(*rl->locvar, *eind), &(el->lhs()->copy())); - } - else - //ass = new SgAssignStmt( *new SgVarRefExp( *rl->locvar), el->lhs()->copy() ); - ass = AssignStatement(new SgVarRefExp(*rl->locvar), &(el->lhs()->copy())); - curst->insertStmtAfter(*ass, *kernel_st); - curst = ass; - } - } - } - if (ass) - kernel_st->lexNext()->addComment(CommentLine("Fill local variable with passed values")); -} - -SgStatement *doLoopNestForReductionArray(reduction_operation_list *rl, SgStatement *ass) -{ - SgStatement *dost; - - int rank, i; - // creating loop nest - // do kkN = 1,dimSizeN - // . . . - // do kk1 = 1,dimSize1 - // - // enddo - // . . . - // enddo - rank = Rank(rl->redvar); - dost = ass; - for (i = 1; i <= rank; i++) - { - if (options.isOn(C_CUDA)) - dost = new SgForStmt(&SgAssignOp(*new SgVarRefExp(IndexLoopVar(i)), *new SgValueExp(0)), - &(*new SgVarRefExp(IndexLoopVar(i)) < *RedVarUpperBound(rl->dimSize_arg, i)), - &SgAssignOp(*new SgVarRefExp(IndexLoopVar(i)), *new SgVarRefExp(IndexLoopVar(i)) + *new SgValueExp(1)), dost); - else - { - SgExpression *e1 = RedVarUpperBound(rl->lowBound_arg, i); - SgExpression *e2 = RedVarUpperBound(rl->dimSize_arg, i); - dost = new SgForStmt(IndexLoopVar(i), e1, &(*e2+*e1-*new SgValueExp(1)), NULL, dost); - } - } - - return(dost); -} - -SgExpression *SubscriptListOfRedArray(SgSymbol *ar) -{ - int rank, j; - SgExpression *list, *el; - rank = Rank(ar); j = 1; - list = el = &kernel_index_var_list->copy(); - while (j != rank) - { - el = el->rhs(); j++; - } - el->setRhs(NULL); - return(list); -} - -SgSymbol *IndexLoopVar(int i) -{ - int j = 1; - SgExpression *ell = kernel_index_var_list; - - while (j != i) - { - ell = ell->rhs(); j++; - } - return(ell->lhs()->symbol()); -} - - -SgExpression *RedVarUpperBound(SgExpression *el, int i) -{ - int j = 1; - SgExpression *ell = el; - - while (j != i) - { - ell = ell->rhs(); j++; - } - return(&ell->lhs()->copy()); -} - - -SgExpression *LocVarIndex(SgSymbol *sl, int i) -{ // i = 1,... - int ind; - SgExpression *ec; - if (!isSgArrayType(sl->type())) - return(new SgValueExp(i)); - ec = Calculate(LowerBound(sl, 0)); - if (!ec->isInteger()) - { - Error("Can not calculate lower bound of array %s", sl->identifier(), 594, dvm_parallel_dir); - return(new SgValueExp(i)); - } - ind = options.isOn(C_CUDA) ? i - 1 : i - 1 + (ec->valueInteger()); - return(new SgValueExp(ind)); - -} - - -SgExpression *RedVarIndex(SgSymbol *sl, int i) -{// i=0,... - SgExpression *ec; - int ind; - ec = Calculate(LowerBound(sl, 0)); - if (!ec->isInteger()) - { - Error("Can not calculate lower bound of array %s", sl->identifier(), 594, dvm_parallel_dir); - return(new SgValueExp(i)); - } - ind = options.isOn(C_CUDA) ? i : i + (ec->valueInteger()); - return(new SgValueExp(ind)); - -} -/* -SgExpression *RedGridIndex(SgSymbol *sl,int i) -{ SgExpression *eind; -if(Rank(sl)==0) -eind = &(*new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1)); -else -eind = new -} -*/ - -SgExpression *LinearFormForRedArray(SgSymbol *ar, SgExpression *el, reduction_operation_list *rsl) -{ - int i, n; - SgExpression *elin, *e; - // el - subscript list (I1,I2,...In), n - rank of reduction array - - // generating - // n - // I1 + SUMMA(DimSize(k-1) * Ik) - // k=2 - - n = Rank(rsl->redvar); - if (!el) // there aren't any subscripts - return(new SgValueExp(0)); - - if (rsl->dimSize_arg == NULL) - return(el); - - elin = ToInt(el->lhs()); - for (e = el->rhs(), i = 1; e; e = e->rhs(), i++) - elin = &(*elin + (*ToInt(e->lhs()) * *coefProd(i, rsl->dimSize_arg))); // + Ik * DimSize(k-1) - - //XXX changed reduction scheme to atomic, Kolganov 19.03.2020 - /*if (rsl->array_red_size <= 0) - elin = &(*elin * *BlockDimsProduct());*/ - return(new SgExprListExp(*elin)); -} - -SgExpression *coefProd(int i, SgExpression *ec) -{ - SgExpression *e, *coef; - int j; - e = &(ec->lhs()->copy()); - for (coef = ec->rhs(), j = 2; coef && j <= i; coef = coef->rhs(), j++) - e = &(*e * coef->lhs()->copy()); - return(e); -} - -SgExpression *BlockDimsProduct() -{ - return &(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z")); -} - -reduction_operation_list *ElementOfReductionStruct(SgSymbol *ar) -{ - reduction_operation_list *rl; - for (rl=red_struct_list; rl; rl=rl->next) - if (!strcmp(rl->redvar->identifier(), ar->identifier())) - return rl; - return red_struct_list; -} - -SgExpression *ElementOfPrivateList(SgSymbol *ar) -{ - SgExpression *el; - for (el=private_list; el; el=el->rhs()) - if (!strcmp(el->lhs()->symbol()->identifier(), ar->identifier())) - return el->lhs(); - return private_list->lhs(); -} - -SgExpression *LowerShiftForArrays (SgSymbol *ar, int i, int type) -{ - SgExpression *e = isConstantBound(ar, i, 1); - if (e) return e; - if (type==0) //private array - { - SgExpression **eatr = (SgExpression **)ElementOfPrivateList(ar)->attributeValue(0, L_BOUNDS); - SgExprListExp *ebounds = (SgExprListExp *)*eatr; - e = new SgVarRefExp(ebounds->elem(i)->lhs()->symbol()); - } - else // reduction array - { - SgExprListExp *el = ((SgExprListExp *) ElementOfReductionStruct(ar)->lowBound_arg); - e = &( el->elem(i)->copy() ); - } - return e; -} - -SgExpression *UpperShiftForArrays (SgSymbol *ar, int i) -{ - SgExpression *e = isConstantBound(ar, i, 0); - if(!e) - e = new SgValueExp(1); - return e; -} - -void CompleteStructuresForReductionInKernel() -{ - reduction_operation_list *rl; - int max_rank = 0; - int r; - s_overall_blocks = NULL; - - for (rl = red_struct_list; rl; rl = rl->next) - { - rl->value_arg = CreateFormalLocationList(rl->redvar, rl->redvar_size); - rl->formal_arg = CreateFormalLocationList(rl->locvar, rl->number); - - if (!s_overall_blocks && rl->redvar_size != 0) - s_overall_blocks = OverallBlocksSymbol(); - if (rl->redvar_size < 0) - { - rl->dimSize_arg = CreateFormalDimSizeList(rl->redvar); - rl->lowBound_arg = CreateFormalLowBoundList(rl->redvar); - //XXX changed reduction scheme to atomic, Kolganov 06.02.2020 - if(options.isOn(C_CUDA) ) - rl->red_init = rl->redvar; - else - rl->red_init = RedInitValSymbolInKernel(rl->redvar, rl->dimSize_arg, rl->lowBound_arg); // after CreateFormalDimSizeList() - } - else - { - rl->dimSize_arg = NULL; - rl->lowBound_arg = NULL; - rl->red_init = NULL; - } - rl->red_grid = RedGridSymbolInKernel(rl->redvar, rl->redvar_size, rl->dimSize_arg, rl->lowBound_arg,1); // after CreateFormalDimSizeList() - rl->loc_grid = rl->locvar ? RedGridSymbolInKernel(rl->locvar, rl->number, NULL, NULL, 0) : NULL; - - r = Rank(rl->redvar); - max_rank = max_rank < r ? r : max_rank; - } - - kernel_index_var_list = CreateIndexVarList(max_rank); -} - -SgExpression *CreateIndexVarList(int N) -{ - int i; - SgExprListExp *list = NULL; - SgExprListExp *el; - if (N == 0) return(NULL); - for (i = N; i; i--) - { - el = new SgExprListExp(*new SgVarRefExp(IndexSymbolForRedVarInKernel(i))); - el->setRhs(list); - list = el; - } - return(list); -} - -SgExpression *CreateFormalLocationList(SgSymbol *locvar, int numb) -{ - SgExprListExp *sl, *sll; - int i; - if (!locvar || numb <= 0) return(NULL); - sl = NULL; - for (i = numb; i; i--) - { - sll = new SgExprListExp(*new SgVarRefExp(FormalLocationSymbol(locvar, i))); - sll->setRhs(sl); - sl = sll; - } - - return(sl); -} - -SgExpression *CreateFormalDimSizeList(SgSymbol *var) -{ - SgExprListExp *sl, *sll; - int i; - sl = NULL; - for (i = Rank(var); i; i--) - { - sll = new SgExprListExp(*new SgVarRefExp(FormalDimSizeSymbol(var, i))); - sll->setRhs(sl); - sl = sll; - } - return(sl); -} - -SgExpression *CreateFormalLowBoundList(SgSymbol *var) -{ - SgExprListExp *sl, *sll; - int i; - sl = NULL; - for (i = Rank(var); i; i--) - { - sll = new SgExprListExp(*new SgVarRefExp(FormalLowBoundSymbol(var, i))); - sll->setRhs(sl); - sl = sll; - } - return(sl); -} - -char *LoopKernelComment() -{ - char *cmnt = new char[100]; - if (options.isOn(C_CUDA)) // in C Language - sprintf(cmnt, "//--------------------- Kernel for loop on line %d ---------------------\n", first_do_par->lineNumber()); - else // in Fortran Language - sprintf(cmnt, "!----------------------- Kernel for loop on line %d -----------------------\n\n", first_do_par->lineNumber()); - return(cmnt); -} - -char *SequenceKernelComment(int lineno) -{ - char *cmnt = new char[150]; - if (options.isOn(C_CUDA)) // in C Language - sprintf(cmnt, "//--------------------- Kernel for sequence of statements on line %d ---------------------\n", lineno); - else // in Fortran Language - sprintf(cmnt, "!----------------------- Kernel for sequence of statements on line %d -----------------------\n\n", lineno); - return(cmnt); -} - -void SymbolChange_InBlock(SgSymbol *snew, SgSymbol *sold, SgStatement *first_st, SgStatement *last_st) -{ - SgStatement *st; - if (!snew || !sold) return; - for (st = first_st; st != last_st; st = st->lexNext()) - { - if (st->symbol() && st->symbol() == sold) - st->setSymbol(*snew); - //printf("----%d\n", st->lineNumber()); - SymbolChange_InExpr(snew, sold, st->expr(0)); - SymbolChange_InExpr(snew, sold, st->expr(1)); - SymbolChange_InExpr(snew, sold, st->expr(2)); - } -} - -void SymbolChange_InExpr(SgSymbol *snew, SgSymbol *sold, SgExpression *e) -{ - if (!e) return; - if (isSgVarRefExp(e) || isSgArrayRefExp(e) || e->variant() == CONST_REF) - { - if (e->symbol() == sold) - e->setSymbol(*snew); - //printf("%s %d %s %d \n",e->symbol()->identifier(),e->symbol()->id(),sold->identifier(),sold->id()); - return; - } - SymbolChange_InExpr(snew, sold, e->lhs()); - SymbolChange_InExpr(snew, sold, e->rhs()); -} - -void SaveLineNumbers(SgStatement *stat_copy) -{ - SgStatement *stmt, *dost, *st; - - dost = DoStmt(first_do_par, ParLoopRank()); - - - for (stmt = stat_copy, st = dost->lexNext(); stmt; stmt = stmt->lexNext(), st = st->lexNext()) - { //printf("----loop %d\n",st->lineNumber()); - BIF_LINE(stmt->thebif) = st->lineNumber(); - } -} -/***************************************************************************************/ -/*ACC*/ -/* Creating C-Cuda Kernel Function */ -/* and Inserting New Statements */ -/***************************************************************************************/ -SgStatement *Create_C_Kernel_Function(SgSymbol *sF) - -// create kernel for loop in C-Cuda language -{ - SgStatement *st_hedr, *st_end; - SgExpression *fe; - - // create fuction header - st_hedr = new SgStatement(FUNC_HEDR); - st_hedr->setSymbol(*sF); - fe = new SgFunctionRefExp(*sF); - fe->setSymbol(*sF); - st_hedr->setExpression(0, *fe); - st_hedr->addDeclSpec(BIT_CUDA_GLOBAL); - - // create end of function - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*sF); - - // inserting - mod_gpu_end->insertStmtBefore(*st_hedr, *mod_gpu); - st_hedr->insertStmtAfter(*st_end, *st_hedr); - - cur_in_mod = st_end; - return(st_hedr); -} - -/***************************************************************************************/ -/*ACC*/ -/* Creating C Program Unit */ -/* and Inserting New Statements */ -/* (C Language, adapter procedure, .cu file) */ -/***************************************************************************************/ -SgType *Cuda_Index_Type() -{ - SgSymbol *st = new SgSymbol(TYPE_NAME, "CudaIndexType", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); - SgType *t_dsc; - if (undefined_Tcuda) - t_dsc = new SgDescriptType(*C_Derived_Type(s_DvmType), BIT_TYPEDEF); //BIT_TYPEDEF | BIT_LONG); - else - t_dsc = new SgDescriptType(*SgTypeInt(), BIT_TYPEDEF); - - st->setType(t_dsc); - s_CudaIndexType = st; - - //SgType *td = new SgType(T_DERIVED_TYPE); - //TYPE_SYMB_DERIVE(td->thetype) = sdim3->thesymb; - //TYPE_SYMB(td->thetype) = sdim3->thesymb; - //define TYPE_LONG_SHORT(NODE) ((NODE)->entry.descriptive.long_short_flag) - //define TYPE_MODE_FLAG(NODE) ((NODE)->entry.descriptive.mod_flag) - //define TYPE_STORAGE_FLAG(NODE) ((NODE)->entry.descriptive.storage_flag) - //define TYPE_ACCESS_FLAG(NODE) ((NODE)->entry.descriptive.access_flag) - - return(t_dsc); -} - -SgType *Dvmh_Type() -{ - SgSymbol *st = new SgSymbol(TYPE_NAME, "DvmType", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); - - SgType *t_dsc = new SgDescriptType(*C_BaseDvmType(), BIT_TYPEDEF | BIT_LONG); - - st->setType(t_dsc); - s_DvmType = st; - - return(t_dsc); -} - -SgType *DvmhLoopRef_Type() -{ // DvmhLoopRef => DvmType in RTS 05.11.16 - SgSymbol *st = new SgSymbol(TYPE_NAME, "DvmType", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); - - SgType *t_dsc = new SgDescriptType(*C_Derived_Type(s_DvmType), BIT_TYPEDEF); - //new SgDescriptType(*C_BaseDvmType(), BIT_TYPEDEF | BIT_LONG); - - st->setType(t_dsc); - s_DvmhLoopRef = st; - - //SgType *td = new SgType(T_DERIVED_TYPE); - //TYPE_SYMB_DERIVE(td->thetype) = sdim3->thesymb; - //TYPE_SYMB(td->thetype) = sdim3->thesymb; - //define TYPE_LONG_SHORT(NODE) ((NODE)->entry.descriptive.long_short_flag) - //define TYPE_MODE_FLAG(NODE) ((NODE)->entry.descriptive.mod_flag) - //define TYPE_STORAGE_FLAG(NODE) ((NODE)->entry.descriptive.storage_flag) - //define TYPE_ACCESS_FLAG(NODE) ((NODE)->entry.descriptive.access_flag) - - return(t_dsc); -} - -SgType *CudaOffsetTypeRef_Type() -{ - SgSymbol *st = new SgSymbol(TYPE_NAME, "CudaOffsetTypeRef", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); - - SgType *t_dsc = new SgDescriptType(*C_Derived_Type(s_DvmType), BIT_TYPEDEF); - - st->setType(t_dsc); - s_CudaOffsetTypeRef = st; - - return(t_dsc); -} - -SgType *C_Derived_Type(SgSymbol *styp) -{ - return(new SgDerivedType(*styp)); -} -SgType * C_VoidType() -{ - return(new SgType(T_VOID)); -} - -SgType * C_LongType() -{ - return(new SgDescriptType(*SgTypeInt(), BIT_LONG)); -} - -SgType * C_LongLongType() -{ - return(new SgDescriptType(*new SgType(T_LONG), BIT_LONG)); -} - -SgType * C_UnsignedLongLongType() -{ - return( new SgDescriptType(*new SgType(T_LONG), BIT_UNSIGNED | BIT_LONG)); //TYPE_LONG_SHORT(type->thetype) = BIT_UNSIGNED & BIT_LONG; -} - -SgType * C_DvmType() -{ - if (!type_DvmType) - type_DvmType = C_Derived_Type(s_DvmType); - return(type_DvmType); - -} - -SgType * C_BaseDvmType() -{ - if (bind_ == 0 && len_DvmType == 8) // size of long == 4 - return(new SgType(T_LONG)); - else - return(SgTypeInt()); -} - -SgType * C_CudaIndexType() -{ - if (!type_CudaIndexType) - type_CudaIndexType = C_Derived_Type(s_CudaIndexType); - return(type_CudaIndexType); - -} -/* -SgSymbol *CudaIndexConst(int iconst) -{ -char name[10]; -if(iconst == rt_INT) -name = "rt_INT"; -else if(iconst == rt_LONG) -name = "rt_LONG"; -else -name = "rt_LLONG"; -return ( new SgVariableSymb(name,SgTypeInt(),block_C) ); -} -*/ - -SgSymbol *CudaIndexConst() -{ - const char *name; - int len; - if (undefined_Tcuda) - len = TypeSize(FortranDvmType()); - else - len = 4; - if (len == 4) - name = "rt_INT"; - else if (len == 8) - name = "rt_LONG"; - else - name = "rt_LLONG"; - - return (new SgVariableSymb(name, SgTypeInt(), block_C)); - -} - -SgType *C_PointerType(SgType *type) -{ - return(new SgPointerType(type)); -} - - -SgType *C_ReferenceType(SgType *type) -{ - return(new SgReferenceType(*type)); -} - -void CreateComplexTypeSymbols(SgStatement *st_bl) -{ - s_cmplx = new SgSymbol(TYPE_NAME, "cmplx2", *st_bl); - s_dcmplx = new SgSymbol(TYPE_NAME, "dcmplx2", *st_bl); -} - -SgType *C_Type(SgType *type) -{ - SgType *tp; - int len; - tp = isSgArrayType(type) ? type->baseType() : type; - len = TypeSize(tp); - switch (tp->variant()) { - - case T_INT: //if(IS_INTRINSIC_TYPE(tp)) - // return(tp); - if (len == 4) - { - if (bind_ == 1) - return(SgTypeInt()); - else //if (bind_==0) - return C_LongType(); - } - else if (len == 8) - { - if (bind_ == 1) - return C_LongType(); - else // if (bind_==0) - return C_LongLongType(); - } - else if (len == 2) - return(new SgDescriptType(*SgTypeInt(), BIT_SHORT)); - else if (len == 1) - return(SgTypeChar()); - break; - - - case T_FLOAT: if (IS_INTRINSIC_TYPE(tp)) - return(tp); - else if (len == 8) - return(SgTypeDouble()); - else if (len == 4) - return(SgTypeFloat()); - break; - - case T_BOOL: - if (len == 8) - { - if (bind_ == 1) - return C_LongType(); - else // if (bind_==0) - return C_LongLongType(); - } - else if (len == 4) - { - if (bind_ == 1) - return(SgTypeInt()); - else //if (bind_==0) - return C_LongType(); - } - else if (len == 2) - return(new SgDescriptType(*SgTypeInt(), BIT_SHORT)); - else if (len == 1) - return(SgTypeChar()); - break; - case T_DOUBLE: return (tp); - case T_COMPLEX: return(C_Derived_Type(s_cmplx)); - case T_DCOMPLEX: return(C_Derived_Type(s_dcmplx)); - case T_DERIVED_TYPE: - if (tp->symbol()->identifier() != std::string("uint4")) // for __dvmh_rand_state - err("Illegal type of used or reduction variable", 499, first_do_par); - return(tp); //return (SgTypeInt()); - case T_CHAR: - case T_STRING: - if (len == 1) - return (SgTypeChar()); - break; - default: - err("Illegal type of used or reduction variable", 499, first_do_par); - return (SgTypeInt()); - } - - err("Illegal type of used or reduction variable", 499, first_do_par); - return (SgTypeInt()); -} - -SgSymbol *AdapterSymbol(SgStatement *st_do) -{ - SgSymbol *s, *sc; - char *aname, *namef; - - aname = (char *)malloc((unsigned)(strlen(st_do->fileName()) + 30)); - if (inparloop) - sprintf(aname, "%s_%s_%d_cuda_", "loop", filename_short(st_do), st_do->lineNumber()); - else - sprintf(aname, "%s_%s_%d_cuda_", "sequence", filename_short(st_do), st_do->lineNumber()); - s = new SgSymbol(FUNCTION_NAME, aname, *C_VoidType(), *block_C); //*current_file->firstStatement()); - - namef = (char *)malloc((unsigned)strlen(aname) + 1); - //strncpy(namef,aname,strlen(aname)-1); - strcpy(namef, aname); - namef[strlen(aname) - 1] = '\0'; - sc = new SgSymbol(PROCEDURE_NAME, namef, *current_file->firstStatement()); - if (cur_region && cur_region->targets & CUDA_DEVICE) - acc_func_list = AddToSymbList(acc_func_list, sc); - - return(s); -} - -void ChangeAdapterName(SgSymbol *s) -//deleting last symbol "_" -{ - char *name; - name = s->identifier(); - name[strlen(name) - 1] = '\0'; -} - -/*--------------------------*/ - -SgSymbol *isSameRedVar(char *name) -{ - reduction_operation_list *rl; - - for (rl = red_struct_list; rl; rl = rl->next) - { - if (rl->redvar && !strcmp(rl->redvar->identifier(), name)) - return(rl->redvar); - if (rl->locvar && !strcmp(rl->locvar->identifier(), name)) - return(rl->locvar); - } - return(NULL); -} - -SgSymbol *isSameRedVar_c(const char *name) -{ - reduction_operation_list *rl; - - for (rl = red_struct_list; rl; rl = rl->next) - { - if (rl->redvar && !strcmp(rl->redvar->identifier(), name)) - return(rl->redvar); - if (rl->locvar && !strcmp(rl->locvar->identifier(), name)) - return(rl->locvar); - } - return(NULL); -} - -SgSymbol *isSameUsedVar(char *name) -{ - SgExpression *el; - SgSymbol *s; - - for (el = uses_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSameUsedVar_c(const char *name) -{ - SgExpression *el; - SgSymbol *s; - - for (el = uses_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSamePrivateVar(char *name) -{ - SgExpression *el; - SgSymbol *s; - - for (el = private_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSamePrivateVar_c(const char *name) -{ - SgExpression *el; - SgSymbol *s; - - for (el = private_list; el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSameIndexVar(char *name) -{ - SgExpression *el; - SgSymbol *s; - if (!dvm_parallel_dir) - return(NULL); - - for (el = dvm_parallel_dir->expr(2); el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSameIndexVar_c(const char *name) -{ - SgExpression *el; - SgSymbol *s; - if (!dvm_parallel_dir) - return(NULL); - - for (el = dvm_parallel_dir->expr(2); el; el = el->rhs()) - { - s = el->lhs()->symbol(); - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSameArray(char *name) -{ - symb_list *sl; - SgSymbol *s; - - for (sl = acc_array_list; sl; sl = sl->next) - { - s = sl->symb; - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSameArray_c(const char *name) -{ - symb_list *sl; - SgSymbol *s; - - for (sl = acc_array_list; sl; sl = sl->next) - { - s = sl->symb; - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -SgSymbol *isSameNameInLoop(char *name) -{ - SgSymbol *s; - s = isSameUsedVar(name); - if (s) return(s); - s = isSameRedVar(name); - if (s) return(s); - s = isSameArray(name); - if (s) return(s); - s = isSamePrivateVar(name); - if (s) return(s); - s = isSameIndexVar(name); - return(s); -} -SgSymbol *isSameNameInLoop_c(const char *name) -{ - SgSymbol *s; - s = isSameUsedVar_c(name); - if (s) return(s); - s = isSameRedVar_c(name); - if (s) return(s); - s = isSameArray_c(name); - if (s) return(s); - s = isSamePrivateVar_c(name); - if (s) return(s); - s = isSameIndexVar_c(name); - return(s); -} - - -char *TestAndCorrectName(char *name) -{ - SgSymbol *s; - - while ((s = isSameNameInLoop(name))) - { - name = (char *)malloc((unsigned)(strlen(name) + 2)); - sprintf(name, "%s_", s->identifier()); - } - return(name); -} - -char *TestAndCorrectName(const char *name) -{ - SgSymbol *s = NULL; - char *ret = new char[strlen(name) + 1]; - strcpy(ret,name); - while ((s = isSameNameInLoop_c(ret))) - { - ret = (char *)malloc((unsigned)(strlen(name) + 2)); - sprintf(ret, "%s_", s->identifier()); - } - return ret; -} - -/*-------------------------------*/ - -char *GpuHeaderName(SgSymbol *s) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 3)); - sprintf(name, "d_%s", s->identifier()); - return(TestAndCorrectName(name)); -} - -SgSymbol *GpuHeaderSymbolInAdapter(SgSymbol *ar, SgStatement *st_hedr) -{ - SgArrayType *typearray = new SgArrayType(*C_DvmType()); - typearray->addRange(*new SgValueExp(Rank(ar) + DELTA)); - return(new SgSymbol(VARIABLE_NAME, GpuHeaderName(ar), *typearray, *st_hedr)); -} - -SgSymbol *GpuBaseSymbolInAdapter(SgSymbol *ar, SgStatement *st_hedr) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 6)); - sprintf(name, "%s_base", ar->identifier()); - name = TestAndCorrectName(name); - return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); -} - -SgSymbol *GpuScalarAdrSymbolInAdapter(SgSymbol *s, SgStatement *st_hedr) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 5)); - sprintf(name, "%s_dev", s->identifier()); - name = TestAndCorrectName(name); - return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); -} - - -SgSymbol *GridSymbolForRedInAdapter(SgSymbol *s, SgStatement *st_hedr) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); - sprintf(name, "%s_grid", s->identifier()); - name = TestAndCorrectName(name); - return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); -} - -SgSymbol *InitValSymbolForRedInAdapter(SgSymbol *s, SgStatement *st_hedr) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); - sprintf(name, "%s_init", s->identifier()); - name = TestAndCorrectName(name); - return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); -} - -SgSymbol *DeviceNumSymbol(SgStatement *st_hedr) -{ - char *name; - name = TestAndCorrectName("device_num"); - return(new SgSymbol(VARIABLE_NAME, name, *C_DvmType(), *st_hedr)); -} - -SgSymbol *doDeviceNumVar(SgStatement *st_hedr, SgStatement *st_exec, SgSymbol *s_dev_num, SgSymbol *s_loop_ref) -{ - SgStatement *ass; - SgExpression *le; - if (s_dev_num) return(s_dev_num); - - s_dev_num = DeviceNumSymbol(st_hedr); - - st_exec->insertStmtBefore(*makeSymbolDeclaration(s_dev_num), *st_hedr); - le = new SgVarRefExp(s_dev_num); - ass = AssignStatement(le, GetDeviceNum(s_loop_ref)); - st_exec->insertStmtBefore(*ass, *st_hedr); - ass->addComment("// Get device number"); - - return(s_dev_num); -} - -char * DimSizeName(SgSymbol *s, int i) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(s->identifier()) + 10)); - sprintf(name, "dim%d_%s", i, s->identifier()); - name = TestAndCorrectName(name); - return(name); -} - -void Create_C_extern_block() -{ - SgStatement *fileHeaderSt; - SgStatement *st_mod, *st_end; - - fileHeaderSt = current_file->firstStatement(); - if (block_C) - return; - //mod_gpu_symb = GPUModuleSymb(fileHeaderSt); - - if (options.isOn(C_CUDA)) - { - st_mod = new SgStatement(MODULE_STMT); - st_end = new SgStatement(CONTROL_END); - fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); - st_mod->insertStmtAfter(*st_end, *st_mod); - block_C_Cuda = st_mod; - //Typedef_Stmts(st_end); //10.12.13 - TypeSymbols(st_end); - if(INTERFACE_RTS2) - st_mod->addComment(IncludeComment("")); - st_mod->addComment(IncludeComment("\n#define dcmplx2 Complex\n#define cmplx2 Complex")); - st_mod->addComment(CudaIndexTypeComment()); - } - - st_mod = new SgStatement(MODULE_STMT); - //st_mod->setSymbol(*mod_gpu_symb); - st_end = new SgStatement(CONTROL_END); - //st_end->setSymbol(*mod_gpu_symb); - fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); - st_mod->insertStmtAfter(*st_end, *st_mod); - - block_C = st_mod; - cur_in_block = st_mod; - end_block = st_end; - if (!options.isOn(C_CUDA)) // for Fortran-Cuda - { //Typedef_Stmts(end_block); //10.12.13 - TypeSymbols(end_block); - block_C->addComment(IncludeComment("")); - if(INTERFACE_RTS2) - block_C->addComment(IncludeComment("")); - block_C->addComment(CudaIndexTypeComment()); - } - block_C->addComment("#ifdef _MS_F_\n"); - - //Prototypes(); //10.12.13 - //cur_in_block = Create_Init_Cuda_Function(); - //cur_in_block = cur_in_block->lexNext(); - - cur_in_block = Create_Empty_Stat(); // empty line - - CreateComplexTypeSymbols(options.isOn(C_CUDA) ? block_C_Cuda : block_C); - - return; -} - -void Create_info_block() -{ - SgStatement *fileHeaderSt; - SgStatement *st_mod, *st_end; - - fileHeaderSt = current_file->firstStatement(); - if (info_block) - return; - - st_mod = new SgStatement(MODULE_STMT); - st_end = new SgStatement(CONTROL_END); - fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); - st_mod->insertStmtAfter(*st_end, *st_mod); - info_block = st_mod; - end_info_block = st_end; - //info_block->insertStmtAfter(*(s_DvmType->makeVarDeclStmt()),*info_block); //10.12.13 - info_block->addComment(IncludeComment("")); - return; -} - -void TypeSymbols(SgStatement *end_bl) -{ - Dvmh_Type(); - Cuda_Index_Type(); - DvmhLoopRef_Type(); - CudaOffsetTypeRef_Type(); - s_cudaStream = new SgSymbol(TYPE_NAME, "cudaStream_t", *end_bl); -} - -void Typedef_Stmts(SgStatement *end_bl) -{ - - Dvmh_Type(); - Cuda_Index_Type(); - DvmhLoopRef_Type(); - CudaOffsetTypeRef_Type(); - - /* 10.12.13 - st = s_DvmType->makeVarDeclStmt(); - end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); - st = s_CudaIndexType->makeVarDeclStmt(); - end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); - st = s_DvmhLoopRef->makeVarDeclStmt(); - end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); - st = s_CudaOffsetTypeRef->makeVarDeclStmt(); - end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); - */ -} - -void Prototypes() -{ - SgSymbol *sf, *sarg; - SgStatement *st; - SgExpression *fref, *ae, *el, *arg_list, *devref, *dvmdesc, *dvmHdesc, *hloop, *rednum, *redNumRef, *base, *outThreads, *outStream; - SgType *typ, *typ1; - SgArrayType *typearray; - SgValueExp M0(0); - // generating prototypes: - - // - //void *dvmh_get_natural_base_(DvmType *deviceRef, DvmType dvmDesc[]); - - sf = fdvm[GET_BASE]; - sf->setType(*C_PointerType(C_VoidType())); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - fref->setType(*C_PointerType(C_VoidType())); - //fref = new SgPointerDerefExp(*fref); - st = new SgStatement(VAR_DECL); - //st=sf->makeVarDeclStmt(); - st->setExpression(0, *new SgExprListExp(*new SgPointerDerefExp(*fref))); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list-----*/ - sarg = new SgSymbol(VARIABLE_NAME, "deviceRef", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - devref = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*devref); - - typearray = new SgArrayType(*C_DvmType()); - typearray->addRange(M0); // addDimension(NULL); - sarg = new SgSymbol(VARIABLE_NAME, "dvmDesc", *typearray, *block_C); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - dvmdesc = ae; - arg_list->setRhs(*new SgExprListExp(*ae)); - - fref->setLhs(arg_list); - - // - //void *dvmh_get_device_adr_(DvmType *deviceRef, void *variable); - - sf = fdvm[GET_DEVICE_ADDR]; - sf->setType(*C_PointerType(C_VoidType())); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - fref->setType(*C_PointerType(C_VoidType())); - //fref = new SgPointerDerefExp(*fref); - st = new SgStatement(VAR_DECL); - //st=sf->makeVarDeclStmt(); - st->setExpression(0, *new SgExprListExp(*new SgPointerDerefExp(*fref))); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list-----*/ - sarg = new SgSymbol(VARIABLE_NAME, "deviceRef", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - devref = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*devref); - - sarg = new SgSymbol(VARIABLE_NAME, "variable", *C_VoidType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_VoidType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - - fref->setLhs(arg_list); - - // - // void dvmh_fill_header_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[]); - - sf = fdvm[FILL_HEADER]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = sf->makeVarDeclStmt(); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(devref->copy()); - fref->setLhs(arg_list); - - sarg = new SgSymbol(VARIABLE_NAME, "base", *C_VoidType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_VoidType())); - ae = base = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); - arg_list = arg_list->rhs(); - - typearray = new SgArrayType(*C_DvmType()); - typearray->addRange(M0); - sarg = new SgSymbol(VARIABLE_NAME, "dvmhDesc", *typearray, *block_C); - ae = dvmHdesc = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - // void dvmh_fill_header_ex_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[], DvmType *outTypeOfTransformation, DvmType extendedParams[]); - - sf = fdvm[FILL_HEADER_EX]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = sf->makeVarDeclStmt(); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(devref->copy()); - fref->setLhs(arg_list); - - sarg = new SgSymbol(VARIABLE_NAME, "base", *C_VoidType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_VoidType())); - ae = base = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); - arg_list = arg_list->rhs(); - arg_list->setRhs(*new SgExprListExp(dvmHdesc->copy())); - arg_list = arg_list->rhs(); - - sarg = new SgSymbol(VARIABLE_NAME, "outTypeOfTransformation", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "extendedParams", *dvmHdesc->symbol()->type(), *block_C); - ae = &(dvmHdesc->copy()); - ae->setSymbol(*sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - // void *dvmh_apply_offset(DvmType dvmDesc[], void *base, DvmType dvmhDesc[]); - - // sf = fdvm[APPLY_OFFSET]; - // sf->setType(*C_PointerType(C_VoidType())); - // fref = new SgFunctionRefExp(*sf); - // fref->setSymbol(*sf); - // fref->setType(*C_PointerType(C_VoidType())); - // st = new SgStatement(VAR_DECL); - // st->setExpression(0,*new SgExprListExp(*new SgPointerDerefExp(*fref))); - - // end_block-> insertStmtBefore(*st,*block_C); - - /* ----argument list----- */ - // arg_list = new SgExprListExp(dvmdesc->copy()); - // fref->setLhs(arg_list); - // arg_list->setRhs(*new SgExprListExp(base->copy())); - // arg_list = arg_list->rhs(); - // arg_list->setRhs(*new SgExprListExp(dvmHdesc->copy())); - - // - // DvmType loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, IndexType **InOutBlocks); - - sf = fdvm[DO_CUDA]; - sf->setType(*C_DvmType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - sarg = new SgSymbol(VARIABLE_NAME, "InDvmhLoop", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - hloop = ae; - arg_list = new SgExprListExp(*ae); - fref->setLhs(arg_list); - - - typ = C_PointerType(t_dim3); - sarg = new SgSymbol(VARIABLE_NAME, "OutBlocks", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - sarg = new SgSymbol(VARIABLE_NAME, "OutThreads", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - outThreads = new SgPointerDerefExp(*ae); - - s_cudaStream = new SgSymbol(TYPE_NAME, "cudaStream_t", *block_C); - typ = C_PointerType(C_Derived_Type(s_cudaStream)); - sarg = new SgSymbol(VARIABLE_NAME, "OutStream", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - outStream = new SgPointerDerefExp(*ae); - - typ1 = C_PointerType(C_Derived_Type(s_CudaIndexType)); - typ = C_PointerType(typ1); - sarg = new SgSymbol(VARIABLE_NAME, "InOutBlocks", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - ae->setType(typ1); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - // - //void loop_cuda_register_red(DvmhLoopRef *InDvmhLoop, DvmType InRedNum, void **ArrayPtr, void **LocPtr); - sf = fdvm[RED_CUDA]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - sarg = new SgSymbol(VARIABLE_NAME, "InRedNum", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - rednum = ae; - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - typ1 = C_PointerType(C_VoidType()); - typ = C_PointerType(typ1); - sarg = new SgSymbol(VARIABLE_NAME, "ArrayPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - ae->setType(typ1); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - sarg = new SgSymbol(VARIABLE_NAME, "LocPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - ae->setType(typ1); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - // void loop_cuda_register_red_(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef, void *InDeviceArrayBaseAddr, void *InDeviceLocBaseAddr,CudaOffsetTypeRef *ArrayOffsetPtr, CudaOffsetTypeRef *LocOffsetPtr); - sf = fdvm[REGISTER_RED]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - sarg = new SgSymbol(VARIABLE_NAME, "InRedNumRef", *C_PointerType(C_DvmType()), *block_C); - ae = new SgVarRefExp(sarg); - ae = new SgPointerDerefExp(*ae); - redNumRef = ae; - arg_list->setRhs(*new SgExprListExp(*ae)); - - arg_list = arg_list->rhs(); - - typ = C_PointerType(C_VoidType()); - sarg = new SgSymbol(VARIABLE_NAME, "InDeviceArrayBaseAddr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - sarg = new SgSymbol(VARIABLE_NAME, "InDeviceLocBaseAddr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - typ = C_PointerType(C_Derived_Type(s_CudaOffsetTypeRef)); - sarg = new SgSymbol(VARIABLE_NAME, "ArrayOffsetPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - sarg = new SgSymbol(VARIABLE_NAME, "LocOffsetPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - // void loop_red_init(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef, void *arrayPtr, void *locPtr); - sf = fdvm[RED_INIT_C]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - //sarg=new SgSymbol(VARIABLE_NAME,"InRedNumRef",*C_PointerType(C_DvmType()),*block_C); - //ae = new SgVarRefExp(sarg); - //ae = new SgPointerDerefExp(*ae); - //arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list->setRhs(*new SgExprListExp(redNumRef->copy())); - arg_list = arg_list->rhs(); - - typ = C_PointerType(C_VoidType()); - sarg = new SgSymbol(VARIABLE_NAME, "arrayPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - sarg = new SgSymbol(VARIABLE_NAME, "locPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - // void loop_cuda_red_init(DvmhLoopRef *InDvmhLoop, Dvmtype InRedNum, void *arrayPtr, void *locPtr, void **devArrayPtr, void **devLocPtr); - arg_list = fref->lhs(); // argument list of loop_red_init() - sf = fdvm[CUDA_RED_INIT]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - - fref->setLhs(arg_list->copy()); // copying argument list of loop_red_init() function - arg_list = fref->lhs(); - //renewing second argument: Dvmtype *InRedNumRef => Dvmtype InRedNum - sarg = new SgSymbol(VARIABLE_NAME, "InRedNum", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - arg_list->rhs()->setLhs(*ae); - while (arg_list->rhs() != 0) - arg_list = arg_list->rhs(); - typ1 = C_PointerType(C_VoidType()); - typ = C_PointerType(typ1); - sarg = new SgSymbol(VARIABLE_NAME, "devArrayPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - ae->setType(typ1); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "devLocPtr", *typ, *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - ae->setType(typ1); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - // - // void loop_cuda_red_prepare_((DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef, DvmType *InCountRef, DvmType *InFillFlagRef); - sf = fdvm[RED_PREPARE]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - arg_list->setRhs(*new SgExprListExp(redNumRef->copy())); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "InCountRef", *C_PointerType(C_DvmType()), *block_C); - ae = new SgVarRefExp(sarg); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "InFillFlagRef", *C_PointerType(C_DvmType()), *block_C); - ae = new SgVarRefExp(sarg); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - // void loop_red_finish_(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef); - sf = fdvm[RED_FINISH]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - arg_list->setRhs(*new SgExprListExp(redNumRef->copy())); - - - // - // void loop_cuda_shared_needed(DvmhLoopRef *InDvmhLoop, DvmType *count); - // sf = fdvm[SHARED_NEEDED]; - // sf->setType(*C_VoidType()); - // fref = new SgFunctionRefExp(*sf); - // fref->setSymbol(*sf); - // st = new SgStatement(VAR_DECL); - // st->setExpression(0,*new SgExprListExp(*fref)); - - // end_block-> insertStmtBefore(*st,*block_C); - - /* ----argument list----- */ - // arg_list = new SgExprListExp(hloop->copy()); - // fref->setLhs(arg_list); - - // sarg=new SgSymbol(VARIABLE_NAME,"countRef",*C_PointerType(C_DvmType()),*block_C); - // ae = new SgVarRefExp(sarg); - // ae = new SgPointerDerefExp(*ae); - // arg_list->setRhs(*new SgExprListExp(*ae)); - // arg_list = arg_list->rhs(); - - // CudaIndexType *loop_cuda_get_local_part(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]); - - sf = fdvm[GET_LOCAL_PART]; - typ = C_PointerType(C_Derived_Type(s_CudaIndexType)); - sf->setType(*typ); //*C_PointerType(C_Derived_Type(s_CudaIndexType))); - - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - fref->setType(*typ); - - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*new SgPointerDerefExp(*fref))); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); - arg_list = arg_list->rhs(); - - //DvmType loop_get_device_num_(DvmhLoopRef *InDvmhLoop) - sf = fdvm[GET_DEVICE_NUM]; - sf->setType(*C_DvmType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - //DvmType loop_cuda_get_red_step_(DvmhLoopRef *InDvmhLoop) - sf = fdvm[GET_OVERALL_STEP]; - sf->setType(*C_DvmType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - // - //DvmType loop_get_dependency_mask_(DvmhLoopRef *InDvmhLoop) - sf = fdvm[GET_DEP_MASK]; - sf->setType(*C_DvmType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - - // - //void dvmh_cuda_replicate_(void *addr, DvmType *recordSize, DvmType *quantity, void *devPtr) - sf = fdvm[CUDA_REPLICATE]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - sarg = new SgSymbol(VARIABLE_NAME, "addr", *C_VoidType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_VoidType())); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fref->setLhs(arg_list); - sarg = new SgSymbol(VARIABLE_NAME, "recordSize", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "quantity", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "devPtr", *C_VoidType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_VoidType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - // - //DvmType DvmType loop_cuda_transform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[], DvmhLoopRef *backFlagRef, DvmType dvmhDesc[], DvmType addressingParams[]); - // sf = fdvm[CUDA_TRANSFORM]; - // sf->setType(*C_DvmType()); - // fref = new SgFunctionRefExp(*sf); - // fref->setSymbol(*sf); - // st = new SgStatement(VAR_DECL); - // st->setExpression(0,*new SgExprListExp(*fref)); - - // end_block-> insertStmtBefore(*st,*block_C); - - /* ----argument list----- */ - // arg_list = new SgExprListExp(hloop->copy()); - // fref->setLhs(arg_list); - // arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); - // arg_list = arg_list->rhs(); - // typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - // sarg=new SgSymbol(VARIABLE_NAME,"backFlagRef",*typ,*block_C); - // ae = new SgVarRefExp(sarg); - // ae->setType(typ); - // ae = new SgPointerDerefExp(*ae); - // arg_list->setRhs( *new SgExprListExp(*ae)); - // arg_list = arg_list->rhs(); - // arg_list->setRhs(*new SgExprListExp(dvmHdesc->copy())); - // arg_list = arg_list->rhs(); - // sarg=new SgSymbol(VARIABLE_NAME,"addressingParams",*dvmHdesc->symbol()->type(),*block_C); - // ae = &(dvmHdesc->copy()); - // ae->setSymbol(*sarg); - // arg_list->setRhs(*new SgExprListExp(*ae)); - - // - //DvmType DvmType loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]); - sf = fdvm[CUDA_AUTOTRANSFORM]; - sf->setType(*C_DvmType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); - arg_list = arg_list->rhs(); - - // - //void loop_cuda_get_config_(DvmhLoopRef *InDvmhLoop, DvmType *InSharedPerThread, DvmType *InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream, DvmType *OutSharedPerBlock); - sf = fdvm[GET_CONFIG]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - sarg = new SgSymbol(VARIABLE_NAME, "InSharedPerThread", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "InRegsPerThread", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - arg_list->setRhs(*new SgExprListExp(outThreads->copy())); - arg_list = arg_list->rhs(); - arg_list->setRhs(*new SgExprListExp(outStream->copy())); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "OutSharedPerBlock", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - - // - //void loop_fill_bounds_(DvmhLoopRef *InDvmhLoop, DvmType idxL[], DvmType idxH[], DvmType steps[]); - if (options.isOn(NO_BL_INFO)) - { - sf = fdvm[FILL_BOUNDS_C]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - arg_list = new SgExprListExp(hloop->copy()); - fref->setLhs(arg_list); - typearray = new SgArrayType(*C_DvmType()); - typearray->addRange(M0); - sarg = new SgSymbol(VARIABLE_NAME, "idxL", *typearray, *block_C); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "idxH", *typearray, *block_C); - ae = &(ae->copy()); - ae->setSymbol(sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "steps", *typearray, *block_C); - ae = &(ae->copy()); - ae->setSymbol(sarg); - arg_list->setRhs(*new SgExprListExp(*ae)); - } - - // - //void dvmh_change_filled_bounds(DvmType *low, DvmType *high, DvmType *idx, DvmType n, DvmType dep, DvmType type_of_run, DvmType *idxs); - sf = fdvm[CHANGE_BOUNDS]; - sf->setType(*C_VoidType()); - fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - end_block->insertStmtBefore(*st, *block_C); - - /* ----argument list----- */ - sarg = new SgSymbol(VARIABLE_NAME, "low", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fref->setLhs(arg_list); - sarg = new SgSymbol(VARIABLE_NAME, "high", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "idx", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "n", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_DvmType()); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "dep", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_DvmType()); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "type_of_run", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_DvmType()); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - sarg = new SgSymbol(VARIABLE_NAME, "idxs", *C_DvmType(), *block_C); - ae = new SgVarRefExp(sarg); - ae->setType(C_PointerType(C_DvmType())); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - -} - -SgStatement *Create_Empty_Stat() -{ - SgStatement *st; - - st = new SgStatement(COMMENT_STAT); - end_block->insertStmtBefore(*st, *block_C); - - return(st); -} - - - -SgStatement *Create_Init_Cuda_Function() -{ - SgStatement *st, *st_end; - SgSymbol *sf; - SgExpression *e; - st = new SgStatement(FUNC_HEDR); - sf = new SgSymbol(FUNCTION_NAME, "init_cuda_", *C_VoidType(), *block_C); - st->setSymbol(*sf); - e = new SgFunctionRefExp(*sf); - e->setSymbol(*sf); - st->setExpression(0, *e); - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*sf); - - end_block->insertStmtBefore(*st, *block_C); - st->insertStmtAfter(*st_end, *st); - return(st); -} - -SgStatement *Create_C_Function(SgSymbol *sF) -{ - SgStatement *st_hedr, *st_end; - SgExpression *fe; - - // create fuction header - st_hedr = new SgStatement(FUNC_HEDR); - st_hedr->setSymbol(*sF); - fe = new SgFunctionRefExp(*sF); - fe->setSymbol(*sF); - st_hedr->setExpression(0, *fe); - - // create end of function - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*sF); - - // inserting - end_block->insertStmtBefore(*st_hedr, *block_C); - st_hedr->insertStmtAfter(*st_end, *st_hedr); - - return(st_hedr); -} - -// TODO: __indexTypeInt and __indexTypeLLong -SgStatement *Create_C_Adapter_Function(SgSymbol *sadapter, int InternalPosition) -{ - // !!ATTENTION!! gpuO1 lvl2 disabled - return(NULL); -} - -SgStatement *Create_C_Adapter_Function(SgSymbol *sadapter) -{ - symb_list *sl; - SgStatement *st_hedr, *st_end, *stmt, *do_while, *first_exec, *st_base = NULL, *st_call, *cur; - SgExpression *fe, *ae, *arg_list, *el, *e, *er; - SgExpression *espec, *e_all_private_size = NULL; - SgFunctionCallExp *fcall; - //SgStatement *fileHeaderSt; - SgSymbol *s_loop_ref, *sarg, *s, *sb, *sg, *sdev, *h_first, *hgpu_first, *base_first, *red_first, *uses_first, *scalar_first, *private_first; - SgSymbol *s_stream = NULL, *s_blocks = NULL, *s_threads = NULL, *s_blocks_info = NULL, *s_red_count = NULL, *s_tmp_var = NULL; - SgSymbol *s_dev_num = NULL, *s_shared_mem = NULL, *s_regs = NULL, *s_blocksS = NULL, *s_idxL = NULL, *s_idxH = NULL, *s_step = NULL, *s_idxTypeInKernel = NULL; - SgSymbol *s_num_of_red_blocks = NULL, *s_fill_flag = NULL, *s_red_num = NULL, *s_restBlocks = NULL, *s_addBlocks = NULL, *s_overallBlocks = NULL; - SgSymbol *s_max_blocks; - SgType *typ = NULL; - int ln, num, i, uses_num, shared_mem_count, has_red_array, use_device_num, nbuf, lnp; - char *define_name; - int pl_rank = ParLoopRank(); - h_first = hgpu_first = base_first = red_first = uses_first = scalar_first = NULL; - has_red_array = 0; use_device_num = 0; nbuf = 0; - s_dev_num = NULL; - s_shared_mem = NULL; - - // create function header - st_hedr = Create_C_Function(sadapter); - st_end = st_hedr->lexNext(); - fe = st_hedr->expr(0); - st_hedr->addComment(Cuda_LoopHandlerComment()); - first_exec = st_end; - - // create dummy argument list: - // loop_ref,,,, - - typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); - - ae = new SgVarRefExp(s_loop_ref); //loop_ref - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fe->setLhs(arg_list); - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) // headers - { //printf("%s\n",sl->symb->identifier()); - SgArrayType *typearray = new SgArrayType(*C_DvmType()); //(*C_LongType()); - typearray->addDimension(NULL); - sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - nbuf++; - } - for (el = uses_list, ln = 0; el; el = el->rhs(), ln++) // uses - { - s = el->lhs()->symbol(); - typ = C_PointerType(C_Type(s->type())); - sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); - - if (isByValue(s)) - SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; - ae = UsedValueRef(s, sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - uses_first = sarg; - } - uses_num = ln; - - if (red_list) // reduction array shapes - { - reduction_operation_list *rsl; //create dimmesion size list for reduction arrays - int idim; - SgExpression *ell; - SgType *t; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (rsl->redvar_size == -1) //reduction variable is array with passed dimension's sizes - { - el = NULL; - t = C_PointerType(C_DvmType()); - for (idim = Rank(rsl->redvar); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, BoundName(rsl->redvar, idim, 1), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - rsl->lowBound_arg = el; - el = NULL; - for (idim = Rank(rsl->redvar); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, DimSizeName(rsl->redvar, idim), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - rsl->dimSize_arg = el; - /*arg_list->setRhs(el->copy());*/ - arg_list = AddListToList(arg_list,&rsl->dimSize_arg->copy()); - arg_list = AddListToList(arg_list,&rsl->lowBound_arg->copy()); - - while (arg_list->rhs() != 0) - arg_list = arg_list->rhs(); - } - } - } - - if (options.isOn(C_CUDA)) // private array shapes - { - int idim; - SgExpression *elp; - SgType *t = C_PointerType(C_DvmType()); - - for (elp=private_list; elp; elp = elp->rhs()) - { - s = elp->lhs()->symbol(); - if (IS_ARRAY(s) && !TestArrayShape(s)) - { - el = NULL; - for (idim = Rank(s); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, DimSizeName(s, idim), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - SgExpression **edim = new (SgExpression *); - *edim = el; - elp->lhs()->addAttribute(DIM_SIZES, (void *)edim, sizeof(SgExpression *) ); - arg_list = AddListToList(arg_list, &el->copy()); - - el = NULL; - for (idim = Rank(s); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, BoundName(s, idim, 1), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - SgExpression **elb = new (SgExpression *); - *elb = el; - elp->lhs()->addAttribute(L_BOUNDS, (void *)elb, sizeof(SgExpression *) ); - arg_list = AddListToList(arg_list, &el->copy()); - - while (arg_list->rhs() != 0) - arg_list = arg_list->rhs(); - } - - } - } - // create variable's declarations: ,,,,blocks_info [ or blocksS,idxL,idxH ],stream,blocks,threads - if (red_list) - { - reduction_operation_list *rsl; - s_shared_mem = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("shared_mem"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - if(!options.isOn(C_CUDA)) - { - s_red_count = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("red_count"), *SgTypeInt(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - s_red_num = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("red_num"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - if (options.isOn(NO_BL_INFO)) // without blocks_info, by option -noBI - { - s_num_of_red_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_of_red_blocks"), *C_DvmType(), *st_hedr); - addDeclExpList(s, stmt->expr(0)); - s_fill_flag = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("fill_flag"), *C_DvmType(), *st_hedr); - addDeclExpList(s, stmt->expr(0)); - } - - //looking through the reduction_op_list - for (er = red_list, rsl = red_struct_list, ln = 0; er; er = er->rhs(), rsl = rsl->next, ln++) - { - SgExpression *ered = NULL, *ev = NULL, *en = NULL, *loc_var_ref = NULL; - SgSymbol *sred = NULL, *sgrid = NULL, *s_loc_var = NULL, *sgrid_loc = NULL, *sinit = NULL; - int is_array; - SgType *loc_type = NULL, *btype = NULL; - - loc_var_ref = NULL; s_loc_var = NULL; is_array = 0; - ered = er->lhs(); // reduction (variant==ARRAY_OP) - //nop =RedFuncNumber(ered->lhs()); - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - if (isSgExprListExp(ev)) - { - ev = ev->lhs(); // reduction variable reference - loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference - en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array - loc_el_num = LocElemNumber(en); - loc_type = loc_var_ref->symbol()->type(); - } - else if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array - is_array = 1; - - s = sred = new SgSymbol(VARIABLE_NAME, ev->symbol()->identifier(), st_hedr); - if (rsl->redvar_size > 0) - { - SgArrayType *typearray = new SgArrayType(*C_Type(ev->symbol()->type())); - typearray->addRange(*ArrayLengthInElems(ev->symbol(), NULL, 0)); - s->setType(*typearray); - - } - else if (rsl->redvar_size < 0) - s->setType(C_PointerType(C_Type(ev->symbol()->type()))); - else - s->setType(C_Type(ev->symbol()->type())); - //stmt = (rsl->redvar_size < 0) ? makeSymbolDeclarationWithInit(s, MallocExpr(s, rsl->dimSize_arg)) : makeSymbolDeclaration(s); - if (rsl->redvar_size >= 0) - { - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - if (!ln) - red_first = s; - s = sgrid = GridSymbolForRedInAdapter(s, st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - if (rsl->redvar_size < 0) - { - s = sinit = InitValSymbolForRedInAdapter(sred, st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - s_loc_var = sgrid_loc = NULL; - if (loc_var_ref) - { - s = s_loc_var = &(loc_var_ref->symbol()->copy()); - if (isSgArrayType(loc_type)) - btype = loc_type->baseType(); - else - btype = loc_type; - - SgArrayType *typearray = new SgArrayType(*C_Type(btype)); - typearray->addRange(*new SgValueExp(loc_el_num)); - s_loc_var->setType(*typearray); - SYMB_SCOPE(s->thesymb) = st_hedr->thebif; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s = sgrid_loc = GridSymbolForRedInAdapter(s, st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - /*--- executable statements: register reductions in RTS ---*/ - e = &SgAssignOp(*new SgVarRefExp(s_red_num), *new SgValueExp(ln + 1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (!ln) - { - stmt->addComment("// Register reduction for CUDA-execution"); - first_exec = stmt; - } - - //XXX swap pointers, changed reduction scheme to atomic, Kolganov 06.02.2020 - if (rsl->redvar_size < 0) - std::swap(sgrid, sinit); - - stmt = new SgCExpStmt(*RegisterReduction(s_loop_ref, s_red_num, sgrid, sgrid_loc)); - st_end->insertStmtBefore(*stmt, *st_hedr); //!printf("__1131 %d\n",s_loc_var); - e = (rsl->redvar_size >= 0) ? InitReduction(s_loop_ref, s_red_num, sred, s_loc_var) : - CudaInitReduction(s_loop_ref, s_red_num, sinit, NULL); //sred, s_loc_var, - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - } - } - if (!options.isOn(NO_BL_INFO)) - { - s_blocks_info = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("blocks_info"), *C_PointerType(C_VoidType()), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - { - s_blocksS = s = ArraySymbol(TestAndCorrectName("blocksS"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - s_restBlocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("restBlocks"), *C_Derived_Type(s_cudaStream), *st_hedr); - addDeclExpList(s, stmt->expr(0)); - s_max_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("maxBlocks"), *C_DvmType(), *st_hedr); - addDeclExpList(s, stmt->expr(0)); - s_addBlocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("addBlocks"), *C_Derived_Type(s_cudaStream), *st_hedr); - addDeclExpList(s, stmt->expr(0)); - s_overallBlocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("overallBlocks"), *C_Derived_Type(s_cudaStream), *st_hedr); - addDeclExpList(s, stmt->expr(0)); - s_idxL = s = ArraySymbol(TestAndCorrectName("idxL"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - s_idxH = s = ArraySymbol(TestAndCorrectName("idxH"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); - addDeclExpList(s, stmt->expr(0)); - s_step = s = ArraySymbol(TestAndCorrectName("loopSteps"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); - addDeclExpList(s, stmt->expr(0)); - - } - s_stream = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("stream"), *C_Derived_Type(s_cudaStream), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("blocks"), *t_dim3, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_threads = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("threads"), *t_dim3, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - s_idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device - if (!scalar_first) - { - scalar_first = sdev; - stmt = makeSymbolDeclaration(sdev); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(sdev, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { - s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - hgpu_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { - s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - base_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - num = ln; - - // create execution part - - - /* -------- call dvmh_get_device_addr(long *deviceRef, void *variable) ----*/ - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Get device addresses"); - sdev = sdev->next(); - } - - - /* -------- call dvmh_get_natural_base(long *deviceRef, long dvmDesc[] ) ----*/ - - for (sl = acc_array_list, s = h_first, sb = base_first, ln = 0; ln < num; sl = sl->next, s = s->next(), sb = sb->next(), ln++) - { - s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); - stmt = cur = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - { - e = LoopGetRemoteBuf(s_loop_ref, nbuf--, s); - stmt = new SgCExpStmt(*e); - cur->insertStmtBefore(*stmt, *st_hedr); - } - if (!ln) - { - stmt->addComment("// Get 'natural' bases"); - st_base = stmt; // save for inserting loop_cuda_autotransform_() before - } - } - - /* -------- call loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[] ) ----*/ - - if (options.isOn(AUTO_TFM)) // for option -noTfm calls are not generated - { - for (s = h_first, ln = 0; ln < num; s = s->next(), ln++) - { - e = CudaAutoTransform(s_loop_ref, s); - stmt = new SgCExpStmt(*e); - st_base->insertStmtBefore(*stmt, *st_hedr); // insert before getting bases for arrays - if (!ln) - stmt->addComment("// Autotransform arrays"); - } - } - /* -------- call dvmh_fill_header_(long *deviceRef, void *base, long dvmDesc[], long dvmhDesc[]);----*/ - - for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) - { - e = FillHeader(s_dev_num, sb, s, sg); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Fill 'device' headers"); - } - - if (options.isOn(RTC)) - { - /* -------- call loop_cuda_rtc_set_lang_(loop_ref, lang); ------------*/ - if (options.isOn(C_CUDA)) - stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 1)); - else - stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 0)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Set CUDA language for launching kernels in RTC"); - } - - /* -------- call loop_guess_index_type_(loop_ref); ------------*/ - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *GuessIndexType(s_loop_ref))); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Guess index type in CUDA kernel"); - - SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - - sizeofL->addArg(*new SgKeywordValExp("long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); - sizeofLL->addArg(*new SgKeywordValExp("long long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); - sizeofI->addArg(*new SgKeywordValExp("int")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofI), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofLL), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - /* -------- call loop_cuda_get_config_(DvmhLoopRef *InDvmhLoop, DvmType *InSharedPerThread, DvmType *InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream,DvmType *OutSharedPerBlock) ----*/ - - e = &SgAssignOp(*new SgVarRefExp(s_threads), *dim3FunctionCall(0)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Get CUDA configuration parameters"); - - shared_mem_count = MaxRedVarSize(red_list); - if (shared_mem_count) - { - if (!options.isOn(C_CUDA)) - { - e = &SgAssignOp(*new SgVarRefExp(s_shared_mem), *new SgValueExp(shared_mem_count)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else - { - std::string preproc = std::string("#ifdef ") + fermiPreprocDir; - char *tmp = new char[preproc.size() + 1]; - strcpy(tmp, preproc.data()); - - st_end->insertStmtBefore(*PreprocessorDirective(tmp), *st_hedr); - e = &SgAssignOp(*new SgVarRefExp(s_shared_mem), *new SgValueExp(shared_mem_count)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - st_end->insertStmtBefore(*PreprocessorDirective("#else"), *st_hedr); - e = &SgAssignOp(*new SgVarRefExp(s_shared_mem), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - st_end->insertStmtBefore(*PreprocessorDirective("#endif"), *st_hedr); - } - } - - SgSymbol *s_regs_int, *s_regs_llong; - - std::string define_name_int = kernel_symb->identifier(); - std::string define_name_long = kernel_symb->identifier(); - - define_name_int += "_int_regs"; - define_name_long += "_llong_regs"; - - s_regs_int = new SgSymbol(VARIABLE_NAME, define_name_int.c_str(), *C_DvmType(), *block_C); - s_regs_llong = new SgSymbol(VARIABLE_NAME, define_name_long.c_str(), *C_DvmType(), *block_C); - - SgStatement *config_int = new SgCExpStmt(*GetConfig(s_loop_ref, s_shared_mem, s_regs_int, s_threads, s_stream, s_shared_mem)); - SgStatement *config_long = new SgCExpStmt(*GetConfig(s_loop_ref, s_shared_mem, s_regs_llong, s_threads, s_stream, s_shared_mem)); - - RGname_list = AddNewToSymbList(RGname_list, s_regs_int); - RGname_list = AddNewToSymbList(RGname_list, s_regs_llong); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), *config_int, *config_long); - st_end->insertStmtBefore(*stmt, *st_hedr); - - /* generating for info_block - define_name = RegisterConstName(); - stmt = ifdef_dir(define_name); - end_info_block->insertStmtBefore(*stmt,*info_block); - s_regs_info = &(s_regs->copy()); - SYMB_SCOPE(s_regs_info->thesymb) = info_block->thebif; - stmt = makeSymbolDeclarationWithInit(s_regs_info, new SgVarRefExp(new SgSymbol(VARIABLE_NAME, define_name))); - end_info_block->insertStmtBefore(*stmt, *info_block); - stmt = else_dir(); - end_info_block->insertStmtBefore(*stmt,*info_block); - stmt = makeSymbolDeclarationWithInit(s_regs_info, new SgValueExp(0)); - end_info_block->insertStmtBefore(*stmt, *info_block); - stmt = endif_dir(); - end_info_block->insertStmtBefore(*stmt,*info_block); */ - - - /* --------- call cuda-kernel ----*/ - espec = CreateBlocksThreadsSpec(shared_mem_count, s_blocks, s_threads, s_stream, s_shared_mem); - - fcall = CallKernel(kernel_symb, espec); - - /* --------- add argument list to kernel call ----*/ - for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) - { - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); - fcall->addArg(*e); - for (i = NumberOfCoeffs(sg); i>0; i--) - fcall->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); - } - if (red_list) - { - reduction_operation_list *rsl; - for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next) //s!=s_blocks_info - { - if (rsl->redvar_size == 0) //reduction variable is scalar - { - if (options.isOn(RTC)) - { - SgVarRefExp *toAdd = new SgVarRefExp(s); - toAdd->addAttribute(RTC_NOT_REPLACE); - fcall->addArg(*toAdd); - } - else - fcall->addArg(*new SgVarRefExp(s)); - } - else if (rsl->redvar_size > 0) - { - int i; - has_red_array = 1; - for (i = 0; i < rsl->redvar_size; i++) - fcall->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); - } - else - { - has_red_array = 1; - for (el = rsl->dimSize_arg; el; el = el->rhs()) - fcall->addArg(el->lhs()->copy()); - for (el = rsl->lowBound_arg; el; el = el->rhs()) - fcall->addArg(el->lhs()->copy()); - } - s = s->next(); - //if (rsl->redvar_size < 0) s = s->next(); // to omit symbol for 'malloc' - // symbol to collect reduction values - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->redvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); - fcall->addArg(*e); s = s->next(); - if (rsl->redvar_size < 0) - {// symbol for initial values of reduction array - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->redvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); - fcall->addArg(*e); s = s->next(); - } - //if(isSgExprListExp(er->lhs()->rhs())) //MAXLOC,MINLOC - if (rsl->locvar) //MAXLOC,MINLOC - { - int i; - for (i = 0; i < rsl->number; i++) - fcall->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); - s = s->next(); - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->locvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); - fcall->addArg(*e); s = s->next(); - } - } - } - - if (!options.isOn(NO_BL_INFO)) - { - if (options.isOn(C_CUDA)) - e = new SgVarRefExp(s_blocks_info); - else - e = new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s_blocks_info)); - fcall->addArg(*e); //'bloks_info' - - } - else //without blocks_info - { - for (i = 0; i < pl_rank; i++) - { - fcall->addArg(*new SgArrayRefExp(*s_idxL, *new SgValueExp(i))); //'idxL[...]' - fcall->addArg(*new SgArrayRefExp(*s_idxH, *new SgValueExp(i))); //'idxH[...]' - if(!IConstStep(DoStmt(first_do_par, i + 1))) //IntStepForHostHandler - fcall->addArg(*new SgArrayRefExp(*s_step, *new SgValueExp(i))); // loopStep[...] - } - for (i = 1; i < pl_rank; i++) - fcall->addArg(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i))); //'blocksS[...]' - fcall->addArg(*new SgVarRefExp(*s_addBlocks)); //'addBlocks' - } - - if (red_list) - { - if(!options.isOn(C_CUDA)) - fcall->addArg(*new SgVarRefExp(s_red_count)); //'red_count' - if (has_red_array) - { - if (!options.isOn(NO_BL_INFO)) - fcall->addArg(*GetOverallStep(s_loop_ref)); - else - fcall->addArg(*new SgVarRefExp(*s_num_of_red_blocks)); - } - } - - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - if (s->attributes() & USE_IN_BIT) - fcall->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel - else - { // passing argument by reference to kernel - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? s->type()->baseType() : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); - fcall->addArg(*e); - sdev = sdev->next(); - } - - e_all_private_size = sizeOfPrivateArraysInBytes(); - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - { - for (el=private_list, lnp=0; el; el=el->rhs()) - { - s = el->lhs()->symbol(); - if (IS_ARRAY(s)) - { - sarg = new SgSymbol(VARIABLE_NAME, PointerNameForPrivateArray(s), *C_PointerType(C_VoidType()), *st_hedr); - ae = new SgCastExp(*C_PointerType( C_Type(s->type()->baseType())), *new SgVarRefExp(sarg)); - fcall->addArg(*ae); - if (!lnp) - private_first = sarg; - lnp++; - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela; ela = ela->rhs()) - fcall->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - eatr = (SgExpression **) el->lhs()->attributeValue(0, L_BOUNDS); - for (ela = *eatr; ela; ela = ela->rhs()) - fcall->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - } - - } - } - } - - if (!options.isOn(NO_BL_INFO)) - { - //insert kernel call - stmt = createKernelCallsInCudaHandler(fcall, s_loop_ref, s_idxTypeInKernel, s_blocks); - - /* ------- WHILE (loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, dim3 *OutThreads, cudaStream_t *OutStream, CudaIndexType **InOutBlocks) != 0) ----*/ - e = LoopDoCuda(s_loop_ref, s_blocks, s_threads, s_stream, s_blocks_info, s_idxTypeInKernel); - do_while = new SgWhileStmt(SgNeqOp(*e, *new SgValueExp(0)), *stmt); - - st_end->insertStmtBefore(*do_while, *st_hedr); - do_while->addComment("// GPU execution"); - - /* ------ block for reductions ----*/ - if (red_list && !options.isOn(C_CUDA)) //if(red_op_list) - InsertDoWhileForRedCount_C(do_while, s_threads, s_red_count); - - } - else //without blocks-info - { - //loop_fill_bounds_(loop_ref,idxL,idxH,0); - e = FillBounds(s_loop_ref, s_idxL, s_idxH, s_step); //s_step => NULL - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - // blocksS[i] = ... i=0,...,pl_rank-1 - for (i = pl_rank - 1; i >= 0; i--) - { - stmt = AssignBlocksSElement(i, pl_rank, s_blocksS, s_idxL, s_idxH, s_step, s_threads); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - // overallBlocks = blocksS[0]; - // restBlocks = overallBlocks; - // addBlocks = 0; - // blocks = dim3(1,1,1); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_overallBlocks), *new SgArrayRefExp(*s_blocksS, *new SgValueExp(0)))); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (currentLoop && currentLoop->irregularAnalysisIsOn()) - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_restBlocks), *new SgVarRefExp(*s_overallBlocks) * *GetWarpSize(s_loop_ref))); - else - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_restBlocks), *new SgVarRefExp(*s_overallBlocks))); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_addBlocks), *new SgValueExp(0))); - st_end->insertStmtBefore(*stmt, *st_hedr); - e = &SgAssignOp(*new SgVarRefExp(s_blocks), *dim3FunctionCall(1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - // stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks,"x"),*new SgArrayRefExp(*s_blocksS,*new SgValueExp(0)))); - // st_end->insertStmtBefore(*stmt,*st_hedr); - // stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks,"y"),*new SgValueExp(1))); - // st_end->insertStmtBefore(*stmt,*st_hedr); - // stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks,"z"),*new SgValueExp(1))); - // st_end->insertStmtBefore(*stmt,*st_hedr); - - /* ------ block for prepare reductions ----*/ - if (red_list) - { - InsertAssignForReduction(st_end, s_num_of_red_blocks, s_fill_flag, s_overallBlocks, s_threads, s_loop_ref); - if(!options.isOn(C_CUDA)) - InsertDoWhileForRedCount_C(st_end, s_threads, s_red_count); - InsertPrepareReductionCalls(st_end, s_loop_ref, s_num_of_red_blocks, s_fill_flag, s_red_num); - } - //insert kernel call - st_call = createKernelCallsInCudaHandler(fcall, s_loop_ref, s_idxTypeInKernel, s_blocks); - - - SgExpression *getProp = GetDeviceProp(s_loop_ref, new SgKeywordValExp("CUDA_MAX_GRID_X")); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_max_blocks), *getProp)); - st_end->insertStmtBefore(*stmt, *st_hedr); - - // insert code for big private arrays - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) //(e_size = sizeOfPrivateArraysInBytes())) - { - SgSymbol *s_private_size = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("privateSizeForBlock"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s_private_size); - st_end->insertStmtBefore(*stmt, *st_hedr); - SgSymbol *s_total_threads = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("totalThreads"), *C_DvmType(), *st_hedr); - addDeclExpList(s_total_threads, stmt->expr(0)); - - SgExpression *e_threads = &(*new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z")); - SgExpression *e_private_size_for_block = &(*e_threads * *(e_all_private_size ? e_all_private_size : CalculateSizeOfPrivateArraysInBytes())); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_private_size), *e_private_size_for_block)); - st_end->insertStmtBefore(*stmt, *st_hedr); - - SgExpression *e_maxBlocks = GetMaxBlocks(s_loop_ref, s_max_blocks, s_private_size); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_max_blocks), *e_maxBlocks)); - st_end->insertStmtBefore(*stmt, *st_hedr); - - SgFunctionCallExp *fmin = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "min", *C_DvmType(), *st_hedr)); - fmin->addArg(*new SgVarRefExp(s_max_blocks)); - fmin->addArg(*new SgVarRefExp(s_restBlocks)); - SgExpression *e_total_threads = &((e_threads->copy()) * *fmin); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_total_threads), *e_total_threads)); - st_end->insertStmtBefore(*stmt, *st_hedr); - - // Get private arrays - GetMemoryForPrivateArrays(private_first, s_loop_ref, lnp, st_end, st_hedr, new SgVarRefExp(s_total_threads)); - } - if (currentLoop && currentLoop->irregularAnalysisIsOn()) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_max_blocks), *new SgVarRefExp(*s_max_blocks) / *GetWarpSize(s_loop_ref) * *GetWarpSize(s_loop_ref))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - //e = & operator > ( *new SgVarRefExp(s_restBlocks), - do_while = new SgWhileStmt(operator > (*new SgVarRefExp(s_restBlocks), *new SgValueExp(0)), *st_call); - st_end->insertStmtBefore(*do_while, *st_hedr); - do_while->addComment("// GPU execution"); - stmt = IfForHeader(s_restBlocks, s_blocks, s_max_blocks); - st_call->insertStmtBefore(*stmt, *do_while); - stmt = new SgCExpStmt(*new SgExpression(MINUS_ASSGN_OP, new SgVarRefExp(*s_restBlocks), new SgRecordRefExp(*s_blocks, "x"), NULL)); - st_call->insertStmtAfter(*stmt, *do_while); - stmt = new SgCExpStmt(operator += (*new SgVarRefExp(*s_addBlocks), *new SgRecordRefExp(*s_blocks, "x"))); - st_call->insertStmtAfter(*stmt, *do_while); - /* ------ block for finish reductions ----*/ - if (red_list) - InsertFinishReductionCalls(st_end, s_loop_ref, s_red_num); - - // to dispose private arrays - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - for (s = private_first, ln = 0; ln < lnp; s = s->next(), ln++) // private arrays - { - stmt = new SgCExpStmt(*DisposePrivateArray(s_loop_ref, s)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(st_hedr, s_loop_ref, 0); - - return(st_hedr); -} - - -SgStatement *Create_C_Adapter_Function_For_Sequence(SgSymbol *sadapter, SgStatement *first_st) -{ - symb_list *sl = NULL; - SgStatement *st_hedr = NULL, *st_end = NULL, *stmt = NULL, *do_while = NULL, *st_base = NULL; - SgExpression *fe = NULL, *ae = NULL, *arg_list = NULL, *el = NULL, *e = NULL; - SgExpression *espec = NULL; - SgFunctionCallExp *fcall = NULL; - //SgStatement *fileHeaderSt; - SgSymbol *s_loop_ref = NULL, *sarg = NULL, *s = NULL, *sb = NULL, *sg = NULL, *sdev = NULL, *h_first = NULL; - SgSymbol *hgpu_first = NULL, *base_first = NULL, *uses_first = NULL, *scalar_first = NULL; - SgSymbol *s_stream = NULL, *s_blocks = NULL, *s_threads = NULL, *s_dev_num = NULL, *s_idxTypeInKernel = NULL; - SgType *typ = NULL; - int ln, num, i, uses_num; - - // create fuction header - st_hedr = Create_C_Function(sadapter); - st_end = st_hedr->lexNext(); - fe = st_hedr->expr(0); - st_hedr->addComment(Cuda_SequenceHandlerComment(first_st->lineNumber())); - - // create dummy argument list: - // loop_ref,, - - typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); - ae = new SgVarRefExp(s_loop_ref); //loop_ref - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fe->setLhs(arg_list); - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) // headers - { //printf("%s\n",sl->symb->identifier()); - SgArrayType *typearray = new SgArrayType(*C_DvmType()); - //typearray -> addRange(*new SgValueExp(Rank(sl->symb)+2)); - sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - } - for (el = uses_list, ln = 0; el; el = el->rhs(), ln++) // uses - { - s = el->lhs()->symbol(); - typ = C_PointerType(C_Type(s->type())); - sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); - if (isByValue(s)) - SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; - - ae = UsedValueRef(s, sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - uses_first = sarg; - } - uses_num = ln; - - // create variable's declarations: ,,,stream,blocks,threads - - s_stream = s = new SgSymbol(VARIABLE_NAME, "stream", *C_Derived_Type(s_cudaStream), *st_hedr); - stmt = makeSymbolDeclaration(s); /*stmt = s->makeVarDeclStmt(); */ - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_blocks = s = new SgSymbol(VARIABLE_NAME, "blocks", *t_dim3, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_threads = s = new SgSymbol(VARIABLE_NAME, "threads", *t_dim3, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - s_idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device - if (!scalar_first) - { - scalar_first = sdev; - stmt = makeSymbolDeclaration(sdev); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(sdev, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { - s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - hgpu_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) - { - s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - base_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - num = ln; - - // create execution part - - /* -------- call dvmh_get_device_addr(DvmType *deviceRef, void *variable) ----*/ - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - s_dev_num = doDeviceNumVar(st_hedr, st_end, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Get device addresses"); - sdev = sdev->next(); - } - - /* -------- call dvmh_get_natural_base(DvmType *deviceRef, DvmType dvmDesc[]) ----*/ - - for (s = h_first, sb = base_first, ln = 0; ln < num; s = s->next(), sb = sb->next(), ln++) - { - s_dev_num = doDeviceNumVar(st_hedr, st_end, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - { - stmt->addComment("// Get 'natural' bases"); - st_base = stmt; // save for inserting loop_cuda_autotransform_() before - } - } - - /* -------- call loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[] ) ----*/ - if (options.isOn(AUTO_TFM)) // for option -noTfm calls are not generated - { - for (s = h_first, ln = 0; ln < num; s = s->next(), ln++) - { - e = CudaAutoTransform(s_loop_ref, s); - stmt = new SgCExpStmt(*e); - st_base->insertStmtBefore(*stmt, *st_hedr); // insert before getting bases for arrays - if (!ln) - stmt->addComment("// Autotransform arrays"); - } - } - /* -------- call dvmh_fill_header_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[]);----*/ - - for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) - { - e = FillHeader(s_dev_num, sb, s, sg); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Fill 'device' headers"); - } - - /* -------- call loop_guess_index_type_(loop_ref); ------------*/ - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *GuessIndexType(s_loop_ref))); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Guess index type in CUDA kernel"); - - SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - - sizeofL->addArg(*new SgKeywordValExp("long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); - sizeofLL->addArg(*new SgKeywordValExp("long long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); - sizeofI->addArg(*new SgKeywordValExp("int")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofI), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofLL), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (lpart_list) // there are dvm-array references in left part of assign statement - { - local_part_list *pl; - - for (pl = lpart_list; pl; pl = pl->next) - { - pl->local_part = new SgVariableSymb(pl->local_part->identifier(), *C_PointerType(C_VoidType()), *st_hedr); - stmt = makeSymbolDeclarationWithInit(pl->local_part, GetLocalPart(s_loop_ref, pl->dvm_array, s_idxTypeInKernel)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - - /* -------- call loop_cuda_get_config_(DvmhLoopRef *InDvmhLoop, DvmType *InSharedPerThread, DvmType *InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream,DvmType *OutSharedPerBlock) ----*/ - - e = &SgAssignOp(*new SgVarRefExp(s_threads), *dim3FunctionCall(0)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Get CUDA configuration parameters"); - - e = GetConfig(s_loop_ref, NULL, NULL, s_threads, s_stream, NULL); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - /* --------- call cuda-kernel ----*/ - espec = CreateBlocksThreadsSpec(0, s_blocks, s_threads, s_stream, NULL); - - fcall = CallKernel(kernel_symb, espec); - - /* --------- add argument list to kernel call ----*/ - // bases and coefficients for arrays - for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) - { - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); - fcall->addArg(*e); - for (i = NumberOfCoeffs(sg); i>0; i--) - fcall->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); - } - - if (lpart_list) // local parts for dvm-arrays - { - local_part_list *pl; - - for (pl = lpart_list; pl; pl = pl->next) - { - if (options.isOn(C_CUDA)) - { - e = new SgVarRefExp(pl->local_part); - SgAttribute *att = new SgAttribute(1, NULL, 777, *new SgSymbol(VARIABLE_NAME), 777); - e->addAttribute(att); - } - else - e = new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(pl->local_part)); - fcall->addArg(*e); - } - } - - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - if (s->attributes() & USE_IN_BIT) - fcall->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel - else - { // passing argument by reference to kernel - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? s->type()->baseType() : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); - fcall->addArg(*e); - sdev = sdev->next(); - } - - // inset kernel call - stmt = createKernelCallsInCudaHandler(fcall, s_loop_ref, s_idxTypeInKernel, s_blocks); - /* ------- WHILE (loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, dim3 *OutThreads, cudaStream_t *OutStream, CudaIndexType **InOutBlocks) != 0) ----*/ - - e = LoopDoCuda(s_loop_ref, s_blocks, s_threads, s_stream, NULL, CudaIndexConst()); - do_while = new SgWhileStmt(SgNeqOp(*e, *new SgValueExp(0)), *stmt); - st_end->insertStmtBefore(*do_while, *st_hedr); - do_while->addComment("// GPU execution"); - - return(st_hedr); -} - -void GetMemoryForPrivateArrays(SgSymbol *private_first, SgSymbol *s_loop_ref, int nump, SgStatement *st_end, SgStatement *st_hedr, SgExpression *e_totalThreads) -{ - SgSymbol *s; - SgExpression *el; - SgStatement *stmt; - int ln; - if (!private_first) - return; - SgStatement *st_decl = makeSymbolDeclaration(private_first); - st_end->insertStmtBefore(*st_decl, *st_hedr); - st_decl->addComment("// Get private arrays"); - - for (s = private_first, el = private_list, ln = 0; ln < nump; s = s->next(), el = el->rhs(), ln++) // private arrays - { - while (!IS_ARRAY(el->lhs()->symbol())) - el = el->rhs(); - if (ln) - addDeclExpList(s, st_decl->expr(0)); - SgExpression **esizes = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *elength = esizes ? &( *ProductOfDimSizeArgs(*esizes) * *sizeOfElementInBytes(el->lhs()->symbol())) : ArrayLength(el->lhs()->symbol(), dvm_parallel_dir, 0); - SgExpression *e_bytes = &(*elength * *e_totalThreads); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s), *GetPrivateArray(s_loop_ref, e_bytes))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } -} - -SgExpression *sizeOfElementInBytes(SgSymbol *symb) -{ - int isz = TypeSize(symb->type()->baseType()); - if (isz <= 0 ) - Error("Illegal type of private array %s, not implemented yet for GPU",symb->identifier(), 592, dvm_parallel_dir); - return (new SgValueExp(isz)); -} - -SgExpression *sizeOfPrivateArraysInBytes() -{ - SgExpression *e_size = CalculateSizeOfPrivateArraysInBytes(); - if (e_size && e_size->isInteger()) // calculating length if it is possible - { - if (options.isOn(BIG_PRIVATES)) - return e_size; - else - return NULL; - } - return e_size; -} - -SgExpression *CalculateSizeOfPrivateArraysInBytes() -{ - SgExpression *el, *e_size = NULL; - int isize = 0; - //if (newVars.size() != 0) - //{ - // correctPrivateList(RESTORE); - // newVars.clear(); - //} - for (el = private_list; el; el = el->rhs()) - { - SgSymbol *symb = el->lhs()->symbol(); - if (IS_ARRAY(symb)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *esa; - if (eatr) - esa = &(*ProductOfDimSizeArgs(*eatr) * *sizeOfElementInBytes(symb)); - else - esa = &(*ArrayLengthInElems(symb, dvm_parallel_dir, 1) * *sizeOfElementInBytes(symb)); //ArrayLength(symb, dvm_parallel_dir, 1); - if (e_size) - e_size = &( *e_size + *esa ); - else - e_size = esa; - - // if (e_size) - // e_size = &( *e_size + *ArrayLengthInElems(symb, dvm_parallel_dir, 1) * *sizeOfElementInBytes(symb)); - // else - // e_size = &( *ArrayLengthInElems(symb, dvm_parallel_dir, 1) * *sizeOfElementInBytes(symb)); - } - } - if (e_size && e_size->isInteger()) // calculating length if it is possible - e_size = new SgValueExp(e_size->valueInteger()); - - return e_size; -} - -int PrivateArrayClassUse(SgExpression *e_all_private_size) -{ - if (private_array_arg || e_all_private_size) - return 1; - return 0; -} - -SgExpression *ProductOfDimSizeArgs(SgExpression *esizes) -{ - SgExpression *el, *eprod = NULL; - for (el=esizes; el; el=el->rhs()) - { - if (eprod) - eprod = &(*eprod * SgDerefOp(*new SgVarRefExp(el->lhs()->lhs()->symbol()))); - - else - eprod = &SgDerefOp(*new SgVarRefExp(el->lhs()->lhs()->symbol())); - } - return eprod; -} - - -SgStatement *AssignBlocksSElement(int i, int pl_rank, SgSymbol *s_blocksS, SgSymbol *s_idxL, SgSymbol *s_idxH, SgSymbol *s_step, SgSymbol *s_threads) -{ - SgExpression *e=NULL, *estep=NULL; - int istep; - istep = IConstStep(DoStmt(first_do_par, i + 1)); - // idxH[i] - idxL[i] + 1 - e = &(*new SgArrayRefExp(*s_idxH, *new SgValueExp(i)) - *new SgArrayRefExp(*s_idxL, *new SgValueExp(i))); - if (istep != 1) - { - // (idxH[i] - idxL[i] + 1)/step[i] - if (istep == 0) - estep = new SgArrayRefExp(*s_step, *new SgValueExp(i)); - else - estep = new SgValueExp(istep); - e = &((*e + estep->copy()) / *estep); - } - if (istep == 1) - { - if (i == pl_rank - 1) - // blocksS[i]= (idxH[i] - idxL[i] + threads.x ) / threads.x; - e = &((*e + *new SgRecordRefExp(*s_threads, "x")) / *new SgRecordRefExp(*s_threads, "x")); - - if (i == pl_rank - 2) - // blocksS[i] = blocksS[i+1] * ((idxH[i] - idxL[i] + threads.y ) / threads.y); - e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "y")) / *new SgRecordRefExp(*s_threads, "y"))); - if (i == pl_rank - 3) - // blocksS[i] = blocksS[i+1] * ((idxH[i] - idxL[i] + threads.z ) / threads.z); - e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "z")) / *new SgRecordRefExp(*s_threads, "z"))); - if (i <= pl_rank - 4) - //blocksS[i]= blocksS[i+1]* (idxH[i] - idxL[i] + 1 ); - e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * (*e + *new SgValueExp(1))); - } - else - { - if (i == pl_rank - 1) - // blocksS[i]= (idxH[i] - idxL[i] + 1)/step[i] + threads.x - 1) / threads.x; - e = &((*e + *new SgRecordRefExp(*s_threads, "x") - *new SgValueExp(1)) / *new SgRecordRefExp(*s_threads, "x")); - if (i == pl_rank - 2) - // blocksS[i] = blocksS[i+1] * (((idxH[i] - idxL[i] + 1)/step[i] + threads.y - 1) / threads.y); step==1 - e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "y") - *new SgValueExp(1)) / *new SgRecordRefExp(*s_threads, "y"))); - if (i == pl_rank - 3) - // blocksS[i] = blocksS[i+1] * (((idxH[i] - idxL[i] + 1)/step[i] + threads.z - 1 ) / threads.z); - e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "z") - *new SgValueExp(1)) / *new SgRecordRefExp(*s_threads, "z"))); - if (i <= pl_rank - 4) - //blocksS[i] = blocksS[i+1] * ((idxH[i] - idxL[i] + 1)/step[i]); - e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * *e); - } - return new SgCExpStmt(SgAssignOp(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i)), *e)); -} - -SgStatement *IfForHeader(SgSymbol *s_restBlocks, SgSymbol *s_blocks, SgSymbol *s_max_blocks) -{ - // if (restBlocks <= max_blocks) - // blocks.x = restBlocks; - // else - // blocks.x = max_blocks; - SgStatement *if_st, *stTrue, *stFalse; - SgExpression *restBlocksRef, *blocksRef, *cond; - restBlocksRef = new SgVarRefExp(s_restBlocks); - blocksRef = new SgVarRefExp(s_blocks); - - cond = &(*restBlocksRef <= (*new SgVarRefExp(s_max_blocks))); - stTrue = new SgCExpStmt(SgAssignOp(*blocksRef, *restBlocksRef)); - stFalse = new SgCExpStmt(SgAssignOp(*blocksRef, *new SgVarRefExp(s_max_blocks))); - if_st = new SgIfStmt(*cond, *stTrue, *stFalse); - - return if_st; -} - -void InsertDoWhileForRedCount_C(SgStatement *cp, SgSymbol *s_threads, SgSymbol *s_red_count) -{ - // inserting after statement cp (DO_WHILE) the block for red_count calculation: - // red_count = 1; - // while (red_count * 2 < threads%x * threads%y * threads%z) - // red_count *= 2; - // - SgStatement *st_while, *ass; - SgExpression *cond, *asse; - // red_count * 2 .lt. threads%x * threads%y * threads%z - cond = &operator < (*new SgVarRefExp(s_red_count) * (*new SgValueExp(2)), *ThreadsGridSize(s_threads)); - // insert do while loop - //ass = new SgAssignStmt(*new SgVarRefExp(red_count_symb), (*new SgVarRefExp(red_count_symb))*(*new SgValueExp(2))); - asse = &operator *= (*new SgVarRefExp(s_red_count), *new SgValueExp(2)); - ass = new SgCExpStmt(*asse); - st_while = new SgWhileStmt(*cond, *ass); - if (cp->variant() == WHILE_NODE) - cp->insertStmtAfter(*st_while, *cp); - else - cp->insertStmtBefore(*st_while, *cp->controlParent()); - // insert: red_count = 1 - ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_count), *new SgValueExp(1))); - st_while->insertStmtBefore(*ass, *st_while->controlParent()); - return; - - - /* - // !!!!!!!!!!!!! DEPRECATED BLOCK !!!!!!!!!!!!!!!!!!!!!! - // inserting after statement cp (DO_WHILE) the block for red_count calculation: - // red_count = 1; - SgStatement *ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_count), *new SgValueExp(1))); - if (cp->variant() == WHILE_NODE) - cp->insertStmtAfter(*ass, *cp); - else - cp->insertStmtBefore(*ass, *cp->controlParent()); - // !!!!!!!!!!!!! END OF DEPRECATED !!!!!!!!!!!!!!!!!!!!!! - */ -} - -void InsertAssignForReduction(SgStatement *st_where, SgSymbol *s_num_of_red_blocks, SgSymbol *s_fill_flag, SgSymbol *s_overallBlocks, SgSymbol *s_threads, SgSymbol* s_loop_ref) -{ - // inserting before statement 'st_where' the block of assignments: - SgStatement *ass; - // for C_Cuda: - // num_of_red_blocks = overallBlocks * (threads.x * threads.y * threads.z / warpSize); - // for Fortran_Cuda: - // num_of_red_blocks = overallBlocks; - - SgExpression *re = new SgVarRefExp(*s_overallBlocks); - if(options.isOn(C_CUDA)) - re = &(*re * (*new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *GetWarpSize(s_loop_ref))); - ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_num_of_red_blocks), *re)); - st_where->insertStmtBefore(*ass, *st_where->controlParent()); - ass->addComment("// Prepare reduction"); - - // fill_flag = 0; - ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_fill_flag), *new SgValueExp(0))); - st_where->insertStmtBefore(*ass, *st_where->controlParent()); -} - -void InsertPrepareReductionCalls(SgStatement *st_where, SgSymbol *s_loop_ref, SgSymbol *s_num_of_red_blocks, SgSymbol *s_fill_flag, SgSymbol *s_red_num) -{ // inserting before statement 'st_where' - SgStatement *stmt; - int ln; - reduction_operation_list *rsl; - // red_num = - // loop_cuda_red_prepare_(loop_ref, &(red_num), &(num_of_red_blocks), &(fill_flag)); - //looking through the reduction_op_list - for (rsl = red_struct_list, ln = 0; rsl; rsl = rsl->next, ln++) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_num), *new SgValueExp(ln + 1))); - st_where->insertStmtBefore(*stmt, *st_where->controlParent()); - - //XXX changed reduction scheme to atomic, Kolganov 06.02.2020 - if (rsl->redvar_size < 0) - stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_red_num, s_num_of_red_blocks, s_fill_flag, 1, 1)); - else - stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_red_num, s_num_of_red_blocks, s_fill_flag)); - st_where->insertStmtBefore(*stmt, *st_where->controlParent()); - } -} - -void InsertFinishReductionCalls(SgStatement *st_where, SgSymbol *s_loop_ref, SgSymbol *s_red_num) -{ // inserting before statement 'st_where' - SgStatement *stmt; - int ln; - reduction_operation_list *rsl; - // red_num = - // loop_red_finish_(loop_ref, &(red_num), &(num_of_red_blocks), &(fill_flag)); - //looking through the reduction_op_list - for (rsl = red_struct_list, ln = 0; rsl; rsl = rsl->next, ln++) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_num), *new SgValueExp(ln + 1))); - st_where->insertStmtBefore(*stmt, *st_where->controlParent()); - if (!ln) - stmt->addComment("// Finish reduction"); - stmt = new SgCExpStmt(*FinishReduction(s_loop_ref, s_red_num)); - st_where->insertStmtBefore(*stmt, *st_where->controlParent()); - } -} - -int MaxRedVarSize(SgExpression *red_op_list) -{ - reduction_operation_list *rsl; - SgExpression *ev, *er, *ered, *el, *en; - int max, size, num_el, size_loc; - SgType *type; - - max = 0; el = NULL; - if (!red_op_list) return(max); - - //looking through the reduction_op_list - for (er = red_op_list, rsl = red_struct_list; er; er = er->rhs(), rsl = rsl->next) - { - ered = er->lhs(); // reduction (variant==ARRAY_OP) - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - - if (isSgExprListExp(ev)) - { - el = ev->rhs()->lhs(); - en = ev->rhs()->rhs()->lhs(); - - ev = ev->lhs(); // reduction variable reference - } - type = ev->symbol()->type(); - - if (isSgArrayType(type)) - type = type->baseType(); - - size = TypeSize(type); - //esize = TypeSizeCExpr(type); - if (rsl->redvar_size > 0) // reduction variable is array - { - if (options.isOn(C_CUDA)) - size = size; - else - size = size * rsl->redvar_size; - } - - if (el) // MAXLOC,MINLOC - { - num_el = rsl->number; - // calculation number of location array - // ec = Calculate(en); - // if(ec->isInteger()) - // num_el = ec->valueInteger(); - - type = el->symbol()->type(); - if (isSgArrayType(type)) - type = type->baseType(); - - size_loc = TypeSize(type) * num_el; - - // if(size % 8 == 0) - // size_loc = ( size_loc % 8 == 0 ) ? size_loc : (size_loc / 8 ) * 8 + 8; - // else if(size % 4 == 0) - // size_loc = ( size_loc % 4 == 0 ) ? size_loc : (size_loc / 4 ) * 4 + 4; - // else if(size % 2 == 0) - // size_loc = ( size_loc % 2 == 0 ) ? size_loc : (size_loc / 2 ) * 2 + 2; - - size = size + size_loc; - size = (size % 8 == 0) ? size : (size / 8) * 8 + 8; - } - max = (max < size) ? size : max; - } - return(max); -} - - -SgExpression *CreateBlocksThreadsSpec(int size, SgSymbol *s_blocks, SgSymbol *s_threads, SgSymbol *s_stream, SgSymbol *s_shared_mem) -{ - SgExprListExp *el, *ell, *elm; - SgExpression *mult; - el = new SgExprListExp(*new SgVarRefExp(s_blocks)); - ell = new SgExprListExp(*new SgVarRefExp(s_threads)); - el->setRhs(ell); - //size==0 - parallel loop without reduction clause - // size - shared memory size per one thread - if (size) - mult = new SgVarRefExp(s_shared_mem); - else - mult = new SgValueExp(size); - elm = new SgExprListExp(*mult); //shared memory size per one block - ell->setRhs(elm); - ell = new SgExprListExp(*new SgVarRefExp(s_stream)); - elm->setRhs(ell); - return((SgExpression *)el); -} - -SgExpression *MallocExpr(SgSymbol *var, SgExpression *eldim) -{ - SgExpression *e, *el; - //e = new SgValueExp(TypeSize(var->type()->baseType())); - e = &SgSizeOfOp(*new SgTypeRefExp(*C_Type(var->type()->baseType()))); - for (el = eldim; el; el = el->rhs()) // sizeof()* *N1...* *Nk - e = &(*e * el->lhs()->copy()); - e = mallocFunction(e, block_C); // malloc(sizeof()* *N1...* *Nk) - e = new SgCastExp(*C_PointerType(C_Type(var->type()->baseType())), *e); - // ( *) malloc(sizeof()* *N1...* *Nk) - return(e); -} - -int NumberOfCoeffs(SgSymbol *sg) -{ - SgArrayType *typearray; - SgExpression *esize; - int d; - typearray = isSgArrayType(sg->type()); - if (!typearray) return(0); - esize = typearray->sizeInDim(0); - if (((SgValueExp *)esize)->intValue() == 0) return(0); //remote_acces buffer of 1 element - d = options.isOn(AUTO_TFM) ? 0 : 1; //inparloop ? 0 : 1; //ACROSS_MOD_IN_KERNEL ? 0 : 1; //WithAcrossClause() - return(((SgValueExp *)esize)->intValue() - DELTA - d); -} - -SgStatement * makeSymbolDeclaration(SgSymbol *s) -{ - SgStatement * st; - - st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*SgMakeDeclExp(s, s->type()))); - - return(st); -} - -SgStatement * makeExternSymbolDeclaration(SgSymbol *s) -{ - SgStatement * st; - - st = new SgStatement(VAR_DECL); - - st->setExpression(0, *new SgExprListExp(*SgMakeDeclExp(s, new SgDescriptType(*s->type(), BIT_EXTERN)))); - - return(st); -} - -SgStatement * makeSymbolDeclarationWithInit(SgSymbol *s, SgExpression *einit) -{ - SgStatement * st; - SgExpression *e; - st = new SgStatement(VAR_DECL); - e = &SgAssignOp(*SgMakeDeclExp(s, s->type()), *einit); - st->setExpression(0, *new SgExprListExp(*e)); - - return(st); -} - -// stmt = makeSymbolDeclaration_T(st_hedr); -// st_end->insertStmtBefore(*stmt,*st_hedr); - -SgStatement * makeSymbolDeclaration_T(SgStatement *st_hedr) -{ - SgStatement * st; - SgExpression *e; - SgSymbol *s; - SgSymbol * sc = new SgSymbol(VARIABLE_NAME, "cuda_ptr", *C_PointerType(SgTypeFloat()), *st_hedr); - st = new SgStatement(VAR_DECL); - SgDerivedCollectionType *tmpT = new SgDerivedCollectionType(*new SgSymbol(VARIABLE_NAME, "device_ptr"), *SgTypeFloat()); - s = new SgSymbol(VARIABLE_NAME, "dev_ptr", *tmpT, *st_hedr); - - e = new SgExpression(CLASSINIT_OP); - e->setLhs(SgMakeDeclExp(s, s->type())); - e->setRhs(new SgExprListExp(*new SgVarRefExp(sc))); - st->setExpression(0, *new SgExprListExp(*e)); - - return(st); -} - - -SgExpression * addDeclExpList(SgSymbol *s, SgExpression *el) -{ - SgExpression *e, *l; - e = new SgExprListExp(*SgMakeDeclExp(s, s->type())); - for (l = el; l->rhs(); l = l->rhs()) - ; - l->setRhs(e); - return(e); - -} - -SgExpression *UsedValueRef(SgSymbol *susg, SgSymbol *s) -{ - if (isSgArrayType(susg->type())) - Error("Array %s is used in loop, not implemented yet for GPU", susg->identifier(), 591, first_do_par); - if (susg->type()->variant() == T_DERIVED_TYPE) - Error("Variable %s of derived type is used in loop, not implemented yet for GPU", susg->identifier(), 590, first_do_par); - return(new SgVarRefExp(s)); -} - -char *Cuda_LoopHandlerComment() -{ - char *cmnt = new char[100]; - sprintf(cmnt, "// CUDA handler for loop on line %d \n", first_do_par->lineNumber()); - //sprintf(cmnt,"//********************* CUDA handler for loop on line %d *********************\n",first_do_par->lineNumber()); - return(cmnt); -} - -char *Cuda_SequenceHandlerComment(int lineno) -{ - char *cmnt = new char[150]; - sprintf(cmnt, "// CUDA handler for sequence of statements on line %d \n", lineno); - //sprintf(cmnt,"//********************* CUDA handler for sequence of statements on line %d *********************\n",first_do_par->lineNumber()); - return(cmnt); -} - -SgExpression *dim3FunctionCall(int i) -{ - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdim3); - - fe->addArg(*new SgValueExp(i)); - fe->addArg(*new SgValueExp(i)); - fe->addArg(*new SgValueExp(i)); - return fe; -} - -char *RegisterConstName() -{ - char *name = new char[strlen(kernel_symb->identifier()) + 6]; - name[0] = '\0'; - strcat(name, aks_strupr(kernel_symb->identifier())); - strcat(name, "_REGS"); - return(name); - -} - -char *Up_regs_Symbol_Name(SgSymbol *s_regs) -{ - char *name = new char[strlen(s_regs->identifier()) + 1]; - name[0] = '\0'; - strcat(name, aks_strupr(s_regs->identifier())); - return(name); - -} - -void GenerateStmtsForInfoFile() -{ - SgStatement *stmt, *end_if_dir; - char *define_name; - symb_list *sl; - //SgSymbol *s_regs_info; - if (!RGname_list || !info_block) - return; - for (sl = RGname_list; sl; sl = sl->next) - { - // generating for info_block - - end_if_dir = endif_dir(); - info_block->insertStmtAfter(*end_if_dir, *info_block); - define_name = Up_regs_Symbol_Name((sl->symb)); - stmt = ifdef_dir(define_name); - end_if_dir->insertStmtBefore(*stmt, *info_block); - //s_regs_info = &(sl->symb->copy()); - //SYMB_SCOPE(sl->symb->thesymb) = info_block->thebif; - stmt = makeSymbolDeclarationWithInit(sl->symb, new SgVarRefExp(new SgSymbol(VARIABLE_NAME, define_name))); - end_if_dir->insertStmtBefore(*stmt, *info_block); - stmt = else_dir(); - end_if_dir->insertStmtBefore(*stmt, *info_block); - stmt = makeSymbolDeclarationWithInit(sl->symb, new SgValueExp(0)); - end_if_dir->insertStmtBefore(*stmt, *info_block); - } - -} - -void GenerateEndIfDir() -{ - if (block_C) - block_C->addComment("#endif\n"); -} - -void GenerateDeclarationDir() -{ - if (block_C) - block_C->addComment(declaration_cmnt); -} - -#undef Nintent -#undef DELTA -#undef Nhandler -#undef SAVE_LABEL_ID diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_across.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_across.cpp deleted file mode 100644 index 43142dd..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_across.cpp +++ /dev/null @@ -1,6318 +0,0 @@ -#include "dvm.h" -#include "aks_structs.h" -#include "acc_data.h" - -using namespace std; - -// all flags -#define LongT C_DvmType() -#define debugMode 0 -#define kerneloff 0 - -// extern variables -extern reduction_operation_list *red_struct_list; -extern symb_list *shared_list, *acc_func_list; -extern symb_list *RGname_list; -extern symb_list *acc_call_list; -extern vector loopVars; - -// extern functions -extern SgStatement *Create_C_Function(SgSymbol*); -extern SgExpression *RedPost(SgSymbol*, SgSymbol*, SgSymbol*, SgSymbol*); -extern SgSymbol *GridSymbolForRedInAdapter(SgSymbol *, SgStatement *); -extern SgSymbol *GpuHeaderSymbolInAdapter(SgSymbol *, SgStatement *); -extern SgSymbol *GpuBaseSymbolInAdapter(SgSymbol *, SgStatement *); -extern SgExpression *CudaReplicate(SgSymbol *, SgSymbol *, SgSymbol *, SgSymbol *); -extern SgStatement *IncludeLine(char*); -extern void optimizeLoopBodyForOne(vector &allNewInfo); -extern void searchIdxs(vector &allInfo, SgExpression *st); - -// local functions -vector Create_C_Adapter_Function_Across_variants(SgSymbol*, SgSymbol*, const int, const int, const int, const vector&, const vector&); -vector Create_C_Adapter_Function_Across_OneThread(SgSymbol*, SgSymbol*, const int, const int); -symb_list* AddToSymbList(symb_list*, SgSymbol*); -symb_list* AddNewToSymbList(symb_list*, SgSymbol*); -void CreateReductionBlocksAcross(SgStatement*, int, SgExpression*, SgSymbol*); -//void CompleteStructuresForReductionInKernelAcross(void); -void DeclarationOfReductionBlockInKernelAcross(SgExpression *ered, reduction_operation_list *rsl); -void DeclarationCreateReductionBlocksAcross(int, SgExpression*); -AnalyzeReturnGpuO1 analyzeLoopBody(int type); - -// local static variables -static SgSymbol *red_first = NULL; -static bool createBodyKernel = false; -static bool createConvert_XY = true; -static const int numLoopVars = 16; -static bool ifReadLvlMode = false; -static vector > copyOfBody; -static vector allRegNames; -static vector allVariants; - -static const char *funcDvmhConvXYfortVer = " attributes(device) subroutine dvmh_convert_XY_int(x,y,Rx,Ry,slash,idx)\n implicit none\n integer ,value:: x\n integer ,value:: y\n integer ,value:: Rx\n integer ,value:: Ry\n integer ,value:: slash\n integer ,device:: idx \n \n if(slash .eq. 0) then\n if(Rx .eq. Ry) then\n if(x + y .lt. Rx) then\n idx = y + (1+x+y)*(x+y)/2\n else\n idx = Rx*(Rx-1)+x-(2*Rx-x-y-1)*(2*Rx-x-y-2)/2\n endif \n elseif(Rx .lt. Ry) then\n if(x + y .lt. Rx) then\n idx = y + ((1+x+y)*(x+y)) / 2\n elseif(x + y .lt. Ry) then\n idx = ((1+Rx)*Rx) / 2 + Rx - x - 1 + Rx * (x+y-Rx)\n else\n idx = Rx*Ry-Ry+y-(((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2))/2)\n endif\n else\n if(x + y .lt. Ry) then\n idx = x + (1+x+y)*(x+y) / 2\n elseif(x + y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + (Ry-y-1) + Ry * (x+y-Ry)\n else\n idx = Rx*Ry-Rx+x-((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2)/2)\n endif\n endif\n else\n if(Rx .eq. Ry) then\n if(x + Rx-1-y .lt. Rx) then\n idx = Rx-1-y + (x+Rx-y)*(x+Rx-1-y)/2\n else\n idx = Rx*(Rx-1) + x - (Rx-x+y)*(Rx-x+y-1)/2\n endif\n elseif(Rx .lt. Ry) then\n if(x + Ry-1-y .lt. Rx) then \n idx = Ry-1-y + ((x+Ry-y)*(x+Ry-1-y)) / 2\n elseif(x + Ry-1-y .lt. Ry) then\n idx = ((1+Rx)*Rx)/2+Rx-x-1+Rx*(x+Ry-1-y-Rx)\n else\n idx = Rx*Ry-1-y-(((Rx+y-x)*(Rx+y-x-1))/2)\n endif\n else\n if(x + Ry-1-y .lt. Ry) then\n idx = x + (1+x+Ry-1-y)*(x+Ry-1-y)/2\n elseif(x + Ry-1-y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + y + Ry * (x-y-1)\n else\n idx = Rx*Ry-Rx+x-((Rx+y-x)*(Rx+y-x-1)/2)\n endif\n endif\n endif\n end subroutine\n"; -static const char *funcDvmhConvXYfortVerLong = " attributes(device) subroutine dvmh_convert_XY_llong(x,y,Rx,Ry,slash,idx)\n implicit none\n integer*8 ,value:: x\n integer*8 ,value:: y\n integer*8 ,value:: Rx\n integer*8 ,value:: Ry\n integer*8 ,value:: slash\n integer*8 ,device:: idx \n \n if(slash .eq. 0) then\n if(Rx .eq. Ry) then\n if(x + y .lt. Rx) then\n idx = y + (1+x+y)*(x+y)/2\n else\n idx = Rx*(Rx-1)+x-(2*Rx-x-y-1)*(2*Rx-x-y-2)/2\n endif \n elseif(Rx .lt. Ry) then\n if(x + y .lt. Rx) then\n idx = y + ((1+x+y)*(x+y)) / 2\n elseif(x + y .lt. Ry) then\n idx = ((1+Rx)*Rx) / 2 + Rx - x - 1 + Rx * (x+y-Rx)\n else\n idx = Rx*Ry-Ry+y-(((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2))/2)\n endif\n else\n if(x + y .lt. Ry) then\n idx = x + (1+x+y)*(x+y) / 2\n elseif(x + y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + (Ry-y-1) + Ry * (x+y-Ry)\n else\n idx = Rx*Ry-Rx+x-((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2)/2)\n endif\n endif\n else\n if(Rx .eq. Ry) then\n if(x + Rx-1-y .lt. Rx) then\n idx = Rx-1-y + (x+Rx-y)*(x+Rx-1-y)/2\n else\n idx = Rx*(Rx-1) + x - (Rx-x+y)*(Rx-x+y-1)/2\n endif\n elseif(Rx .lt. Ry) then\n if(x + Ry-1-y .lt. Rx) then \n idx = Ry-1-y + ((x+Ry-y)*(x+Ry-1-y)) / 2\n elseif(x + Ry-1-y .lt. Ry) then\n idx = ((1+Rx)*Rx)/2+Rx-x-1+Rx*(x+Ry-1-y-Rx)\n else\n idx = Rx*Ry-1-y-(((Rx+y-x)*(Rx+y-x-1))/2)\n endif\n else\n if(x + Ry-1-y .lt. Ry) then\n idx = x + (1+x+Ry-1-y)*(x+Ry-1-y)/2\n elseif(x + Ry-1-y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + y + Ry * (x-y-1)\n else\n idx = Rx*Ry-Rx+x-((Rx+y-x)*(Rx+y-x-1)/2)\n endif\n endif\n endif\n end subroutine\n" ; -static const char* fermiPreprocDir = "CUDA_FERMI_ARCH"; - -// local variables -SgStatement *kernelScope, *block; - -void InitializeAcrossACC() -{ - red_first = NULL; - createBodyKernel = false; - createConvert_XY = true; - ifReadLvlMode = false; - copyOfBody.clear(); - allRegNames.clear(); - allVariants.clear(); -} - -static inline int pow(int n) -{ - int tmp = 1; - tmp = tmp << n; - return tmp; -} - -static void setDvmDebugLvl() -{ - char *s = getenv("DVMH_LOGLEVEL"); - if (!ifReadLvlMode && s != NULL) - { - sscanf(s, "%d", &DVM_DEBUG_LVL); - ifReadLvlMode = true; - } -} - -static inline void mywarn(const char *str) -{ -#if debugMode - printf("%s\n", str); -#endif -} - -static char *getLoopLine(const char *sadapter) -{ - char *newLine = new char[strlen(sadapter) + 16]; - newLine[0] = '\0'; - strcat(newLine, "loop on line "); - int k = (int)strlen(newLine); - int i = (int)strlen(sadapter) - 1 - 6; - - for (; sadapter[i] != '_'; i--); - - for (i++; sadapter[i] != '_'; i++, k++) - { - newLine[k] = sadapter[i]; - } - newLine[k] = '\\'; - newLine[k + 1] = 'n'; - newLine[k + 2] = '\0'; - return newLine; -} - -// generating function call (specially for across): -//loop_cuda_register_red(DvmhLoopRef *InDvmhLoop, DvmType InRedNum, void **ArrayPtr, void **LocPtr) -static SgExpression *RegisterReduction_forAcross(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red, SgSymbol *s_loc) -{ - SgExpression *eloc; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RED_CUDA]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - - fe->addArg(*new SgVarRefExp(s_var_num)); - fe->addArg(*new SgCastExp(*C_PointerType(C_PointerType(SgTypeVoid())), SgAddrOp(*new SgVarRefExp(*s_red)))); - if (s_loc != NULL) - eloc = &(SgAddrOp(*new SgVarRefExp(*s_loc))); - else - eloc = new SgValueExp(0); - fe->addArg(*eloc); - - return fe; -} - -SgExpression *CreateBlocksThreadsSpec(SgSymbol *s_shared, SgSymbol *s_blocks, SgSymbol *s_threads, SgSymbol *s_stream) -{ - SgExprListExp *el, *ell, *elm; - SgExpression *mult; - el = new SgExprListExp(*new SgVarRefExp(s_blocks)); - ell = new SgExprListExp(*new SgVarRefExp(s_threads)); - el->setRhs(ell); - mult = new SgVarRefExp(s_shared); - elm = new SgExprListExp(*mult); - ell->setRhs(elm); - ell = new SgExprListExp(*new SgVarRefExp(s_stream)); - elm->setRhs(ell); - return ((SgExpression *)el); -} - -SgExpression* CreateBlocksThreadsSpec(int size, SgSymbol *s_blocks, SgSymbol *s_threads) -{ - SgExprListExp *el, *ell, *elm; - SgExpression *mult; - - el = new SgExprListExp(*new SgVarRefExp(s_blocks)); - ell = new SgExprListExp(*new SgVarRefExp(s_threads)); - el->setRhs(ell); - //size==0 - parallel loop without reduction clause - mult = size ? &((*ThreadsGridSize(s_threads)) * (*new SgValueExp(size))) : new SgValueExp(size); - elm = new SgExprListExp(*mult); - ell->setRhs(elm); - return((SgExpression *)el); -} - -SgExpression* CreateBlocksThreadsSpec(SgSymbol *s_blocks, SgSymbol *s_threads) -{ - SgExprListExp *el, *ell; - el = new SgExprListExp(*new SgVarRefExp(s_blocks)); - ell = new SgExprListExp(*new SgVarRefExp(s_threads)); - el->setRhs(ell); - return((SgExpression *)el); -} - -static void getDefaultCudaBlock(int &x, int &y, int &z, int loopDep, int loopIndep) -{ - if (options.isOn(AUTO_TFM)) - { - if (loopDep == 0) - { - if (loopIndep == 1) { x = 256; y = 1; z = 1; } - else if (loopIndep == 2) { x = 32; y = 14; z = 1; } - else { x = 32; y = 7; z = 2; } - } - else if (loopDep == 1) - { - if (loopIndep == 0) { x = 1; y = 1; z = 1; } - else if (loopIndep == 1) { x = 256; y = 1; z = 1; } - else if (loopIndep == 2) { x = 32; y = 5; z = 1; } - else { x = 16; y = 8; z = 2; } - } - else if (loopDep == 2) - { - if (loopIndep == 0) { x = 32; y = 1; z = 1; } - else if (loopIndep == 1) { x = 32; y = 4; z = 1; } - else { x = 16; y = 8; z = 2; } - } - else if (loopDep >= 3) - { - if (loopIndep == 0) { x = 32; y = 5; z = 1; } - else { x = 32; y = 5; z = 2; } - } - } - else - { - if (loopDep == 0) - { - if (loopIndep == 1) { x = 256; y = 1; z = 1; } - else if (loopIndep == 2) { x = 32; y = 14; z = 1; } - else { x = 32; y = 7; z = 2; } - } - else if (loopDep == 1) - { - if (loopIndep == 0) { x = 1; y = 1; z = 1; } - else if (loopIndep == 1) { x = 256; y = 1; z = 1; } - else if (loopIndep == 2) { x = 32; y = 8; z = 1; } - else { x = 16; y = 8; z = 2; } - } - else if (loopDep == 2) - { - if (loopIndep == 0) { x = 32; y = 1; z = 1; } - else if (loopIndep == 1) { x = 32; y = 4; z = 1; } - else { x = 16; y = 8; z = 2; } - } - else if (loopDep >= 3) - { - if (loopIndep == 0) { x = 8; y = 4; z = 1; } - else { x = 8; y = 4; z = 2; } - } - } -} - -static const char *getKeyWordType(SgType *inType) -{ - const char *ret = NULL; - - if (inType->baseType()->variant() == SgTypeFloat()->variant()) - ret = "float"; - else if (inType->baseType()->variant() == SgTypeDouble()->variant()) - ret = "double"; - else if (inType->baseType()->variant() == SgTypeInt()->variant()) - ret = "int"; - else if (inType->baseType()->variant() == SgTypeBool()->variant()) - ret = "bool"; - else if (inType->baseType()->variant() == SgTypeChar()->variant()) - ret = "char"; - else if (inType->baseType()->variant() == SgTypeVoid()->variant()) - ret = "void"; - return ret; -} - -static int getSizeOf() -{ - int ret = 1; - for (SgExpression *er = red_list; er; er = er->rhs()) - { - SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference - SgType *inType = red_expr_ref->type(); - SgExpression* len = inType->length(); - if (len && len->isInteger()) - { - ret = MAX(ret, len->valueInteger()); - continue; - } - - SgExpression* kind = inType->selector(); - if (kind && kind->lhs()) - { - SgExpression *kvalue = Calculate(kind->lhs()); - if (kvalue->isInteger()) - { - ret = MAX(ret, kvalue->valueInteger()); - continue; - } - } - - if (inType->variant() == SgTypeFloat()->variant()) - ret = MAX(ret, sizeof(float)); - else if (inType->variant() == SgTypeDouble()->variant()) - ret = MAX(ret, sizeof(double)); - else if (inType->variant() == SgTypeInt()->variant()) - ret = MAX(ret, sizeof(int)); - else if (inType->variant() == SgTypeBool()->variant()) - ret = MAX(ret, sizeof(bool)); - else if (inType->variant() == SgTypeChar()->variant()) - ret = MAX(ret, sizeof(char)); - } - return ret; -} - -static SgStatement *CreateKernelProcedureDevice(SgSymbol *skernel) -{ - SgStatement *st, *st_end; - SgExpression *e; - - st = new SgStatement(PROC_HEDR); - st->setSymbol(*skernel); - e = new SgExpression(ACC_ATTRIBUTES_OP, new SgExpression(ACC_DEVICE_OP), NULL, NULL); - //e ->setRhs(new SgExpression(ACC_GLOBAL_OP)); - st->setExpression(2, *e); - st_end = new SgStatement(CONTROL_END); - st_end->setSymbol(*skernel); - - cur_in_mod->insertStmtAfter(*st, *mod_gpu); - st->insertStmtAfter(*st_end, *st); - st->setVariant(PROS_HEDR); - - cur_in_mod = st_end; - - return st; -} - -static SgStatement* AssignStatement(SgExpression &lhs, SgExpression &rhs) -{ - SgStatement *st; - if (options.isOn(C_CUDA)) - st = new SgCExpStmt(SgAssignOp(lhs, rhs)); - else - st = new SgAssignStmt(lhs, rhs); - return st; -} - -static char* createName(const char* oldName, const char* variant) -{ - char* correctName = new char[strlen(oldName) + strlen(variant) + 1]; - correctName[0] = '\0'; - strcat(correctName, oldName); - strcat(correctName, variant); - - return correctName; -} - -static SgSymbol *createVariantOfSAdapter(SgSymbol *sadapter, const char *variant) -{ - SgSymbol *s_adapter; - const char *oldName = sadapter->identifier(); - s_adapter = new SgSymbol(FUNCTION_NAME, createName(oldName, variant), *C_VoidType(), *block_C); - - return s_adapter; -} - -static SgSymbol *createVariantOfKernelSymbol(SgSymbol *kernel_symb, const char *variant) -{ - SgSymbol *sk; - char *oldName = kernel_symb->identifier(); - sk = new SgSymbol(PROCEDURE_NAME, createName(oldName, variant), *mod_gpu); - if (options.isOn(C_CUDA)) - sk->setType(C_VoidType()); - return sk; -} - -static void createNewAdapter(SgSymbol *sadapter, ParamsForAllVariants &newVar, char *str) -{ - SgSymbol *s_adapter; - char *nameOfNewSAdapter; - - nameOfNewSAdapter = new char[strlen(sadapter->identifier()) + strlen(str) + 1]; - nameOfNewSAdapter[0] = '\0'; - strcat(nameOfNewSAdapter, sadapter->identifier()); - s_adapter = createVariantOfSAdapter(sadapter, str); - strcat(nameOfNewSAdapter, str); - newVar.nameOfNewSAdapter = nameOfNewSAdapter; - newVar.s_adapter = s_adapter; -} - -static void createNewKernel(SgSymbol *kernel_symb, ParamsForAllVariants &newVar, char *str) -{ - SgSymbol *s_ks; - char *nameOfNewSK; - - nameOfNewSK = new char[strlen(kernel_symb->identifier()) + strlen(str) + 1]; - nameOfNewSK[0] = '\0'; - strcat(nameOfNewSK, kernel_symb->identifier()); - s_ks = createVariantOfKernelSymbol(kernel_symb, str); - strcat(nameOfNewSK, str); - newVar.nameOfNewKernelSymb = nameOfNewSK; - newVar.s_kernel_symb = s_ks; -} - -static int countBit(int num) -{ - int ret = 0; - while (num != 0) - { - if ((num & 1) == 1) - ret++; - num = num >> 1; - } - return ret; -} - -static void generateAllBitmasks(int dep, int all, vector &out) -{ - if (dep == all) - out.push_back(pow(all) - 1); - else - { - int maxVar = pow(all); - for (int i = 1; i < maxVar; ++i) - { - if (countBit(i) == dep) - out.push_back(i); - } - } -} - -static void GetAllCombinations2(vector &allVariants, SgSymbol *sadapter, SgSymbol *kernel_symb, int numAcr, - const vector& allSymb) -{ - const unsigned sizeOfAllSymb = allSymb.size(); - - char *tmpstrAdapter = new char[16]; - char *tmpstrKernel = new char[16]; - tmpstrAdapter[0] = '\0'; - tmpstrKernel[0] = '\0'; - - ParamsForAllVariants newVar; - newVar.allDims = sizeOfAllSymb; - newVar.loopSymb.resize(numLoopVars); - newVar.loopAcrossSymb.resize(numLoopVars); - newVar.nameOfNewSAdapter = NULL; - newVar.s_adapter = NULL; - newVar.acrossV = numAcr; - newVar.loopV = newVar.allDims - newVar.acrossV; - newVar.type = (1 << numAcr) - 1; - - sprintf(tmpstrAdapter, "%d", newVar.type); - strcat(tmpstrAdapter, "_case"); - sprintf(tmpstrKernel, "_%d", newVar.type); - strcat(tmpstrKernel, "_case"); - - createNewAdapter(sadapter, newVar, tmpstrAdapter); - createNewKernel(kernel_symb, newVar, tmpstrKernel); - - int k = 0; - for (int r = 0; r < sizeOfAllSymb; ++r) - { - if (r < numAcr) - { - newVar.loopAcrossSymb[r].across_left = newVar.loopAcrossSymb[r].across_right = 0; - newVar.loopAcrossSymb[r].symb = allSymb[sizeOfAllSymb - r - 1].symb; - newVar.loopAcrossSymb[r].len = sizeOfAllSymb - r - 1; - } - else - { - newVar.loopSymb[k].across_left = newVar.loopSymb[k].across_right = 0; - newVar.loopSymb[k].symb = allSymb[sizeOfAllSymb - r - 1].symb; - newVar.loopSymb[k].len = sizeOfAllSymb - r - 1; - k++; - } - } - allVariants.push_back(newVar); -} - -static void GetAllVariants2(vector &allVariants, SgSymbol *sadapter, SgSymbol *kernel_symb) -{ - int acrossV = 0; - - SageAcrossInfo Info = GetLoopsWithParAndAcrDir(); - vector allSymb = GetSymbInParalell(dvm_parallel_dir->expr(2)); - const int allDims = allSymb.size(); - - for (int z = 0; z < Info.idxs.size() && (acrossV < allDims); ++z) - { - SageArrayIdxs& idxInfo = Info.idxs[z]; - for (int i = 0; i < idxInfo.dim && (acrossV < allDims); ++i) - if (idxInfo.symb[i].across_left != 0 || idxInfo.symb[i].across_right != 0) - acrossV++; - } - - // correct dependencies lvl only for ACROSS with one dep - SgStatement *st = loop_body; - - SgExpression* dvmDir = dvm_parallel_dir->expr(1); - vector allInfo; - bool nextStep = true; - loopVars.clear(); - - while (dvmDir) - { - SgExpression *t = dvmDir->lhs(); - if (t->variant() == ACROSS_OP) - { - vector toAnalyze; - SgExpression* list = t->lhs(); - while (list) - { - if (list->lhs()->variant() == ARRAY_REF) - toAnalyze.push_back(list->lhs()); - else if (list->lhs()->variant() == ARRAY_OP) - { - if (list->lhs()->lhs()->variant() == ARRAY_REF) - toAnalyze.push_back(list->lhs()->lhs()); - } - list = list->rhs(); - } - - for (int i = 0; i < toAnalyze.size(); ++i) - { - SgExpression* array = toAnalyze[i]; - - acrossInfo tmpI; - tmpI.nameOfArray = array->symbol()->identifier(); - tmpI.symbol = array->symbol(); - tmpI.allDim = 0; - tmpI.widthL = 0; - tmpI.widthR = 0; - tmpI.acrossPos = 0; - tmpI.acrossNum = 0; - - SgExpression* tt = array->lhs(); - int position = 0; - while (tt) - { - bool here = true; - if (tt->lhs()->lhs()->valueInteger() != 0) - { - tmpI.acrossPos = position; - tmpI.acrossNum++; - tmpI.widthL = (-1) * tt->lhs()->lhs()->valueInteger(); - here = false; - } - - if (tt->lhs()->rhs()->valueInteger() != 0) - { - tmpI.acrossPos = position; - if (here) - tmpI.acrossNum++; - tmpI.widthR = tt->lhs()->rhs()->valueInteger(); - } - position++; - tt = tt->rhs(); - } - - for (int i = 0; i < position; ++i) - { - tmpI.dims.push_back(0); - tmpI.symbs.push_back(NULL); - } - allInfo.push_back(tmpI); - } - break; - } - dvmDir = dvmDir->rhs(); - } - - for (size_t i = 0; i < allInfo.size(); ++i) - { - if (allInfo[i].acrossNum > 1) - { - nextStep = false; - break; - } - } - - if (nextStep) - { - SgExpression* dvmDir = dvm_parallel_dir->expr(2); - while (dvmDir) - { - loopVars.push_back(dvmDir->lhs()->symbol()); - dvmDir = dvmDir->rhs(); - } - - while (st) - { - for (int i = 0; i < 3; ++i) - if (st->expr(i)) - searchIdxs(allInfo, st->expr(i)); - st = st->lexNext(); - } - - for (size_t i = 0; i < allInfo.size(); ++i) - { - if (allInfo[i].symbs[allInfo[i].acrossPos] == NULL) - { - nextStep = false; - break; - } - } - - if (nextStep) - { - vector uniqSymbs; - - uniqSymbs.push_back(allInfo[0].symbs[allInfo[0].acrossPos]->identifier() ); - for (size_t i = 1; i < allInfo.size(); ++i) - { - bool uniq = true; - char *cmpd = allInfo[i].symbs[allInfo[i].acrossPos]->identifier(); - for (size_t k = 0; k < uniqSymbs.size(); ++k) - { - if (strcmp(uniqSymbs[k], cmpd) == 0) - { - uniq = false; - break; - } - } - if (uniq) - { - uniqSymbs.push_back(cmpd); - } - } - - acrossV = MIN((int)uniqSymbs.size(), allDims); - } - } - for (int i = 1; i <= acrossV; ++i) - GetAllCombinations2(allVariants, sadapter, kernel_symb, i, allSymb); -} - -/*void printAllVars(vector &vectorT) -{ - for (size_t i = 0; i < vectorT.size(); ++i) - { - printf("acrossV = %d loopV = %d alldims = %d\n", vectorT[i].acrossV, vectorT[i].loopV, vectorT[i].allDims); - printf("nameOfKernel = %s nameOfAdapt = %s \n", vectorT[i].nameOfNewKernelSymb, vectorT[i].nameOfNewSAdapter); - for (int k = 0; k < vectorT[i].loopV; ++k) - { - printf("%s, L = %d, R = %d, len= %d\n", vectorT[i].loopSymb[k]->symb->identifier(), vectorT[i].loopSymb[k]->across_left, vectorT[i].loopSymb[k]->across_right, vectorT[i].loopSymb[k]->len); - } - for (int k = 0; k < vectorT[i].acrossV; ++k) - { - printf("%s, L = %d, R = %d, len= %d\n", vectorT[i].loopAcrossSymb[k]->symb->identifier(), vectorT[i].loopAcrossSymb[k]->across_left, vectorT[i].loopAcrossSymb[k]->across_right, vectorT[i].loopAcrossSymb[k]->len); - } - printf("\n"); - } - printf("\n"); -}*/ - -ArgsForKernel *Create_C_Adapter_Function_Across(SgSymbol *sadapter) -{ - createBodyKernel = true; - - // clear information - allRegNames.clear(); - - SgStatement *st_hedr=NULL, *st_end, *first_exec, *stmt; - vector cuda_kernel; - SgExpression *fe, *ae, *el, *arg_list; - SgType *typ; - SgSymbol *s_loop_ref, *sarg, *s, *current_symbol; - symb_list *sl; - vector argsForVariantFunction; - - setDvmDebugLvl(); - - mywarn("start: getAllVars"); - allVariants.clear(); - - GetAllVariants2(allVariants, sadapter, kernel_symb); - mywarn(" end: getAllVars"); - - cuda_kernel.resize(countKernels); - current_symbol = SymbMapping(current_file->filept->cur_symb); //CUR_FILE_CUR_SYMB(); - - if (options.isOn(ONE_THREAD)) - { - const vector tmpStr = GetSymbInParalell(dvm_parallel_dir->expr(2)); - int num = tmpStr.size(); - - vector retValueForKernel = Create_C_Adapter_Function_Across_OneThread(sadapter, kernel_symb, num, 0); - - for (unsigned t = 0; t < countKernels; ++t) - { - loop_body = CopyOfBody.top(); - CopyOfBody.pop(); - - currentLoop = new Loop(loop_body, options.isOn(OPT_EXP_COMP)); - SgType *typeParams = indexTypeInKernel(rtTypes[t]); - - for (int i = 0; i < num; ++i) - { - char *str = new char[64]; - char *addL = new char[64]; - str[0] = addL[0] = '\0'; - retValueForKernel[t].otherVarsForOneTh.push_back(tmpStr[i].symb); - strcat(str, tmpStr[i].symb->identifier()); - strcat(str, "_"); - - strcat(addL, str); - strcat(addL, "low"); - retValueForKernel[t].otherVars.push_back(new SgSymbol(VARIABLE_NAME, addL, typeParams, kernel_symb->scope())); - - addL[0] = '\0'; - strcat(addL, str); - strcat(addL, "high"); - retValueForKernel[t].otherVars.push_back(new SgSymbol(VARIABLE_NAME, addL, typeParams, kernel_symb->scope())); - - addL[0] = '\0'; - strcat(addL, str); - strcat(addL, "idx"); - retValueForKernel[t].otherVars.push_back(new SgSymbol(VARIABLE_NAME, addL, typeParams, kernel_symb->scope())); - } - - string kernel_symbNew = kernel_symb->identifier(); - if (rtTypes[t] == rt_INT) - kernel_symbNew += "_int"; - else if (rtTypes[t] == rt_LONG) - kernel_symbNew += "_long"; - else if (rtTypes[t] == rt_LLONG) - kernel_symbNew += "_llong"; - - cuda_kernel[t] = CreateLoopKernelAcross(new SgSymbol(FUNCTION_NAME, kernel_symbNew.c_str(), *C_VoidType(), *block_C), &retValueForKernel[t], indexTypeInKernel(rtTypes[t])); - - if (options.isOn(RTC)) - { - acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); - if (options.isOn(C_CUDA)) - ACC_RTC_ConvertCudaKernel(cuda_kernel[t], kernel_symbNew.c_str()); - else - ACC_RTC_AddCalledProcedureComment(kernel_symb); - - RTC_FKernelArgs.push_back((SgFunctionCallExp*)cuda_kernel[t]->expr(0)); - } - - delete currentLoop; - currentLoop = NULL; - } - if (options.isOn(RTC)) - ACC_RTC_CompleteAllParams(); - } - else - { - mywarn("start: create all VARIANTS"); - // if only type ~ 1 across symb - bool ifOne = true; - for (size_t i = 0; i < allVariants.size(); ++i) - { - if (allVariants[i].acrossV != 1) - ifOne = false; - } - // set global if true - if (ifOne) - dontGenConvertXY = true; - else - dontGenConvertXY = false; - - for (size_t i = 0; i < allVariants.size(); ++i) - { -#if debugMode - printf("%d case\n", allVariants[i].type); -#endif - ParamsForAllVariants tmp = allVariants[i]; - vector retValueForKernel; - - for (unsigned k = 0; k < countKernels; ++k) - { - loop_body = CopyOfBody.top(); - CopyOfBody.pop(); - - // temporary check for ON mapping - const bool contitionOfOptimization = options.isOn(AUTO_TFM); - if (contitionOfOptimization) - currentLoop = new Loop(loop_body, true); - - string kernel_symb = tmp.s_kernel_symb->identifier(); - if (rtTypes[k] == rt_INT) - kernel_symb += "_int"; - else if (rtTypes[k] == rt_LONG) - kernel_symb += "_long"; - else if (rtTypes[k] == rt_LLONG) - kernel_symb += "_llong"; - - if (tmp.acrossV == 1 && tmp.type == 1) - { - if (k == 0) // create CUDA handler once - retValueForKernel = Create_C_Adapter_Function_Across_variants(tmp.s_adapter, tmp.s_kernel_symb, tmp.loopV, tmp.acrossV, tmp.allDims, tmp.loopSymb, tmp.loopAcrossSymb); - cuda_kernel[k] = CreateLoopKernelAcross(new SgSymbol(FUNCTION_NAME, kernel_symb.c_str(), *C_VoidType(), *block_C), &retValueForKernel[k], tmp.acrossV, indexTypeInKernel(rtTypes[k])); - if (options.isOn(RTC)) - acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); - } - else if (tmp.acrossV != 1 && (tmp.type == 3 || tmp.type == 7 || tmp.type > 14)) - { - // optimized loop body - if (options.isOn(GPU_O1)) - analyzeLoopBody(ACROSS_TYPE); - - if (k == 0) // create CUDA handler once - retValueForKernel = Create_C_Adapter_Function_Across_variants(tmp.s_adapter, tmp.s_kernel_symb, tmp.loopV, tmp.acrossV, tmp.allDims, tmp.loopSymb, tmp.loopAcrossSymb); - cuda_kernel[k] = CreateLoopKernelAcross(new SgSymbol(FUNCTION_NAME, kernel_symb.c_str(), *C_VoidType(), *block_C), &retValueForKernel[k], tmp.acrossV, indexTypeInKernel(rtTypes[k])); - if (options.isOn(RTC)) - { - acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); - if (!options.isOn(C_CUDA) && options.isOn(AUTO_TFM)) - { - if (strstr(kernel_symb.c_str(), "_llong") != NULL) - acc_call_list = AddNewToSymbList(acc_call_list, createNewFunctionSymbol("dvmh_convert_XY_llong")); - else if (strstr(kernel_symb.c_str(), "_int") != NULL) - acc_call_list = AddNewToSymbList(acc_call_list, createNewFunctionSymbol("dvmh_convert_XY_int")); - } - } - } - - if (newVars.size() != 0) - { - correctPrivateList(RESTORE); - newVars.clear(); - } - if (contitionOfOptimization) - { - delete currentLoop; - currentLoop = NULL; - } - } - if (options.isOn(RTC)) - { - for (unsigned diff = 0; diff < RTC_FCall.size() / countKernels; ++diff) - { - for (unsigned k = 0; k < countKernels; ++k) - RTC_FKernelArgs.push_back((SgFunctionCallExp*)cuda_kernel[k]->expr(0)); - } - - for (unsigned k = 0; k < countKernels; ++k) - { - string kernel_symb = tmp.s_kernel_symb->identifier(); - if (rtTypes[k] == rt_INT) - kernel_symb += "_int"; - else if (rtTypes[k] == rt_LONG) - kernel_symb += "_long"; - else if (rtTypes[k] == rt_LLONG) - kernel_symb += "_llong"; - - if (options.isOn(C_CUDA)) - ACC_RTC_ConvertCudaKernel(cuda_kernel[k], kernel_symb.c_str()); - else - ACC_RTC_AddCalledProcedureComment(new SgSymbol(VARIABLE_NAME, kernel_symb.c_str())); - } - - ACC_RTC_CompleteAllParams(); - } - } - - - mywarn(" end: create all VARIANTS"); - - //create new control function - st_hedr = Create_C_Function(sadapter); - st_end = st_hedr->lexNext(); - fe = st_hedr->expr(0); - st_hedr->addComment(Cuda_LoopHandlerComment()); - first_exec = st_end; - mywarn("start: create dummy argument list "); - - // create dummy argument list: loop_ref, , , - typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); - argsForVariantFunction.push_back(s_loop_ref); - - ae = new SgVarRefExp(s_loop_ref); //loop_ref - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fe->setLhs(arg_list); - - for (sl = acc_array_list; sl; sl = sl->next) // - { - SgArrayType *typearray = new SgArrayType(*C_DvmType()); - typearray->addDimension(NULL); - sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); - argsForVariantFunction.push_back(sarg); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - - for (el = uses_list; el; el = el->rhs()) // - { - s = el->lhs()->symbol(); - typ = C_PointerType(C_Type(s->type())); - sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); - argsForVariantFunction.push_back(sarg); - if (isByValue(s)) - SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; - ae = UsedValueRef(s, sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - - if (options.isOn(C_CUDA)) // - { - int idim; - SgExpression *elp; - SgType *t = C_PointerType(C_DvmType()); - - for (elp=private_list; elp; elp = elp->rhs()) - { - s = elp->lhs()->symbol(); - if (IS_ARRAY(s) && !TestArrayShape(s)) - { - el = NULL; - for (idim = 1; idim<=Rank(s); idim++) - { - sarg = new SgSymbol(VARIABLE_NAME, DimSizeName(s, idim), *t, *st_hedr); - argsForVariantFunction.push_back(sarg); - ae = new SgVarRefExp(sarg); - ae->setType(t); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - } - el = NULL; - for (idim = 1; idim<=Rank(s); idim++) - { - sarg = new SgSymbol(VARIABLE_NAME, BoundName(s, idim, 1), *t, *st_hedr); - argsForVariantFunction.push_back(sarg); - ae = new SgVarRefExp(sarg); - ae->setType(t); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - } - - } - } - - mywarn(" end: create dummy argument list "); - - mywarn("start: create IF BLOCK "); - SgSymbol *which_run = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("which_run"), *C_Type(SgTypeInt()), *st_hedr); - stmt = makeSymbolDeclaration(which_run); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(which_run), *GetDependencyMask(s_loop_ref))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - char *str = new char[64]; - str[0] = '\0'; - - strcat(str, "which_run in "); - strncat(str, sadapter->identifier(), strlen(sadapter->identifier()) - 6); - strcat(str, " is %d\\n"); - SgFunctionCallExp *tmpF2 = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); - tmpF2->addArg(*new SgValueExp(str)); - tmpF2->addArg(*new SgVarRefExp(which_run)); - if (DVM_DEBUG_LVL > 5) - st_end->insertStmtBefore(*new SgCExpStmt(*tmpF2), *st_hedr); - - SgSymbol *s_cudaEvent = new SgSymbol(TYPE_NAME, "cudaEvent_t", *block_C); - SgSymbol *cudaEventStart = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("start"), *C_Derived_Type(s_cudaEvent), *st_hedr); - SgSymbol *cudaEventStop = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("stop"), *C_Derived_Type(s_cudaEvent), *st_hedr); - SgSymbol *gpuTime = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("gpuTime"), *SgTypeFloat(), *st_hedr); - SgSymbol *minGpuTime = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("minGpuTime"), *SgTypeFloat(), *st_hedr); - SgSymbol *s_i = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_i"), *C_Type(SgTypeInt()), *st_hedr); - SgSymbol *s_k = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_k"), *C_Type(SgTypeInt()), *st_hedr); - SgSymbol *min_s_i = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("min_s_i"), *C_Type(SgTypeInt()), *st_hedr); - SgSymbol *min_s_k = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("min_s_k"), *C_Type(SgTypeInt()), *st_hedr); - SgSymbol *max_cuda_block = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__max_cuda_block"), *C_Type(SgTypeInt()), *st_hedr); - SgWhileStmt *whileSt = NULL; - SgWhileStmt *whileSt1 = NULL; - - SgIfStmt *if_st; - vector > allVarForIfBlock; - vector allFuncCalls; - - for (size_t k = 0; k < allVariants.size(); ++k) - { - SgFunctionCallExp *funcCall; - - if ((size_t)allVariants[k].acrossV > allVarForIfBlock.size() && - (allVariants[k].type == 1 || allVariants[k].type == 3 || allVariants[k].type == 7 || allVariants[k].type > 14)) - { - vector tmp; - generateAllBitmasks(allVariants[k].acrossV, allVariants[k].allDims, tmp); - allVarForIfBlock.push_back(tmp); - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol(allVariants[k].nameOfNewSAdapter)); - for (size_t i = 0; i < argsForVariantFunction.size(); ++i) - funcCall->addArg(*new SgVarRefExp(argsForVariantFunction[i])); - funcCall->addArg(*new SgVarRefExp(which_run)); - allFuncCalls.push_back(funcCall); - } - } - - if (options.isOn(SPEED_TEST_L0)) - { - stmt = makeSymbolDeclarationWithInit(s_i, new SgValueExp(16)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclarationWithInit(s_k, new SgValueExp(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclaration(min_s_i); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclaration(min_s_k); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclaration(max_cuda_block); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclarationWithInit(minGpuTime, new SgValueExp(99999)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclaration(gpuTime); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclaration(cudaEventStart); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stmt = makeSymbolDeclaration(cudaEventStop); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - SgFunctionCallExp *eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventCreate")); - eventF->addArg(SgAddrOp(*new SgVarRefExp(cudaEventStart))); - st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); - - eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventCreate")); - eventF->addArg(SgAddrOp(*new SgVarRefExp(cudaEventStop))); - st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); - - SgFunctionCallExp *tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); - tmpF->addArg(*new SgValueExp(getLoopLine(sadapter->identifier()))); - st_end->insertStmtBefore(*new SgCExpStmt(*tmpF), *st_hedr); - - - tmpF2 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); - tmpF2->addArg(*new SgVarRefExp(allRegNames[0])); - if (allRegNames.size() == 1) - tmpF2->addArg(*new SgVarRefExp(allRegNames[0])); - else - tmpF2->addArg(*new SgVarRefExp(allRegNames[1])); - - for (size_t i = 2; i < allRegNames.size(); ++i) - { - SgFunctionCallExp *tmpF1 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); - tmpF1->addArg(*tmpF2); - tmpF1->addArg(*new SgVarRefExp(allRegNames[i])); - tmpF2 = tmpF1; - } - - tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); - tmpF->addArg(*new SgValueExp(384)); - tmpF->addArg(*new SgValueExp(65535) / *tmpF2); - - tmpF2 = tmpF; - st_end->insertStmtBefore(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(max_cuda_block), *tmpF2)), *st_hedr); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_i), *new SgVarRefExp(s_i) + *new SgValueExp(16))); - whileSt = new SgWhileStmt(*new SgVarRefExp(s_i) < *new SgValueExp(257), *stmt); - st_hedr->lastExecutable()->insertStmtAfter(*whileSt, *st_hedr); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_k), *new SgVarRefExp(s_k) + *new SgValueExp(1))); - whileSt1 = new SgWhileStmt(*new SgVarRefExp(s_k) < *new SgValueExp(17), *stmt); - whileSt->insertStmtAfter(*whileSt1); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_k), *new SgValueExp(1))); - whileSt->insertStmtAfter(*stmt); - } - - for (size_t i = 0; i < allVarForIfBlock.size(); ++i) - { - SgExpression *e = NULL; - for (size_t k = 0; k < allVarForIfBlock[i].size(); ++k) - { - if (k == 0) - e = &(SgEqOp(*new SgVarRefExp(which_run), *new SgValueExp(allVarForIfBlock[i][k]))); - else - e = &(*e || SgEqOp(*new SgVarRefExp(which_run), *new SgValueExp(allVarForIfBlock[i][k]))); - } - if (options.isOn(SPEED_TEST_L0)) - { - allFuncCalls[i]->addArg(*new SgVarRefExp(s_i)); - allFuncCalls[i]->addArg(*new SgVarRefExp(s_k)); - } - stmt = new SgCExpStmt(*allFuncCalls[i]); - if_st = new SgIfStmt(*e, *stmt); - if (!options.isOn(SPEED_TEST_L0)) - st_end->insertStmtBefore(*if_st, *st_hedr); - else - { - whileSt1->lastExecutable()->insertStmtBefore(*if_st); - } - } - - tmpF2 = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); - tmpF2->addArg(*new SgValueExp("It may be wrong!!\\n")); - - if (DVM_DEBUG_LVL > 5) - { - if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(which_run), *new SgValueExp(0)), *new SgCExpStmt(*tmpF2)); - st_end->insertStmtBefore(*if_st, *st_hedr); - } - - if (options.isOn(SPEED_TEST_L0)) - { - SgFunctionCallExp *tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventRecord")); - tmpF->addArg(*new SgVarRefExp(cudaEventStart)); - tmpF->addArg(*new SgValueExp(0)); - whileSt1->insertStmtAfter(*new SgCExpStmt(*tmpF)); - - tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventRecord")); - tmpF->addArg(*new SgVarRefExp(cudaEventStop)); - tmpF->addArg(*new SgValueExp(0)); - whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); - - tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventSynchronize")); - tmpF->addArg(*new SgVarRefExp(cudaEventStop)); - whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); - - tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventElapsedTime")); - tmpF->addArg(SgAddrOp(*new SgVarRefExp(gpuTime))); - tmpF->addArg(*new SgVarRefExp(cudaEventStart)); - tmpF->addArg(*new SgVarRefExp(cudaEventStop)); - whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(min_s_i), *new SgVarRefExp(s_i))); - if_st = new SgIfStmt(*new SgVarRefExp(gpuTime) < *new SgVarRefExp(minGpuTime), *stmt); - whileSt1->lastExecutable()->insertStmtBefore(*if_st); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(min_s_k), *new SgVarRefExp(s_k))); - if_st->insertStmtAfter(*stmt); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(minGpuTime), *new SgVarRefExp(gpuTime))); - if_st->insertStmtAfter(*stmt); - - if (options.isOn(SPEED_TEST_L1)) - { - tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); - tmpF->addArg(*new SgValueExp(" cuda-block [%d, %d] with time - %f ms\\n")); - tmpF->addArg(*new SgVarRefExp(s_i)); - tmpF->addArg(*new SgVarRefExp(s_k)); - tmpF->addArg(*new SgVarRefExp(gpuTime)); - whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); - } - - tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); - tmpF->addArg(*new SgValueExp(" minimum time = %f ms, optimal cuda-block = [%d, %d]\\n\\n")); - tmpF->addArg(*new SgVarRefExp(minGpuTime)); - tmpF->addArg(*new SgVarRefExp(min_s_i)); - tmpF->addArg(*new SgVarRefExp(min_s_k)); - st_end->insertStmtBefore(*new SgCExpStmt(*tmpF), *st_hedr); - - SgFunctionCallExp *eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventDestroy")); - eventF->addArg(*new SgVarRefExp(cudaEventStart)); - st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); - - eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventDestroy")); - eventF->addArg(*new SgVarRefExp(cudaEventStop)); - st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_k), *new SgVarRefExp(s_k) + *new SgValueExp(1))); - SgContinueStmt *contST = new SgContinueStmt(); - - if_st = new SgIfStmt(*new SgVarRefExp(s_k) * *new SgVarRefExp(s_i) > *new SgVarRefExp(max_cuda_block), *contST); - whileSt1->insertStmtAfter(*if_st); - if_st->insertStmtAfter(*stmt); - } - - mywarn(" end: create IF BLOCK "); - } - - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(st_hedr, s_loop_ref, 0); //(st_hedr, current_symbol->next(), 0); - - return NULL; -} - -vector Create_C_Adapter_Function_Across_OneThread(SgSymbol *sadapter, SgSymbol *kernel_symb, const int loopV, const int acrossV) -{ -#if debugMode - warn("PARALLEL directive with ACROSS clause in region", 420, dvm_parallel_dir); -#endif - - SgSymbol **reduction_ptr; - SgSymbol *lowI, *highI, *idxI; - symb_list *sl; - SgStatement *st_hedr, *st_end, *stmt, *first_exec, *stmt_save; - SgExpression *fe, *ae, *arg_list, *el, *e, *espec, *er, *e_all_private_size = NULL; - SgSymbol *s_loop_ref, *sarg, *s, *sb, *sg, *sdev, *h_first, *hgpu_first, *base_first, *uses_first, *scalar_first, *private_first=NULL; - SgSymbol *s_blocks, *s_threads, *s_dev_num, *s_tmp_var, *idxTypeInKernel; - SgType *typ; - SgFunctionCallExp *funcCall; - vector dvm_array_headers; - int ln, num, uses_num, has_red_array, use_device_num, num_of_red_arrays = 0, nbuf = 0, lnp = 0; - - // init block - reduction_ptr = NULL; - lowI = highI = idxI = h_first = hgpu_first = base_first = red_first = uses_first = scalar_first = NULL; - s_loop_ref = sarg = s = sb = sg = sdev = h_first = s_blocks = s_threads = s_dev_num = s_tmp_var = NULL; - sl = NULL; - typ = NULL; - funcCall = NULL; - st_hedr = st_end = stmt = first_exec = NULL; - fe = ae = arg_list = el = e = espec = er = NULL; - ln = num = uses_num = has_red_array = use_device_num = num_of_red_arrays = 0; - // end of init block - - mywarn("start: create fuction header "); - // create fuction header - st_hedr = Create_C_Function(sadapter); - st_hedr->addComment(Cuda_LoopHandlerComment()); - st_end = st_hedr->lexNext(); - fe = st_hedr->expr(0); - - first_exec = st_end; - - mywarn(" end: create fuction header "); - mywarn("start: create dummy argument list "); - - // create dummy argument list: loop_ref, , - typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); - - ae = new SgVarRefExp(s_loop_ref); //loop_ref - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fe->setLhs(arg_list); - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) // - { - SgArrayType *typearray = new SgArrayType(*C_DvmType()); - typearray->addDimension(NULL); - sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); - dvm_array_headers.push_back(sl->symb->identifier()); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - nbuf++; - } - - for (el = uses_list, ln = 0; el; el = el->rhs(), ++ln) // - { - s = el->lhs()->symbol(); - typ = C_PointerType(C_Type(s->type())); - sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); - if (isByValue(s)) - SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; - ae = UsedValueRef(s, sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - uses_first = sarg; - } - uses_num = ln; - - if (options.isOn(C_CUDA)) // - { - int idim; - SgExpression *elp; - SgType *t = C_PointerType(C_DvmType()); - - for (elp=private_list; elp; elp = elp->rhs()) - { - s = elp->lhs()->symbol(); - if (IS_ARRAY(s) && !TestArrayShape(s)) - { - el = NULL; - for (idim = Rank(s); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, DimSizeName(s, idim), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - arg_list = AddListToList(arg_list, &el->copy()); - if (!elp->lhs()->attributeValue(0, DIM_SIZES)) - { - SgExpression **edim = new (SgExpression *); - *edim = el; - elp->lhs()->addAttribute(DIM_SIZES, (void *)edim, sizeof(SgExpression *) ); - } - - el = NULL; - for (idim = Rank(s); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, BoundName(s, idim, 1), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - arg_list = AddListToList(arg_list, &el->copy()); - if (!elp->lhs()->attributeValue(0, L_BOUNDS)) - { - SgExpression **elb = new (SgExpression *); - *elb = el; - elp->lhs()->addAttribute(L_BOUNDS, (void *)elb, sizeof(SgExpression *) ); - } - - while (arg_list->rhs() != 0) - arg_list = arg_list->rhs(); - } - - } - } - - mywarn(" end: create dummy argument list "); - // create variable's declarations: ,,,,,blocks_info [ or blocksS,idxL,idxH ],stream,blocks,threads - if (red_list) // reduction section - { - mywarn("start: in reduction section "); - - s_tmp_var = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("tmpVar"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - //looking through the reduction_op_list - for (er = red_list; er; er = er->rhs()) - num_of_red_arrays++; - - reduction_ptr = new SgSymbol*[num_of_red_arrays]; - - for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) - { - SgExpression *ered, *ev, *en, *loc_var_ref; - SgSymbol *sred, *s_loc_var, *sgrid_loc; - int is_array; - SgType *loc_type = NULL, *btype = NULL; - - loc_var_ref = NULL; - s_loc_var = NULL; - is_array = 0; - ered = er->lhs(); // reduction (variant==ARRAY_OP) - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - if (isSgExprListExp(ev)) - { - ev = ev->lhs(); // reduction variable reference - loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference - en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array - loc_el_num = LocElemNumber(en); - loc_type = loc_var_ref->symbol()->type(); - } - else if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array - is_array = 1; - - s = sred = &(ev->symbol()->copy()); - SYMB_SCOPE(s->thesymb) = st_hedr->thebif; - if (is_array) - { - SgArrayType *typearray = new SgArrayType(*C_Type(ev->symbol()->type())); - typearray->addRange(*ArrayLengthInElems(ev->symbol(), NULL, 0)); - s->setType(*typearray); - } - else - s->setType(C_Type(ev->symbol()->type())); - - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - if (!ln) - red_first = s; - - s_loc_var = sgrid_loc = NULL; - if (loc_var_ref) - { - s = s_loc_var = &(loc_var_ref->symbol()->copy()); - if (isSgArrayType(loc_type)) - btype = loc_type->baseType(); - else - btype = loc_type; - - SgArrayType *typearray = new SgArrayType(*C_Type(btype)); - typearray->addRange(*new SgValueExp(loc_el_num)); - s_loc_var->setType(*typearray); - SYMB_SCOPE(s->thesymb) = st_hedr->thebif; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s = sgrid_loc = GridSymbolForRedInAdapter(s, st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - /*--- executable statements: register reductions in RTS ---*/ - e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (!ln) - { - stmt->addComment("// Register reduction for CUDA-execution"); - first_exec = stmt; - } - stmt = new SgCExpStmt(*InitReduction(s_loop_ref, s_tmp_var, sred, s_loc_var)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) - { - char *buf_tmp = new char[8]; - sprintf(buf_tmp, "%d", ln); - reduction_ptr[ln] = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "cuda_ptr_"), buf_tmp)), *C_PointerType(C_Type(er->lhs()->rhs()->symbol()->type())), *st_hedr); - st_hedr->insertStmtAfter(*makeSymbolDeclaration(reduction_ptr[ln]), *st_hedr); - delete[]buf_tmp; - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("cudaMalloc")); - funcCall->addArg(*new SgCastExp(*C_PointerType(C_PointerType(SgTypeVoid())), SgAddrOp(*new SgVarRefExp(reduction_ptr[ln])))); - funcCall->addArg(SgSizeOfOp(*new SgKeywordValExp(getKeyWordType(reduction_ptr[ln]->type())))); - stmt = new SgCExpStmt(*funcCall); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - mywarn(" end: out reduction section "); - } - - mywarn("start: create vars "); - - // create type for static arrays - SgArrayType *tpArr = new SgArrayType(*LongT); - SgValueExp *dimSize = new SgValueExp(loopV + acrossV + 2); - tpArr->addDimension(dimSize); - - lowI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("lowI"), *LongT, *st_hedr); - s->setType(tpArr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - highI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("highI"), *LongT, *st_hedr); - s->setType(tpArr); - addDeclExpList(s, stmt->expr(0)); - - idxI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxI"), *LongT, *st_hedr); - s->setType(tpArr); - addDeclExpList(s, stmt->expr(0)); - - idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - mywarn(" end: create vars "); - mywarn("start: create assigns"); - - s_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("blocks"), *t_dim3, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_threads = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("threads"), *t_dim3, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device - if (!ln) - { - scalar_first = sdev; - stmt = makeSymbolDeclaration(sdev); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(sdev, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) - { - s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - hgpu_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) - { - s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - base_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - num = ln; - - - /* -------- call dvmh_get_device_addr(long *deviceRef, void *variable) ----*/ - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Get device addresses"); - sdev = sdev->next(); - } - - /* -------- call dvmh_get_natural_base(long *deviceRef, long dvmDesc[] ) ----*/ - - for (sl = acc_array_list, s = h_first, sb = base_first, ln = 0; ln < num; sl = sl->next, s = s->next(), sb = sb->next(), ln++) - { - s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - SgStatement *cur = stmt; - st_end->insertStmtBefore(*stmt, *st_hedr); - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - { - e = LoopGetRemoteBuf(s_loop_ref, nbuf--, s); - stmt = new SgCExpStmt(*e); - cur->insertStmtBefore(*stmt, *st_hedr); - } - if (!ln) - stmt->addComment("// Get natural bases"); - } - /* -------- call dvmh_fill_header_(long *deviceRef, void *base, long dvmDesc[], long dvmhDesc[]);----*/ - - for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) - { - e = FillHeader(s_dev_num, sb, s, sg); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Fill device headers"); - } - - /* -------- call loop_fill_bounds_(loop_ref, lowI, highI, idxI); ----*/ - - stmt = new SgCExpStmt(*FillBounds(s_loop_ref, lowI, highI, idxI)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Get bounds"); - mywarn(" end: create assigns"); - stmt_save = stmt; - - stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks, "x"), *new SgValueExp(1))); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Start counting"); - SgStatement *st_where = stmt; - - stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_threads, "x"), *new SgValueExp(1))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (options.isOn(RTC)) - { - /* -------- call loop_cuda_rtc_set_lang_(loop_ref, lang); ------------*/ - if (options.isOn(C_CUDA)) - stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 1)); - else - stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 0)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Set CUDA language for launching kernels in RTC"); - } - - /* -------- call loop_guess_index_type_(loop_ref); ------------*/ - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *GuessIndexType(s_loop_ref))); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Guess index type in CUDA kernel"); - - - SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - - sizeofL->addArg(*new SgKeywordValExp("long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); - sizeofLL->addArg(*new SgKeywordValExp("long long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); - sizeofI->addArg(*new SgKeywordValExp("int")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofI), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofLL), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - /* args for kernel */ - { - espec = CreateBlocksThreadsSpec(s_blocks, s_threads); - funcCall = CallKernel(kernel_symb, espec); - - for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) - { - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); - funcCall->addArg(*e); - for (int i = NumberOfCoeffs(sg); i>0; i--) - funcCall->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); - } - - if (red_list) - { - reduction_operation_list *rsl; - int i = 0; - for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next, ++i) //s!=s_blocks_info - { - if (rsl->redvar_size == 0) //reduction variable is scalar - { - if (options.isOn(RTC)) - { - SgVarRefExp *toAdd = new SgVarRefExp(s); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCall->addArg(*toAdd); - } - else - funcCall->addArg(*new SgVarRefExp(s)); - } - else - { - int i; - has_red_array = 1; - for (i = 0; i < rsl->redvar_size; i++) - funcCall->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); - } - s = s->next(); - - if (options.isOn(C_CUDA)) - funcCall->addArg(*new SgVarRefExp(reduction_ptr[i])); - else - funcCall->addArg(*new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(reduction_ptr[i]))); - } - } - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - { - if (s->attributes() & USE_IN_BIT) - funcCall->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel - else - { // passing argument by reference to kernel - SgType *tp = NULL; - if (s->type()->hasBaseType()) - tp = s->type()->baseType(); - else - tp = s->type(); - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); - funcCall->addArg(*e); - sdev = sdev->next(); - } - } - - e_all_private_size = sizeOfPrivateArraysInBytes(); - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - { - for (el=private_list, lnp=0; el; el=el->rhs()) - { - s = el->lhs()->symbol(); - if (IS_ARRAY(s)) - { - sarg = new SgSymbol(VARIABLE_NAME, PointerNameForPrivateArray(s), *C_PointerType(C_VoidType()), *st_hedr); - ae = new SgCastExp(*C_PointerType( C_Type(s->type()->baseType())), *new SgVarRefExp(sarg)); - funcCall->addArg(*ae); - if (!lnp) - private_first = sarg; - lnp++; - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela; ela = ela->rhs()) - funcCall->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - eatr = (SgExpression **) el->lhs()->attributeValue(0, L_BOUNDS); - for (ela = *eatr; ela; ela = ela->rhs()) - funcCall->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - } - - } - } - } - - for (int i = 0; i < acrossV + loopV; ++i) - { - funcCall->addArg(*new SgArrayRefExp(*lowI, *new SgValueExp(i))); - funcCall->addArg(*new SgArrayRefExp(*highI, *new SgValueExp(i))); - funcCall->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(i))); - } - } - - stmt = createKernelCallsInCudaHandler(funcCall, s_loop_ref, idxTypeInKernel, s_blocks); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (red_list) - { - ln = 0; - for (er = red_list, s = red_first; er; er = er->rhs(), ++ln, s=s->next()) - { - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("cudaMemcpy")); - funcCall->addArg(SgAddrOp(*new SgVarRefExp(&(er->lhs()->rhs()->symbol()->copy())))); - funcCall->addArg(*new SgVarRefExp(reduction_ptr[ln])); - funcCall->addArg(SgSizeOfOp(*new SgKeywordValExp(getKeyWordType(reduction_ptr[ln]->type())))); - funcCall->addArg(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "cudaMemcpyDeviceToHost"))); - stmt = new SgCExpStmt(*funcCall); - st_end->insertStmtBefore(*stmt, *st_hedr); - - e = &SgAssignOp(*new SgVarRefExp(*s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(*RedPost(s_loop_ref, s_tmp_var, s, NULL)); // loop_red_post_ - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - ln = 0; - for (er = red_list; er; er = er->rhs(), ++ln) - { - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("cudaFree")); - funcCall->addArg(*new SgVarRefExp(reduction_ptr[ln])); - stmt = new SgCExpStmt(*funcCall); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (ln == 0) - stmt->addComment("// Free temporary variables"); - } - } - // insert code for big private arrays - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - { - GetMemoryForPrivateArrays(private_first, s_loop_ref, lnp, st_where, st_hedr, new SgValueExp(1)); - - // to dispose private arrays - for (s = private_first, ln = 0; ln < lnp; s = s->next(), ln++) // private arrays - { - stmt = new SgCExpStmt(*DisposePrivateArray(s_loop_ref, s)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - // create args for kernel and return it - vector argsKernel(countKernels); - for (unsigned i = 0; i < countKernels; ++i) - argsKernel[i].st_header = st_hedr; - - delete[]reduction_ptr; - mywarn(" end Adapter Function"); - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(st_hedr, s_loop_ref, 0); - - return argsKernel; -} - -static inline void insertReductionArgs(SgSymbol **reduction_ptr, SgSymbol **reduction_loc_ptr, - SgSymbol **reduction_symb, SgSymbol **reduction_loc_symb, - SgFunctionCallExp *funcCallKernel, SgSymbol* numBlocks, int &has_red_array) -{ - reduction_operation_list *rsl; - SgSymbol *s = NULL; - SgExpression *e = NULL; - - for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next) //s!=s_blocks_info - { - if (rsl->redvar_size > 0) - { - funcCallKernel->addArg(*new SgVarRefExp(*numBlocks)); - break; - } - } - - int i = 0; - for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next, ++i) //s!=s_blocks_info - { - if (rsl->redvar_size == 0) //reduction variable is scalar - { - if (options.isOn(RTC)) - { - SgVarRefExp *toAdd = new SgVarRefExp(reduction_symb[i]); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - } - else - funcCallKernel->addArg(*new SgVarRefExp(reduction_symb[i])); - } - else //TODO!! - { - has_red_array = 1; - for (int k = 0; k < rsl->redvar_size; ++k) - funcCallKernel->addArg(*new SgArrayRefExp(*reduction_symb[i], *new SgValueExp(k))); - } - - if (options.isOn(C_CUDA)) - funcCallKernel->addArg(*new SgVarRefExp(reduction_ptr[i])); - else - funcCallKernel->addArg(*new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(reduction_ptr[i]))); - - if (rsl->locvar) //MAXLOC,MINLOC - { - for (int k = 0; k < rsl->number; ++k) - funcCallKernel->addArg(*new SgArrayRefExp(*reduction_loc_symb[i], *new SgValueExp(k))); - s = s->next(); - - if (options.isOn(C_CUDA)) - e = new SgCastExp(*C_PointerType(C_Type(rsl->locvar->type())), *new SgVarRefExp(reduction_loc_ptr[i])); - else - e = new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s));// TODO it like in C_Cuda - funcCallKernel->addArg(*e); - s = s->next(); - } - } -} - -static void createPrivatePointers(SgSymbol* &private_first, int &lnp, SgStatement* st_hedr, SgExpression* &e_all_private_size) -{ - private_first = NULL; - e_all_private_size = sizeOfPrivateArraysInBytes(); - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - { - SgExpression *el, *ae; - SgSymbol *sarg; - - for (el=private_list, lnp=0; el; el=el->rhs()) - { - SgSymbol *s = el->lhs()->symbol(); - if (IS_ARRAY(s)) - { - sarg = new SgSymbol(VARIABLE_NAME, PointerNameForPrivateArray(s), *C_PointerType(C_VoidType()), *st_hedr); - if (!lnp) - private_first = sarg; - lnp++; - } - } - } -} - -static void createArgsForKernelForTwoDeps(SgFunctionCallExp*& funcCallKernel, SgSymbol* kernel_symb, SgExpression* espec, SgSymbol*& sg, SgSymbol* hgpu_first, - SgSymbol*& sb, SgSymbol* base_first, symb_list*& sl, int& ln, int num, SgExpression*& e, SgSymbol** reduction_ptr, - SgSymbol** reduction_loc_ptr, SgSymbol** reduction_symb, SgSymbol** reduction_loc_symb, SgSymbol* red_blocks, int& has_red_array, - SgSymbol* diag, const int& loopV, SgSymbol** num_elems, const int& acrossV, SgSymbol* acrossBase[16], SgSymbol* loopBase[16], - SgSymbol* idxI, const vector& loopAcrossSymb, const vector& loopSymb, SgSymbol*& s, SgSymbol* uses_first, - SgSymbol*& sdev, SgSymbol* scalar_first, int uses_num, vector& dvm_array_headers, - SgSymbol** addressingParams, SgSymbol** outTypeOfTransformation, SgSymbol* type_of_run, SgSymbol* bIdxs, SgSymbol* private_first, int lnp) -{ - - funcCallKernel = CallKernel(kernel_symb, espec); - for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; ln < num; sg = sg->next(), sb = sb->next(), sl = sl->next, ln++) - { - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); - funcCallKernel->addArg(*e); - for (int i = NumberOfCoeffs(sg); i > 0; i--) - funcCallKernel->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); - } - if (red_list) - insertReductionArgs(reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, funcCallKernel, red_blocks, has_red_array); - - if (options.isOn(RTC)) // diag is modifiable value - { - SgVarRefExp* toAdd = new SgVarRefExp(diag); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - } - else - funcCallKernel->addArg(*new SgVarRefExp(diag)); - - if (loopV > 2) - for (int k = 1; k < loopV + 2; ++k) - { - if (loopV > 2 && k == 2) - continue; - funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); - } - else if (loopV > 0) - for (int k = 1; k < loopV + 1; ++k) - funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); - for (int i = 0; i < acrossV; ++i) - { - if (i <= 1 && options.isOn(RTC)) // across base is modifiable value - { - SgVarRefExp* toAdd = new SgVarRefExp(acrossBase[i]); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - } - else - funcCallKernel->addArg(*new SgVarRefExp(acrossBase[i])); - } - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgVarRefExp(loopBase[i])); - for (int i = 0; i < acrossV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i].len))); - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[i].len))); - - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - { - if (s->attributes() & USE_IN_BIT) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel - else - { // passing argument by reference to kernel - SgType* tp = NULL; - if (s->type()->hasBaseType()) - tp = s->type()->baseType(); - else - tp = s->type(); - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); - funcCallKernel->addArg(*e); - sdev = sdev->next(); - } - } - - if (options.isOn(C_CUDA) && private_first) // there are big private arrays - { - SgExpression *el, *ae; - SgSymbol *sarg, *sp, *s; - int ln; - for (sp = private_first, el = private_list, ln = 0; ln < lnp; sp = sp->next(), el = el->rhs(), ln++) - { - while (!IS_ARRAY(el->lhs()->symbol())) - el = el->rhs(); - s = el->lhs()->symbol(); - ae = new SgCastExp(*C_PointerType( C_Type(s->type()->baseType())), *new SgVarRefExp(sp)); - funcCallKernel->addArg(*ae); - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela; ela = ela->rhs()) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - eatr = (SgExpression **) el->lhs()->attributeValue(0, L_BOUNDS); - for (ela = *eatr; ela; ela = ela->rhs()) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - } - - } - } - - if (options.isOn(AUTO_TFM)) - { - for (size_t i = 0; i < dvm_array_headers.size(); ++i) - { - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(0))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(1))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(2))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(3))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(4))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(5))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(6))); - funcCallKernel->addArg(*new SgVarRefExp(*outTypeOfTransformation[i])); - } - } - - funcCallKernel->addArg(*new SgVarRefExp(type_of_run)); - for (int i = 0; i < acrossV + loopV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*bIdxs, *new SgValueExp(i))); -} - -vector Create_C_Adapter_Function_Across_variants(SgSymbol *sadapter, SgSymbol *kernel_symb, const int loopV, const int acrossV, - const int allDims, const vector& loopSymb, const vector& loopAcrossSymb) -{ -#if debugMode - warn("PARALLEL directive with ACROSS clause in region", 420, dvm_parallel_dir); -#endif - - SgSymbol **num_elems = new SgSymbol*[allDims + 1]; - SgSymbol **reduction_ptr = NULL, **reduction_loc_ptr = NULL, **addressingParams = NULL; - SgSymbol **reduction_symb = NULL, **reduction_loc_symb = NULL; - SgSymbol *lowI, *highI, *idxI, *bIdxs; - SgSymbol *elem, *red_blocks, *shared_mem, *stream_t; - SgSymbol *M, *N, *M1, *M2, *M3, *q, *diag, *Emax, *Emin, *Allmin, *SE, *var1, *var2, *var3; - SgSymbol *acrossBase[numLoopVars], *loopBase[numLoopVars], **outTypeOfTransformation = NULL; - SgSymbol *nums[3], *steps = NULL; - const char *s_cuda_var[3] = { "x", "y", "z" }; - - symb_list *sl; - SgStatement *st_hedr, *st_end, *stmt, *first_exec; - SgExpression *fe, *ae, *arg_list, *el, *e, *espec, *ex, *er, *e_all_private_size = NULL, *e_totalThreads; - SgSymbol *s_loop_ref, *sarg, *s, *sb, *sg, *sdev, *h_first, *hgpu_first, *base_first, *uses_first, *scalar_first, *private_first; - SgSymbol *s_blocks, *s_threads, *s_dev_num, *s_tmp_var, *type_of_run, *s_i = NULL, *s_k = NULL, *s_tmp_var_1; - SgSymbol *idxTypeInKernel; - SgType *typ; - SgFunctionCallExp *funcCall, *funcCallKernel; - vector dvm_array_headers; - int ln, num, uses_num, has_red_array, use_device_num, num_of_red_arrays, nbuf = 0, lnp; - - // init block - lowI = highI = idxI = elem = red_blocks = shared_mem = stream_t = bIdxs = NULL; - M = N = M1 = M2 = M3 = q = diag = Emax = Emin = Allmin = SE = var1 = var2 = var3 = NULL; - s_loop_ref = sarg = s = sb = sg = sdev = h_first = NULL; - hgpu_first = base_first = uses_first = scalar_first = NULL; - s_blocks = s_threads = s_dev_num = s_tmp_var = s_tmp_var_1 = NULL; - typ = NULL; - funcCall = funcCallKernel = NULL; - sl = NULL; - type_of_run = NULL; - st_hedr = st_end = stmt = first_exec = NULL; - fe = ae = arg_list = el = e = espec = ex = er = NULL; - ln = num = uses_num = has_red_array = use_device_num = num_of_red_arrays = 0; - //end of init block - - mywarn("start: create fuction header "); - // create fuction header - st_hedr = Create_C_Function(sadapter); - st_hedr->addComment(Cuda_LoopHandlerComment()); - st_end = st_hedr->lexNext(); - fe = st_hedr->expr(0); - first_exec = st_end; - if (declaration_cmnt == NULL) - declaration_cmnt = "#include \n#define MIN(X,Y) ((X) < (Y) ? (X) : (Y))\n#define MAX(X,Y) ((X) > (Y) ? (X) : (Y))"; - - mywarn(" end: create fuction header "); - mywarn("start: create dummy argument list "); - - // create dummy argument list: loop_ref, , - typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); - s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); - - ae = new SgVarRefExp(s_loop_ref); //loop_ref - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list = new SgExprListExp(*ae); - fe->setLhs(arg_list); - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) // - { - SgArrayType *typearray = new SgArrayType(*C_DvmType()); - typearray->addDimension(NULL); - sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); - dvm_array_headers.push_back(sl->symb->identifier()); - ae = new SgArrayRefExp(*sarg); - ae->setType(*typearray); - el = new SgExpression(EXPR_LIST); - el->setLhs(NULL); - ae->setLhs(*el); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - h_first = sarg; - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - nbuf++; - } - - for (el = uses_list, ln = 0; el; el = el->rhs(), ++ln) // - { - s = el->lhs()->symbol(); - typ = C_PointerType(C_Type(s->type())); - sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); - if (isByValue(s)) - SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; - ae = UsedValueRef(s, sarg); - ae->setType(typ); - ae = new SgPointerDerefExp(*ae); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - if (!ln) - uses_first = sarg; - } - uses_num = ln; - - if (options.isOn(C_CUDA)) // - { - int idim; - SgExpression *elp; - SgType *t = C_PointerType(C_DvmType()); - - for (elp=private_list; elp; elp = elp->rhs()) - { - s = elp->lhs()->symbol(); - if (IS_ARRAY(s) && !TestArrayShape(s)) - { - el = NULL; - for (idim = Rank(s); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, DimSizeName(s, idim), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - arg_list = AddListToList(arg_list, &el->copy()); - if (!elp->lhs()->attributeValue(0, DIM_SIZES)) - { - SgExpression **edim = new (SgExpression *); - *edim = el; - elp->lhs()->addAttribute(DIM_SIZES, (void *)edim, sizeof(SgExpression *) ); - } - - el = NULL; - for (idim = Rank(s); idim; idim--) - { - sarg = new SgSymbol(VARIABLE_NAME, BoundName(s, idim, 1), *t, *st_hedr); - ae = new SgVarRefExp(sarg); - ae->setType(t); - el = AddElementToList(el, new SgPointerDerefExp(*ae)); - } - arg_list = AddListToList(arg_list, &el->copy()); - if (!elp->lhs()->attributeValue(0, L_BOUNDS)) - { - SgExpression **elb = new (SgExpression *); - *elb = el; - elp->lhs()->addAttribute(L_BOUNDS, (void *)elb, sizeof(SgExpression *) ); - } - - while (arg_list->rhs() != 0) - arg_list = arg_list->rhs(); - } - - } - } - - type_of_run = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("type_of_run"), *LongT, *st_hedr); - ae = new SgVarRefExp(type_of_run); - ae->setType(LongT); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - if (options.isOn(SPEED_TEST_L0)) - { - s_i = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_i"), *C_Type(SgTypeInt()), *st_hedr); - ae = new SgVarRefExp(s_i); - ae->setType(C_Type(SgTypeInt())); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - - s_k = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_k"), *C_Type(SgTypeInt()), *st_hedr); - ae = new SgVarRefExp(s_k); - ae->setType(C_Type(SgTypeInt())); - arg_list->setRhs(*new SgExprListExp(*ae)); - arg_list = arg_list->rhs(); - } - - mywarn(" end: create dummy argument list "); - if (red_list) // reduction section - { - mywarn("start: in reduction section "); - s_tmp_var = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("tmpVar"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_tmp_var_1 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("tmpVar1"), *C_DvmType(), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - //looking through the reduction_op_list - for (er = red_list; er; er = er->rhs()) - num_of_red_arrays++; - - reduction_ptr = new SgSymbol*[num_of_red_arrays]; - reduction_symb = new SgSymbol*[num_of_red_arrays]; - - reduction_loc_ptr = new SgSymbol*[num_of_red_arrays]; - reduction_loc_symb = new SgSymbol*[num_of_red_arrays]; - - for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) - { - SgExpression *ered, *ev, *en, *loc_var_ref; - SgSymbol *sred, *s_loc_var, *sgrid_loc; - int is_array; - SgType *loc_type = NULL, *btype = NULL; - - loc_var_ref = NULL; - s_loc_var = NULL; - is_array = 0; - ered = er->lhs(); // reduction (variant==ARRAY_OP) - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - if (isSgExprListExp(ev)) - { - ev = ev->lhs(); // reduction variable reference - loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference - en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array - loc_el_num = LocElemNumber(en); - loc_type = loc_var_ref->symbol()->type(); - } - else if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array - is_array = 1; - - s = sred = &(ev->symbol()->copy()); - SYMB_SCOPE(s->thesymb) = st_hedr->thebif; - if (is_array) - { - SgArrayType *typearray = new SgArrayType(*C_Type(ev->symbol()->type())); - typearray->addRange(*ArrayLengthInElems(ev->symbol(), NULL, 0)); - s->setType(*typearray); - } - else - s->setType(C_Type(ev->symbol()->type())); - - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - reduction_symb[ln] = s; - if (!ln) - red_first = s; - - s_loc_var = sgrid_loc = NULL; - if (loc_var_ref) - { - s = s_loc_var = &(loc_var_ref->symbol()->copy()); - if (isSgArrayType(loc_type)) - btype = loc_type->baseType(); - else - btype = loc_type; - - SgArrayType *typearray = new SgArrayType(*C_Type(btype)); - typearray->addRange(*new SgValueExp(loc_el_num)); - s_loc_var->setType(*typearray); - SYMB_SCOPE(s->thesymb) = st_hedr->thebif; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - reduction_loc_symb[ln] = s_loc_var; - - s = sgrid_loc = GridSymbolForRedInAdapter(s, st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - - /*--- executable statements: register reductions in RTS ---*/ - e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (!ln) - { - stmt->addComment("// Register reduction for CUDA-execution"); - first_exec = stmt; - } - - char *buf_tmp = new char[8]; - sprintf(buf_tmp, "%d", ln); - reduction_ptr[ln] = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "cuda_ptr_"), buf_tmp)), *C_PointerType(C_Type(ev->symbol()->type())), *st_hedr); - st_hedr->insertStmtAfter(*makeSymbolDeclaration(reduction_ptr[ln]), *st_hedr); - delete[]buf_tmp; - - if (s_loc_var) - reduction_loc_ptr[ln] = sgrid_loc; - else - reduction_loc_ptr[ln] = NULL; - - // create loop_cuda_register_red() - stmt = new SgCExpStmt(*RegisterReduction_forAcross(s_loop_ref, s_tmp_var, reduction_ptr[ln], reduction_loc_ptr[ln])); - st_end->insertStmtBefore(*stmt, *st_hedr); - // create loop_red_init_() - stmt = new SgCExpStmt(*InitReduction(s_loop_ref, s_tmp_var, sred, s_loc_var)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - mywarn(" end: out reduction section "); - } - - mywarn("start: create vars "); - - // create type for static arrays - SgArrayType *tpArr = new SgArrayType(*LongT); - SgValueExp *dimSize = new SgValueExp(loopV + acrossV + 2); - tpArr->addDimension(dimSize); - - if (red_list) - { - red_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_of_red_blocks"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - lowI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("lowI"), *LongT, *st_hedr); - s->setType(tpArr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - highI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("highI"), *LongT, *st_hedr); - s->setType(tpArr); - addDeclExpList(s, stmt->expr(0)); - - idxI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxI"), *LongT, *st_hedr); - s->setType(tpArr); - addDeclExpList(s, stmt->expr(0)); - - idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - if (options.isOn(GPU_O0)) - { - steps = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("steps"), *LongT, *st_hedr); - s->setType(tpArr); - addDeclExpList(s, stmt->expr(0)); - } - - bIdxs = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxs"), *LongT, *st_hedr); - s->setType(tpArr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - if (options.isOn(AUTO_TFM)) - { - // create type for static arrays for addresingParams, size = 5 - SgArrayType *tpArr = new SgArrayType(*LongT); - SgValueExp *dimSize = new SgValueExp(7); - tpArr->addDimension(dimSize); - - addressingParams = new SgSymbol*[dvm_array_headers.size()]; - outTypeOfTransformation = new SgSymbol*[dvm_array_headers.size()]; - char *tmpS = new char[64]; - for (size_t i = 0; i < dvm_array_headers.size(); ++i) - { - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_addressingParams"); - addressingParams[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), *LongT, *st_hedr); - s->setType(tpArr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_outTypeOfTfm"); - outTypeOfTransformation[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - } - - if (acrossV == 1) // ACROSS with one dependence: create variables - { - SgStatement **stmts = new SgStatement*[MIN(loopV, 3) * 2]; - for (int k = 0, k1 = MIN(loopV, 3); k < MIN(loopV, 3); ++k, ++k1) - { - nums[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_"), s_cuda_var[k])), *LongT, *st_hedr); - stmts[k] = makeSymbolDeclaration(s); - - num_elems[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_"), s_cuda_var[k])), *LongT, *st_hedr); - stmts[k1] = makeSymbolDeclaration(s); - } - for (int k = 0; k < MIN(loopV, 3) * 2; ++k) - st_hedr->insertStmtAfter(*stmts[k], *st_hedr); - - if (loopV > 3) - { - for (int k = 0; k < loopV - 2; ++k) - { - char *tmp = new char[10]; - sprintf(tmp, "%d", k); - num_elems[k + 3] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_z_"), tmp)), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - delete[]tmp; - } - } - - delete[]stmts; - } - else if (acrossV == 2) // ACROSS with two dependence: create variables - { - M = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("M"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - N = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("N"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - elem = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("elem"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - diag = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("diag"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - q = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("q"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - SgStatement **stmts = new SgStatement*[(MIN(loopV + 1, 3) - 1) * 2]; - for (int k = 1, k1 = MIN(loopV + 1, 3) - 1; k < MIN(loopV + 1, 3); ++k, ++k1) - { - nums[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_"), s_cuda_var[k])), *LongT, *st_hedr); - stmts[k - 1] = makeSymbolDeclaration(s); - - num_elems[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_"), s_cuda_var[k])), *LongT, *st_hedr); - stmts[k1] = makeSymbolDeclaration(s); - } - - nums[0] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_x"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - for (int i = 0; i < (MIN(loopV + 1, 3) - 1) * 2; ++i) - st_hedr->insertStmtAfter(*stmts[i], *st_hedr); - delete[]stmts; - - if (loopV > 2) - { - for (int k = 0; k < loopV - 1; ++k) - { - char *tmp = new char[10]; - sprintf(tmp, "%d", k); - num_elems[k + 3] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_z_"), tmp)), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - delete[]tmp; - } - } - } - else if (acrossV >= 3) // ACROSS with three dependence: create variables - { - nums[0] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_x"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - nums[1] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_y"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - if (loopV > 0) - { - nums[2] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_z"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - for (int k = 0; k < loopV; ++k) - { - char *tmp = new char[10]; - sprintf(tmp, "%d", k); - num_elems[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_z_"), tmp)), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - delete[]tmp; - } - - num_elems[loopV] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_elem_z"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - M1 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Mi"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - M2 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Mj"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - M3 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Mk"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - Emax = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emax"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - Emin = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emin"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - Allmin = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Allmin"), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - SE = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("SE"), *LongT, *st_hedr); - stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - diag = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("diag"), *LongT, *st_hedr); - stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - var1 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var1"), *LongT, *st_hedr); - stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(1)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - var2 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var2"), *LongT, *st_hedr); - stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(0)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - var3 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var3"), *LongT, *st_hedr); - stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(0)); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - - // create indxs - for (int i = 0; i < acrossV; ++i) - { - acrossBase[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[20], "base_"), - loopAcrossSymb[i].symb->identifier())), *LongT, *st_hedr); - if (i == 0) - { - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - for (int i = 0; i < loopV; ++i) - { - loopBase[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[20], "base_"), - loopSymb[i].symb->identifier())), *LongT, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - } - // end - - mywarn(" end: create vars "); - mywarn("start: create assigns"); - - s_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("blocks"), *t_dim3, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - s_threads = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("threads"), *t_dim3, *st_hedr); - addDeclExpList(s, stmt->expr(0)); - - shared_mem = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("shared_mem"), *LongT, *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - stream_t = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("stream"), *C_Derived_Type(s_cudaStream), *st_hedr); - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - - for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device - if (!scalar_first) - { - scalar_first = sdev; - stmt = makeSymbolDeclaration(sdev); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(sdev, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) - { - s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - hgpu_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - - for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) - { - s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); - if (!ln) - { - base_first = s; - stmt = makeSymbolDeclaration(s); - st_hedr->insertStmtAfter(*stmt, *st_hedr); - } - else - addDeclExpList(s, stmt->expr(0)); - } - num = ln; - - /* call DvmType loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]); */ - if (options.isOn(AUTO_TFM)) - { - s = h_first; - for (size_t i = 0; i < dvm_array_headers.size(); ++i, s = s->next()) - { - stmt = new SgCExpStmt(*CudaAutoTransform(s_loop_ref, s)); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!i) - stmt->addComment("// Autotransform all arrays"); - } - } - - /* -------- call dvmh_get_device_addr(long *deviceRef, void *variable) ----*/ - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses - if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference - { - s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Get device addresses"); - sdev = sdev->next(); - } - - /* -------- call dvmh_get_natural_base(long *deviceRef, long dvmDesc[] ) ----*/ - - for (sl = acc_array_list, s = h_first, sb = base_first, ln = 0; ln < num; sl = sl->next, s = s->next(), sb = sb->next(), ln++) - { - s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); - e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); - stmt = new SgCExpStmt(*e); - SgStatement *cur = stmt; - st_end->insertStmtBefore(*stmt, *st_hedr); - if (IS_REMOTE_ACCESS_BUFFER(sl->symb)) // case of RTS2 interface - { - e = LoopGetRemoteBuf(s_loop_ref, nbuf--, s); - stmt = new SgCExpStmt(*e); - cur->insertStmtBefore(*stmt, *st_hedr); - } - if (!ln) - stmt->addComment("// Get natural bases"); - } - - /* call dvmh_fill_header_ex_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[], DvmType *outTypeOfTransformation, DvmType extendedParams[]);*/ - if (options.isOn(AUTO_TFM)) - { - for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) - { - stmt = new SgCExpStmt(*FillHeader_Ex(s_dev_num, sb, s, sg, outTypeOfTransformation[ln], addressingParams[ln])); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Fill device headers"); - } - } - /* -------- call dvmh_fill_header_(long *deviceRef, void *base, long dvmDesc[], long dvmhDesc[]);----*/ - else - { - for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) - { - e = FillHeader(s_dev_num, sb, s, sg); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (!ln) - stmt->addComment("// Fill device headers"); - } - } - /* -------- call loop_fill_bounds_(loop_ref, lowI, highI, idxI); ----*/ - - stmt = new SgCExpStmt(*FillBounds(s_loop_ref, lowI, highI, idxI)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Get bounds"); - - /* -------- call dvmh_change_filled_bounds(low, high, idx, n, dep, type_of_run, idxs); ----*/ - if (acrossV == 1 || acrossV == 2 || acrossV >= 3) - { - char *name = new char[16]; - name[0] = '\0'; - sprintf(name, "%d", acrossV + loopV); - SgSymbol *tmp_1 = new SgSymbol(VARIABLE_NAME, name); - name[0] = '\0'; - sprintf(name, "%d", acrossV); - SgSymbol *tmp_2 = new SgSymbol(VARIABLE_NAME, name); - - stmt = new SgCExpStmt(*ChangeFilledBounds(lowI, highI, idxI, tmp_1, tmp_2, type_of_run, bIdxs)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Swap bounds"); - - delete[]name; - } - - if (options.isOn(RTC)) - { - /* -------- call loop_cuda_rtc_set_lang_(loop_ref, lang); ------------*/ - if (options.isOn(C_CUDA)) - stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 1)); - else - stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 0)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Set CUDA language for launching kernels in RTC"); - } - - /* -------- call loop_guess_index_type_(loop_ref); ------------*/ - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *GuessIndexType(s_loop_ref))); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Guess index type in CUDA kernel"); - - SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); - - sizeofL->addArg(*new SgKeywordValExp("long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); - sizeofLL->addArg(*new SgKeywordValExp("long long")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); - sizeofI->addArg(*new SgKeywordValExp("int")); //addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofI), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) - && - SgEqOp(*sizeofL, *sizeofLL), - *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - /* -------- call loop_cuda_get_config_(loop_ref, &shared_mem, ®_per_th, &threads, &stream, &shared_mem); ------------*/ - SgFunctionCallExp *tmpFunc = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); - int x = 0, y = 0, z = 0; - getDefaultCudaBlock(x, y, z, acrossV, loopV); - tmpFunc->addArg(*new SgValueExp(x)); - tmpFunc->addArg(*new SgValueExp(y)); - tmpFunc->addArg(*new SgValueExp(z)); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_threads), *tmpFunc)); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Get CUDA configuration params"); - - if (loopV > 0 && red_list) - { - //OLD VAR - //stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*shared_mem), *new SgValueExp(getSizeOf()))); - //st_end->insertStmtBefore(*stmt, *st_hedr); - - int shared_mem_count = getSizeOf(); - if (shared_mem_count) - { - if (!options.isOn(C_CUDA)) - { - e = &SgAssignOp(*new SgVarRefExp(shared_mem), *new SgValueExp(shared_mem_count)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else - { - std::string preproc = std::string("#ifdef ") + fermiPreprocDir; - char* tmp = new char[preproc.size() + 1]; - strcpy(tmp, preproc.data()); - - st_end->insertStmtBefore(*PreprocessorDirective(tmp), *st_hedr); - e = &SgAssignOp(*new SgVarRefExp(shared_mem), *new SgValueExp(shared_mem_count)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - st_end->insertStmtBefore(*PreprocessorDirective("#else"), *st_hedr); - e = &SgAssignOp(*new SgVarRefExp(shared_mem), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - st_end->insertStmtBefore(*PreprocessorDirective("#endif"), *st_hedr); - } - } - } - else - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*shared_mem), *new SgValueExp(0))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - string define_name_int = kernel_symb->identifier(); - string define_name_long = kernel_symb->identifier(); - - define_name_int += "_int_regs"; - define_name_long += "_llong_regs"; - - SgStatement *config_int = new SgCExpStmt(*GetConfig(s_loop_ref, shared_mem, new SgSymbol(VARIABLE_NAME, define_name_int.c_str()), s_threads, stream_t, shared_mem)); - SgStatement *config_long = new SgCExpStmt(*GetConfig(s_loop_ref, shared_mem, new SgSymbol(VARIABLE_NAME, define_name_long.c_str()), s_threads, stream_t, shared_mem)); - - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), *config_int, *config_long); - st_end->insertStmtBefore(*stmt, *st_hedr); - - // collect names, all _REGS constant - RGname_list = AddNewToSymbList(RGname_list, new SgSymbol(VARIABLE_NAME, define_name_int.c_str(), C_DvmType(), st_hedr)); - allRegNames.push_back(new SgSymbol(VARIABLE_NAME, define_name_int.c_str())); - - RGname_list = AddNewToSymbList(RGname_list, new SgSymbol(VARIABLE_NAME, define_name_long.c_str(), C_DvmType(), st_hedr)); - allRegNames.push_back(new SgSymbol(VARIABLE_NAME, define_name_long.c_str())); - - tmpFunc = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); - if (options.isOn(SPEED_TEST_L0)) - { - tmpFunc->addArg(*new SgVarRefExp(s_i)); - tmpFunc->addArg(*new SgVarRefExp(s_k)); - tmpFunc->addArg(*new SgValueExp(z)); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_threads), *tmpFunc)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - if (acrossV == 1) // ACROSS with one dependence: create variables - { - //SgStatement **stmts = new SgStatement*[MIN(loopV, 3) * 2]; - for (int k = 0; k < MIN(loopV, 3); ++k) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[k]), *new SgRecordRefExp(*s_threads, (char*)s_cuda_var[k]))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - else if (acrossV == 2) // ACROSS with two dependence: create variables - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[0]), *new SgRecordRefExp(*s_threads, "x"))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - for (int k = 1; k < MIN(loopV + 1, 3); ++k) - { - if (k == 1) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[k]), *new SgRecordRefExp(*s_threads, "y"))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[k]), *new SgRecordRefExp(*s_threads, "z"))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - } - else if (acrossV >= 3) // ACROSS with three dependence: create variables - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[0]), *new SgRecordRefExp(*s_threads, "x"))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[1]), *new SgRecordRefExp(*s_threads, "y"))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (loopV > 0) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[2]), *new SgRecordRefExp(*s_threads, "z"))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - - mywarn(" end: create assigns"); - - espec = CreateBlocksThreadsSpec(shared_mem, s_blocks, s_threads, stream_t); - - if (acrossV == 1) // ACROSS with one dependence: generate method - { - mywarn("start: in start across 1"); - SgFunctionCallExp *f = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); - f->addArg(*new SgValueExp(1)); - f->addArg(*new SgValueExp(1)); - f->addArg(*new SgValueExp(1)); - - e = &SgAssignOp(*new SgVarRefExp(s_blocks), *f); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - stmt->addComment("// Start method"); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - { - int *idx = new int[loopV]; - SgExpression *mult_z = NULL; - for (int k = 0; k < MIN(2, loopV); ++k) - { - SgStatement *st1; - idx[k] = loopSymb[k].len; - - e = &SgAssignOp(*new SgVarRefExp(loopBase[k]), *new SgArrayRefExp(*lowI, *new SgValueExp(idx[k]))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[k]))); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[k])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[k])))); - e = &(*funcCall + *f1); - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[k]), *e / *f1)); - st_end->insertStmtBefore(*st1, *st_hedr); - - st1 = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks, (char *)s_cuda_var[k]), - *new SgVarRefExp(*num_elems[k]) / *new SgVarRefExp(nums[k]) + - SgNeqOp(*new SgVarRefExp(*num_elems[k]) % *new SgVarRefExp(nums[k]), *new SgValueExp(0)))); - st_end->insertStmtBefore(*st1, *st_hedr); - - e = &SgAssignOp(*new SgRecordRefExp(*s_threads, (char *)s_cuda_var[k]), *new SgVarRefExp(*nums[k])); - st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); - } - - if (loopV > 3) - { - for (int k = 2; k < loopV; ++k) - { - SgStatement *st1; - idx[k] = loopSymb[k].len; - - e = &SgAssignOp(*new SgVarRefExp(loopBase[k]), *new SgArrayRefExp(*lowI, *new SgValueExp(idx[k]))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[k]))); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[k])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[k])))); - e = &(*funcCall + *f1); - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[k + 1]), *e / *f1)); - st_end->insertStmtBefore(*st1, *st_hedr); - - if (k == 2) - mult_z = &(*new SgVarRefExp(*num_elems[k + 1])); - else - mult_z = &((*mult_z) * (*new SgVarRefExp(*num_elems[k + 1]))); - } - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[2]), *mult_z)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else if (loopV > 2) - { - SgStatement *st1; - int k = 2; - idx[k] = loopSymb[k].len; - - e = &SgAssignOp(*new SgVarRefExp(loopBase[k]), *new SgArrayRefExp(*lowI, *new SgValueExp(idx[k]))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[k]))); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[k])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[k])))); - e = &(*funcCall + *f1); - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[k]), *e / *f1)); - st_end->insertStmtBefore(*st1, *st_hedr); - } - - if (loopV > 2) - { - stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks, (char *)s_cuda_var[2]), - *new SgVarRefExp(*num_elems[2]) / *new SgVarRefExp(nums[2]) + - SgNeqOp(*new SgVarRefExp(*num_elems[2]) % *new SgVarRefExp(nums[2]), *new SgValueExp(0)))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - e = &SgAssignOp(*new SgRecordRefExp(*s_threads, (char *)s_cuda_var[2]), *new SgVarRefExp(*nums[2])); - st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); - } - - delete[]idx; - } - - mywarn(" end: out start across 1"); - - if (red_list) - { - mywarn("strat: in red section"); - if (loopV != 0) - { - // (blocks.x * blocks.y * blocks.z * threads.x * threads.y * threads.z) / warpSize) - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), - (*new SgRecordRefExp(*s_blocks, "x") * *new SgRecordRefExp(*s_blocks, "y") * *new SgRecordRefExp(*s_blocks, "z") * - *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z")) - / *GetWarpSize(s_loop_ref)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else - { - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_tmp_var_1), *new SgValueExp(1))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) - { - e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_tmp_var, red_blocks, s_tmp_var_1)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - mywarn(" end: out red section"); - } - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) - + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))); - stmt = new SgCExpStmt(*e); - - - if (options.isOn(C_CUDA) || options.isOn(GPU_O0) == false) - { - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - SgFunctionCallExp *f2 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1->addArg(*new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0].len)) - *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len))); - f2->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))); - - e = &SgAssignOp(*new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0].len)), (*f1 + *f2) / *f2); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - if (options.isOn(GPU_O0)) - { - e = &SgAssignOp(*new SgArrayRefExp(*steps, *new SgArrayRefExp(*bIdxs, *new SgValueExp(0))), *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - for (int i = 0; i < loopV; ++i) - { - e = &SgAssignOp(*new SgArrayRefExp(*steps, *new SgArrayRefExp(*bIdxs, *new SgValueExp((int)(i + 1)))), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - mywarn("start: in adding args section"); - - /* args for kernel */ - { - funcCallKernel = CallKernel(kernel_symb, espec); - - for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) - { - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); - funcCallKernel->addArg(*e); - for (int i = NumberOfCoeffs(sg); i > 0; i--) - funcCallKernel->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); - } - - if (red_list) - insertReductionArgs(reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, funcCallKernel, red_blocks, has_red_array); - - for (int k = 0; k < MIN(loopV, 2); ++k) - funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); - if (loopV == 3) - funcCallKernel->addArg(*new SgVarRefExp(num_elems[2])); - else if (loopV > 3) - for (int k = 3; k < loopV + 1; ++k) - funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); - for (int i = 0; i < acrossV; ++i) - { - if (i == 0 && options.isOn(RTC)) // across base is modifiable value - { - SgVarRefExp *toAdd = new SgVarRefExp(acrossBase[i]); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - } - else - funcCallKernel->addArg(*new SgVarRefExp(acrossBase[i])); - } - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgVarRefExp(loopBase[i])); - for (int i = 0; i < acrossV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i].len))); - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[i].len))); - - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - { - if (s->attributes() & USE_IN_BIT) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel - else - { // passing argument by reference to kernel - SgType *tp = NULL; - if (s->type()->hasBaseType()) - tp = s->type()->baseType(); - else - tp = s->type(); - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); - funcCallKernel->addArg(*e); - sdev = sdev->next(); - } - } - - e_all_private_size = sizeOfPrivateArraysInBytes(); - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - { - for (el=private_list, lnp=0; el; el=el->rhs()) - { - s = el->lhs()->symbol(); - if (IS_ARRAY(s)) - { - sarg = new SgSymbol(VARIABLE_NAME, PointerNameForPrivateArray(s), *C_PointerType(C_VoidType()), *st_hedr); - ae = new SgCastExp(*C_PointerType( C_Type(s->type()->baseType())), *new SgVarRefExp(sarg)); - funcCallKernel->addArg(*ae); - if (!lnp) - private_first = sarg; - lnp++; - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela; ela = ela->rhs()) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - eatr = (SgExpression **) el->lhs()->attributeValue(0, L_BOUNDS); - for (ela = *eatr; ela; ela = ela->rhs()) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - } - } - } - } - - funcCallKernel->addArg(*new SgVarRefExp(type_of_run)); - for (int i = 0; i < acrossV + loopV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*bIdxs, *new SgValueExp(i))); - - char *cond_ = new char[strlen("cond_") + strlen(loopAcrossSymb[0].symb->identifier()) + 1]; - cond_[0] = '\0'; - strcat(cond_, "cond_"); - strcat(cond_, loopAcrossSymb[0].symb->identifier()); - - if (options.isOn(GPU_O0)) - { - funcCallKernel->addArg(*new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0].len))); - for (int i = loopV - 1; i >= 0; i--) - funcCallKernel->addArg(*new SgArrayRefExp(*steps, *new SgValueExp(loopSymb[i].len))); - funcCallKernel->addArg(*new SgArrayRefExp(*steps, *new SgValueExp(loopAcrossSymb[0].len))); - } - - } - mywarn(" end: out adding args section"); - - stmt = createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks); - - if (options.isOn(GPU_O0)) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - { - SgSymbol *tmpV = new SgSymbol(VARIABLE_NAME, "int tmpV"); - SgSymbol *tmpV1 = new SgSymbol(VARIABLE_NAME, "tmpV"); - SgExprListExp *expr = new SgExprListExp(); - expr->setLhs(SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len)))); - expr->setRhs(new SgExprListExp()); - expr->rhs()->setLhs(SgAssignOp(*new SgVarRefExp(tmpV1), *new SgVarRefExp(tmpV1) + *new SgValueExp(1))); - SgForStmt *simple; - simple = new SgForStmt(&SgAssignOp(*new SgVarRefExp(tmpV), *new SgValueExp(0)), &(*new SgVarRefExp(tmpV1) < *new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0].len))), expr, stmt); - st_end->insertStmtBefore(*simple); - stmt = simple; - } - stmt->addComment("// GPU execution"); - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - { - e_totalThreads = &(*new SgRecordRefExp(*s_blocks, "x") * *new SgRecordRefExp(*s_blocks, "y") * *new SgRecordRefExp(*s_blocks, "z") * *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z")); - GetMemoryForPrivateArrays(private_first, s_loop_ref, lnp, stmt, st_hedr, e_totalThreads); - } - - } - else if (acrossV == 2) // ACROSS with two dependence: generate method - { - // attention!! need to add flag for support all cases - if (loopV != 0) - { - SgSymbol *tmp = nums[0]; - nums[0] = nums[1]; - nums[1] = tmp; - - const char *tmpS = s_cuda_var[0]; - s_cuda_var[0] = s_cuda_var[1]; - s_cuda_var[1] = tmpS; - } - - mywarn("strat: alloc mem"); - { - int idx[2]; - SgStatement *st1, *st2; - idx[1] = loopAcrossSymb[1].len; - idx[0] = loopAcrossSymb[0].len; - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[0]))); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[0])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[0])))); - e = &(*funcCall + *new SgValueExp(1)); - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[1]))); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[1])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[1])))); - e = &(*funcCall + *new SgValueExp(1)); - st2 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(N), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); - - st_end->insertStmtBefore(*st1, *st_hedr); - st_end->insertStmtBefore(*st2, *st_hedr); - st1->addComment("// Count used variables"); - } - - // count num_elem_y and num_elem_z - if (loopV > 0) - { - SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[0].len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[0].len)))); - tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[0].len))); - e = &SgAssignOp(*new SgVarRefExp(num_elems[1]), (*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - SgExpression **e_z = new SgExpression*[loopV - 1]; - for (int k = 0; k < loopV - 1; ++k) - { - SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[k + 1].len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[k + 1].len)))); - tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[k + 1].len))); - e_z[k] = &((*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); - } - if (loopV > 2) - { - for (int k = 0; k < loopV - 1; ++k) - { - e = &SgAssignOp(*new SgVarRefExp(num_elems[k + 3]), *e_z[k]); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (k == 0) - e_z[0] = new SgVarRefExp(num_elems[k + 3]); - else - e_z[0] = &(*(e_z[0]) * (*new SgVarRefExp(num_elems[k + 3]))); - } - } - - if (loopV > 1) - { - e = &SgAssignOp(*new SgVarRefExp(num_elems[2]), *e_z[0]); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - delete[]e_z; - } - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); - funcCall->addArg(*new SgVarRefExp(nums[0])); - for (int k = 1; k < MIN(loopV + 1, 3); ++k) - { - funcCall->addArg(*new SgVarRefExp(nums[k])); - } - - e = &SgAssignOp(*new SgVarRefExp(s_blocks), *funcCall); - st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); - - for (int k = 1; k < MIN(loopV + 1, 3); ++k) - { - e = new SgExpression(NOTEQL_OP, &(*new SgVarRefExp(num_elems[k]) % *new SgVarRefExp(nums[k])), new SgValueExp(0), s); - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[k]), *new SgVarRefExp(num_elems[k]) / *new SgVarRefExp(nums[k]) + *e); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); - funcCall->addArg(*new SgVarRefExp(M)); - funcCall->addArg(*new SgVarRefExp(N)); - e = &SgAssignOp(*new SgVarRefExp(q), *funcCall); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - mywarn(" end: alloc mem"); - - if (red_list) - { - mywarn("strat: in red section"); - if (loopV == 0) - { - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), *new SgVarRefExp(q)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else if (loopV == 1) - { - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), (*new SgVarRefExp(q) / *new SgVarRefExp(nums[0]) + - SgNeqOp(*new SgVarRefExp(q) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))) * - *new SgRecordRefExp(*s_blocks, "y") * - *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *GetWarpSize(s_loop_ref)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else - { - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), (*new SgVarRefExp(q) / *new SgVarRefExp(nums[0]) + - SgNeqOp(*new SgVarRefExp(q) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))) * - *new SgRecordRefExp(*s_blocks, "y") * *new SgRecordRefExp(*s_blocks, "z") * - *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *GetWarpSize(s_loop_ref)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - e = &SgAssignOp(*new SgVarRefExp(s_tmp_var_1), *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) - { - e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_tmp_var, red_blocks, s_tmp_var_1)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - mywarn(" end: out red section"); - } - createPrivatePointers(private_first, lnp, st_hedr, e_all_private_size); - GetMemoryForPrivateArrays (private_first, s_loop_ref, lnp, st_end, st_hedr, new SgVarRefExp(q)); - mywarn("strat: init bases"); - // init bases - for (int i = 0; i < acrossV; ++i) - { - e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (i == 0) - stmt->addComment("// Start SOR method here"); - } - for (int i = 0; i < loopV; ++i) - { - e = &SgAssignOp(*new SgVarRefExp(loopBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[i].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - mywarn(" end: init bases"); - mywarn("start: block1"); - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - - SgWhileStmt *while_st = new SgWhileStmt(*new SgVarRefExp(diag) <= *new SgVarRefExp(q), *stmt); - st_end->insertStmtBefore(*while_st, *st_hedr); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + - *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))); - stmt = new SgCExpStmt(*e); - - - while_st->insertStmtAfter(*stmt); - /* --------- add argument list to kernel call ----*/ - createArgsForKernelForTwoDeps(funcCallKernel, kernel_symb, espec, sg, hgpu_first, sb, base_first, sl, ln, num, e, - reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, red_blocks, - has_red_array, diag, loopV, num_elems, acrossV, acrossBase, loopBase, idxI, - loopAcrossSymb, loopSymb, s, uses_first, sdev, scalar_first, uses_num, dvm_array_headers, - addressingParams, outTypeOfTransformation, type_of_run, bIdxs, private_first, lnp); - - stmt = createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks); - while_st->insertStmtAfter(*stmt); - - mywarn(" end: block1"); - mywarn("start: block2"); - - ex = new SgExpression(NOTEQL_OP, &(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[0])), new SgValueExp(0), s); - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[0]) + *ex); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgVarRefExp(*diag), *new SgVarRefExp(*diag) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg(*new SgVarRefExp(*M) - *new SgVarRefExp(*N)); - SgWhileStmt *while_st1 = new SgWhileStmt(*new SgVarRefExp(diag) < *funcCall, *stmt); - SgWhileStmt *while_st2 = new SgWhileStmt(*new SgVarRefExp(diag) < *funcCall, stmt->copy()); - SgWhileStmt *while_st3 = new SgWhileStmt(*new SgVarRefExp(diag) < *new SgVarRefExp(M) + *new SgVarRefExp(N), stmt->copy()); - SgWhileStmt *while_st4 = new SgWhileStmt(*new SgVarRefExp(diag) < *new SgVarRefExp(M) + *new SgVarRefExp(N), stmt->copy()); - SgIfStmt *if_st = new SgIfStmt(*new SgVarRefExp(*N) < *new SgVarRefExp(*M), *while_st3, *while_st4); - st_end->insertStmtBefore(*if_st, *st_hedr); - - e = &SgAssignOp(*new SgVarRefExp(*elem), *new SgVarRefExp(q) - *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - if_st->insertStmtAfter(*stmt); - - if_st->falseBody()->insertStmtBefore(stmt->copy()); - if_st->falseBody()->insertStmtBefore(*while_st2); - if_st->falseBody()->insertStmtBefore(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(0)))); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) - - *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))); - stmt = new SgCExpStmt(*e); - if_st->insertStmtAfter(*stmt); - if_st->falseBody()->insertStmtBefore(stmt->copy()); - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(q) + *funcCall + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - if_st->lexNext()->insertStmtAfter(*stmt); - if_st->falseBody()->lexNext()->lexNext()->lexNext()->insertStmtAfter(stmt->copy(), *if_st); - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1].len)) + - *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len))); - stmt = new SgCExpStmt(*e); - if_st->insertStmtAfter(*stmt); - if_st->falseBody()->insertStmtBefore(stmt->copy()); - - if_st->insertStmtAfter(*while_st1); - if_st->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(0)))); - - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + - *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))); - stmt = new SgCExpStmt(*e); - while_st1->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + - *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len))); - stmt = new SgCExpStmt(*e); - - while_st2->insertStmtAfter(*stmt); - while_st3->insertStmtAfter(stmt->copy()); - while_st4->insertStmtAfter(stmt->copy()); - - mywarn(" end: block2"); - mywarn("start: block3"); - - e = &SgAssignOp(*new SgVarRefExp(*elem), *new SgVarRefExp(*elem) - *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - while_st3->lastExecutable()->insertStmtAfter(*stmt); - while_st4->lastExecutable()->insertStmtAfter(stmt->copy()); - - /* --------- add argument list to kernel call ----*/ - createArgsForKernelForTwoDeps(funcCallKernel, kernel_symb, espec, sg, hgpu_first, sb, base_first, sl, ln, num, e, - reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, red_blocks, - has_red_array, q, loopV, num_elems, acrossV, acrossBase, loopBase, idxI, - loopAcrossSymb, loopSymb, s, uses_first, sdev, scalar_first, uses_num, dvm_array_headers, - addressingParams, outTypeOfTransformation, type_of_run, bIdxs, private_first, lnp); - - while_st1->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - while_st2->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - - mywarn(" end: block3"); - - /* --------- add argument list to kernel call ----*/ - createArgsForKernelForTwoDeps(funcCallKernel, kernel_symb, espec, sg, hgpu_first, sb, base_first, sl, ln, num, e, - reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, red_blocks, - has_red_array, elem, loopV, num_elems, acrossV, acrossBase, loopBase, idxI, - loopAcrossSymb, loopSymb, s, uses_first, sdev, scalar_first, uses_num, dvm_array_headers, - addressingParams, outTypeOfTransformation, type_of_run, bIdxs, private_first, lnp); - - while_st3->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - while_st4->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - - - ex = new SgExpression(MOD_OP, new SgVarRefExp(q), new SgVarRefExp(nums[0]), s); - ex = new SgExpression(NOTEQL_OP, ex, new SgValueExp(0), s); - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(q) / *new SgVarRefExp(nums[0]) + *ex); - while_st1->insertStmtAfter(*new SgCExpStmt(*e)); - while_st2->insertStmtAfter(*new SgCExpStmt(*e)); - - SgExpression *ex1 = &(*new SgVarRefExp(*elem)); - ex = new SgExpression(MOD_OP, ex1, new SgVarRefExp(nums[0]), s); - ex = new SgExpression(NOTEQL_OP, ex, new SgValueExp(0), s); - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *ex1 / *new SgVarRefExp(nums[0]) + *ex); - while_st3->insertStmtAfter(*new SgCExpStmt(*e)); - while_st4->insertStmtAfter(*new SgCExpStmt(*e)); - } - else if (acrossV >= 3) // ACROSS with three or more dependence: generate method - { - // attention!! need to add flag for support all cases - if (loopV != 0) - { - SgSymbol *tmp = nums[0]; - nums[0] = nums[2]; - nums[2] = tmp; - - const char *tmpS = s_cuda_var[0]; - s_cuda_var[0] = s_cuda_var[2]; - s_cuda_var[2] = tmpS; - } - - SgExpression* firstElem = new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len)); - SgExpression* secondElem = new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)); - - SgIfStmt* if_stSwap = new SgIfStmt(*new SgVarRefExp(M1) > *new SgVarRefExp(M2), *new SgCExpStmt(*firstElem ^= *secondElem ^= *firstElem ^= *secondElem)); - - /* --------- add argument list to kernel call ----*/ - { - funcCallKernel = CallKernel(kernel_symb, espec); - for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) - { - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); - funcCallKernel->addArg(*e); - for (int i = NumberOfCoeffs(sg); i>0; i--) - funcCallKernel->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); - } - if (red_list) - insertReductionArgs(reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, funcCallKernel, red_blocks, has_red_array); - - for (int i = 0; i < acrossV; ++i) - { - if (options.isOn(RTC)) // across base is modifiable value - { - SgVarRefExp *toAdd = new SgVarRefExp(acrossBase[i]); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - } - else - funcCallKernel->addArg(*new SgVarRefExp(acrossBase[i])); - } - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgVarRefExp(loopBase[i])); - for (int i = 0; i < acrossV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i].len))); - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[i].len))); - - for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses - { - if (s->attributes() & USE_IN_BIT) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel - else - { // passing argument by reference to kernel - SgType *tp = NULL; - if (s->type()->hasBaseType()) - tp = s->type()->baseType(); - else - tp = s->type(); - e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); - funcCallKernel->addArg(*e); - sdev = sdev->next(); - } - } - createPrivatePointers(private_first, lnp, st_hedr, e_all_private_size); - if (options.isOn(C_CUDA) && private_first) // there are big private arrays - { - SgSymbol *sp; - for (sp = private_first, el = private_list, ln = 0; ln < lnp; sp = sp->next(), el = el->rhs(), ln++) - { - while (!IS_ARRAY(el->lhs()->symbol())) - el = el->rhs(); - s = el->lhs()->symbol(); - ae = new SgCastExp(*C_PointerType( C_Type(s->type()->baseType())), *new SgVarRefExp(sp)); - funcCallKernel->addArg(*ae); - if (!TestArrayShape(s)) - { - SgExpression **eatr = (SgExpression **) el->lhs()->attributeValue(0, DIM_SIZES); - SgExpression *ela; - for (ela = *eatr; ela; ela = ela->rhs()) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - eatr = (SgExpression **) el->lhs()->attributeValue(0, L_BOUNDS); - for (ela = *eatr; ela; ela = ela->rhs()) - funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(ela->lhs()->lhs()->symbol()))); - } - } - } - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); - funcCall->addArg(*new SgVarRefExp(M1)); - funcCall->addArg(*new SgVarRefExp(M2)); - - if (options.isOn(RTC)) // diag and SE are modifiable value - { - SgVarRefExp *toAdd = new SgVarRefExp(diag); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - - toAdd = new SgVarRefExp(SE); - toAdd->addAttribute(RTC_NOT_REPLACE); - funcCallKernel->addArg(*toAdd); - } - else - { - funcCallKernel->addArg(*new SgVarRefExp(diag)); - funcCallKernel->addArg(*new SgVarRefExp(SE)); - } - - funcCallKernel->addArg(*new SgVarRefExp(var1)); - funcCallKernel->addArg(*new SgVarRefExp(var2)); - funcCallKernel->addArg(*new SgVarRefExp(var3)); - funcCallKernel->addArg(*new SgVarRefExp(Emax)); - funcCallKernel->addArg(*new SgVarRefExp(Emin)); - funcCallKernel->addArg(*funcCall); - funcCallKernel->addArg(*new SgVarRefExp(M1) > *new SgVarRefExp(M2)); - - if (loopV > 0) - for (int i = 0; i < loopV; ++i) - funcCallKernel->addArg(*new SgVarRefExp(num_elems[i])); - - if (options.isOn(AUTO_TFM)) - { - for (size_t i = 0; i < dvm_array_headers.size(); ++i) - { - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(0))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(1))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(2))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(3))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(4))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(5))); - funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(6))); - funcCallKernel->addArg(*new SgVarRefExp(*outTypeOfTransformation[i])); - } - } - funcCallKernel->addArg(*new SgVarRefExp(type_of_run)); - for (int i = 0; i < acrossV + loopV; ++i) - funcCallKernel->addArg(*new SgArrayRefExp(*bIdxs, *new SgValueExp(i))); - } - - { - int idx[3]; - SgStatement *st1; - for (int i = 0; i < 3; ++i) - idx[i] = loopAcrossSymb[i].len; - - for (int i = 0; i < 3; ++i) - { - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M1), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); - f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[i]))); - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[i])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[i])))); - e = &(*funcCall + *new SgValueExp(1)); - - if (i == 0) - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M1), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); - else if (i == 1) - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M2), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); - else - st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M3), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); - st_end->insertStmtBefore(*st1, *st_hedr); - if (i == 0) - st1->addComment("// Count used variables"); - } - - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); - SgFunctionCallExp *f2 = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); - f1->addArg(*new SgVarRefExp(M1)); - f1->addArg(*new SgVarRefExp(M2)); - f2->addArg(*f1); - f2->addArg(*new SgVarRefExp(M3)); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(Allmin), *f2)); - st_end->insertStmtBefore(*stmt, *st_hedr); - - f2 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - f2->addArg(*new SgVarRefExp(M1) - *new SgVarRefExp(M2)); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(Emin), *f1)); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(Emax), *f1 + *f2 + *new SgValueExp(1))); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - // count num_elem_z - if (loopV > 0) - { - SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[0].len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[0].len)))); - tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[0].len))); - e = &SgAssignOp(*new SgVarRefExp(num_elems[0]), (*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (loopV > 1) - { - SgExpression **e_z = new SgExpression*[loopV - 1]; - for (int k = 0; k < loopV - 1; ++k) - { - SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[k + 1].len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[k + 1].len)))); - tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[k + 1].len))); - e_z[k] = &((*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); - } - - for (int k = 0; k < loopV - 1; ++k) - { - e = &SgAssignOp(*new SgVarRefExp(num_elems[k + 1]), *e_z[k]); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - if (k == 0) - e_z[0] = &(*new SgVarRefExp(num_elems[0]) * (*new SgVarRefExp(num_elems[k + 1]))); - else - e_z[0] = &(*(e_z[0]) * (*new SgVarRefExp(num_elems[k + 1]))); - } - - e = &SgAssignOp(*new SgVarRefExp(num_elems[loopV]), *e_z[0]); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - delete[]e_z; - } - else - { - e = &SgAssignOp(*new SgVarRefExp(num_elems[loopV]), *new SgVarRefExp(num_elems[0])); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); - if (loopV > 0) - { - funcCall->addArg(*new SgVarRefExp(num_elems[loopV]) / *new SgVarRefExp(*nums[2]) + SgNeqOp(*new SgVarRefExp(num_elems[loopV]) % *new SgVarRefExp(*nums[2]), *new SgValueExp(0))); - funcCall->addArg(*new SgVarRefExp(nums[1])); - funcCall->addArg(*new SgVarRefExp(nums[0])); - } - else - { - funcCall->addArg(*new SgVarRefExp(nums[0])); - funcCall->addArg(*new SgVarRefExp(nums[1])); - } - - e = &SgAssignOp(*new SgVarRefExp(s_blocks), *funcCall); - st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); - - if (red_list) - { - SgFunctionCallExp* f_m1 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); - SgFunctionCallExp* f_m2 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); - f_m1->addArg(*new SgVarRefExp(M1)); - f_m1->addArg(*new SgVarRefExp(M2)); - f_m2->addArg(*f_m1); - f_m2->addArg(*new SgVarRefExp(M3)); - - mywarn("strat: in red section"); - if (loopV == 0) - { - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), *new SgVarRefExp(Emin) * *f_m2); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - else if (loopV > 0) - { - e = &SgAssignOp(*new SgVarRefExp(*red_blocks), (*new SgVarRefExp(Emin) / *new SgVarRefExp(nums[0]) + - SgNeqOp(*new SgVarRefExp(Emin) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))) * - (*f_m2 / *new SgVarRefExp(nums[1]) + SgNeqOp(*f_m2 % *new SgVarRefExp(nums[1]), *new SgValueExp(0))) - * *new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[2]) * - *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *GetWarpSize(s_loop_ref)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_tmp_var_1), *new SgValueExp(1))); - st_end->insertStmtBefore(*stmt, *st_hedr); - - for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) - { - e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_tmp_var, red_blocks, s_tmp_var_1)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - mywarn(" end: out red section"); - } - - if (options.isOn(C_CUDA) && private_first) - { - SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); - SgFunctionCallExp *f2 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); - f1->addArg(*new SgVarRefExp(M1)); - f1->addArg(*new SgVarRefExp(M2)); - f2->addArg(*f1); - f2->addArg(*new SgVarRefExp(M3)); - e_totalThreads = &(*new SgVarRefExp(Emin) * *f2); - GetMemoryForPrivateArrays (private_first, s_loop_ref, lnp, st_end, st_hedr, e_totalThreads); - } - - int flag_comment = 0; - for (int i = 3; i < acrossV; ++i) - { - e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (i - 3 == 0) - { - stmt->addComment("// Start method"); - flag_comment = 1; - } - } - - if (acrossV == 3) - { - for (int i = 0; i < MIN(3, acrossV); ++i) - { - e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - if (i == 0 && flag_comment == 0) - stmt->addComment("// Start method"); - } - - for (int i = 0; i < loopV; ++i) - { - e = &SgAssignOp(*new SgVarRefExp(loopBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[i].len))); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - SgWhileStmt *main_while_st = NULL; - SgStatement *main_stmt = NULL; - bool first = true; - if (acrossV > 3) - { - SgWhileStmt *tmp; - for (int i = 3; i < acrossV; ++i) - { - e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgVarRefExp(acrossBase[i]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i].len))); - stmt = new SgCExpStmt(*e); - SgExpression *e1 = NULL; - SgFunctionCallExp *func = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - func->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i].len))); - e1 = &(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i].len)) / *func); - if (first) - { - main_while_st = new SgWhileStmt(*e1 * *new SgVarRefExp(acrossBase[i]) <= *e1 * *new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[i].len)), *stmt); - first = false; - } - else - { - tmp = new SgWhileStmt(*new SgVarRefExp(acrossBase[i]) <= *new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[i].len)), *stmt); - main_while_st->insertStmtAfter(*tmp); - main_while_st = tmp; - } - main_stmt = stmt; - } - st_end->insertStmtBefore(*main_while_st, *st_hedr); - - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(SE), *new SgValueExp(1))); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(1))); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(var1), *new SgValueExp(1))); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(var2), *new SgValueExp(0))); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(var3), *new SgValueExp(0))); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - for (int i = 0; i < MIN(3, acrossV); ++i) - { - e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i].len))); - stmt = new SgCExpStmt(*e); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - } - - for (int i = 0; i < loopV; ++i) - { - e = &SgAssignOp(*new SgVarRefExp(loopBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[i].len))); - stmt = new SgCExpStmt(*e); - main_stmt->insertStmtBefore(*stmt, *main_while_st); - } - } - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - - SgWhileStmt *while_st = new SgWhileStmt(*new SgVarRefExp(diag) <= *new SgVarRefExp(Allmin), *stmt); - if (acrossV == 3) - st_end->insertStmtBefore(*while_st, *st_hedr); - else - main_stmt->insertStmtBefore(*while_st, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[2]), *new SgVarRefExp(acrossBase[2]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[2].len))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt); - while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgVarRefExp(var1), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(var2), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(var3), *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - { // while for if block - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - - SgWhileStmt *while_st = new SgWhileStmt(SgNeqOp(*new SgVarRefExp(diag) - *new SgValueExp(1), *new SgVarRefExp(M3)), *stmt); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[2]), *new SgVarRefExp(acrossBase[2]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[2].len))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt, *while_st); - - while_st->insertStmtAfter(if_stSwap->copy(), *while_st); - while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - while_st->insertStmtAfter(if_stSwap->copy(), *while_st); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(Emin) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(Emin) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt); - - SgIfStmt *if_st = new SgIfStmt(*new SgVarRefExp(M3) > *new SgVarRefExp(Emin), *while_st); - if (acrossV == 3) - st_end->insertStmtBefore(*if_st, *st_hedr); - else - main_stmt->insertStmtBefore(*if_st, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(*diag), *new SgVarRefExp(*Allmin) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - if_st->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1].len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); - stmt = new SgCExpStmt(*e); - if_st->insertStmtAfter(*stmt); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1].len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); - stmt = new SgCExpStmt(*e); - if_st->insertStmtAfter(*stmt); - } - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(M3)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(Emin) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(Emin) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(SE), *new SgValueExp(2)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), (*new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len))) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + (*new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1].len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len))) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1].len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[2]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[2].len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[2].len)) * (*new SgVarRefExp(M3) - *new SgValueExp(1))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(SE), *new SgVarRefExp(SE) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - - while_st = new SgWhileStmt(SgNeqOp(*new SgVarRefExp(M1) + *new SgVarRefExp(M2) - *new SgVarRefExp(Allmin), *new SgVarRefExp(SE) - *new SgValueExp(1)), *stmt); - if (acrossV == 3) - st_end->insertStmtBefore(*while_st, *st_hedr); - else - main_stmt->insertStmtBefore(*while_st, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt, *while_st); - - while_st->insertStmtAfter(if_stSwap->copy(), *while_st); - while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - while_st->insertStmtAfter(if_stSwap->copy(), *while_st); - - e = &SgAssignOp(*new SgVarRefExp(var1), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(var2), *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(var3), *new SgValueExp(0)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(Allmin) - *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0].len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0].len)) * (*new SgVarRefExp(M1) - *new SgValueExp(1))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1].len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2)) + *new SgVarRefExp(acrossBase[1]) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2))); - stmt = new SgCExpStmt(*e); - if (acrossV == 3) - st_end->insertStmtBefore(*stmt, *st_hedr); - else - main_stmt->insertStmtBefore(*stmt, *main_while_st); - - { // if block - funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcCall->addArg(*new SgVarRefExp(*Emin) - *new SgVarRefExp(M3)); - SgExpression *e1 = NULL, *e2 = NULL; - SgIfStmt *if_st1 = NULL; - - e1 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) + *new SgVarRefExp(*Emax) - *new SgVarRefExp(*Emin) - *new SgValueExp(1)); - e2 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) - *new SgVarRefExp(*Emax) + *new SgVarRefExp(*Emin) + *new SgValueExp(1)); - - if_st1 = new SgIfStmt(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) > *new SgValueExp(0), *new SgCExpStmt(*e1), *new SgCExpStmt(*e2)); - - SgIfStmt *if_st = new SgIfStmt(*new SgVarRefExp(*M1) <= *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) > *new SgVarRefExp(*Emin), *if_st1); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len))); - stmt = new SgCExpStmt(*e); - if_st = new SgIfStmt(*new SgVarRefExp(*M1) > *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) > *new SgVarRefExp(*Emin), *stmt, *if_st); - - e1 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) + *new SgVarRefExp(*Emax) - *new SgVarRefExp(*Emin) - *new SgValueExp(1) + *funcCall); - e2 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) - *new SgVarRefExp(*Emax) + *new SgVarRefExp(*Emin) + *new SgValueExp(1) + *new SgVarRefExp(M3) - *new SgVarRefExp(*Emin)); - - if_st1 = new SgIfStmt(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) > *new SgValueExp(0), *new SgCExpStmt(*e1), *new SgCExpStmt(*e2)); - - if_st = new SgIfStmt(*new SgVarRefExp(*M1) <= *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) <= *new SgVarRefExp(*Emin), *if_st1, *if_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) + *funcCall); - stmt = new SgCExpStmt(*e); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) + *funcCall * *new SgValueExp(-1)); - SgStatement* stmtElse = new SgCExpStmt(*e); - - if_st1 = new SgIfStmt(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len)) > *new SgValueExp(0), *stmt, *stmtElse); - - if_st = new SgIfStmt(*new SgVarRefExp(*M1) > *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) <= *new SgVarRefExp(*Emin), *if_st1, *if_st); - - if (acrossV == 3) - st_end->insertStmtBefore(*if_st, *st_hedr); - else - main_stmt->insertStmtBefore(*if_st, *main_while_st); - } - - e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) - *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - - while_st = new SgWhileStmt(SgNeqOp(*new SgVarRefExp(diag), *new SgValueExp(0)), *stmt); - if (acrossV == 3) - st_end->insertStmtBefore(*while_st, *st_hedr); - else - main_stmt->insertStmtBefore(*while_st, *main_while_st); - - e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1].len))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt, *while_st); - - e = &SgAssignOp(*new SgVarRefExp(SE), *new SgVarRefExp(SE) + *new SgValueExp(1)); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt, *while_st); - while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt, *while_st); - - e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); - stmt = new SgCExpStmt(*e); - while_st->insertStmtAfter(*stmt, *while_st); - } - - // !!! Global for all cases !!! - if (red_list) - { - ln = 0; - for (er = red_list; er; er = er->rhs(), ++ln) - { - //SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference - num = RedFuncNumber(er->lhs()->lhs()); // type of reduction - - e = &SgAssignOp(*new SgVarRefExp(*s_tmp_var), *new SgValueExp(ln+1)); - stmt = new SgCExpStmt(*e); - st_end->insertStmtBefore(*stmt, *st_hedr); - - stmt = new SgCExpStmt(*FinishReduction(s_loop_ref, s_tmp_var)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - } - // to dispose private arrays - if (options.isOn(C_CUDA) && PrivateArrayClassUse(e_all_private_size)) - for (s = private_first, ln = 0; ln < lnp; s = s->next(), ln++) // private arrays - { - stmt = new SgCExpStmt(*DisposePrivateArray(s_loop_ref, s)); - st_end->insertStmtBefore(*stmt, *st_hedr); - } - - // create args for kernel and return it - vector argsKernel(countKernels); - const int rtTypes[] = { rt_INT, rt_LLONG }; - - for (unsigned ck = 0; ck < countKernels; ++ck) - { - argsKernel[ck].st_header = st_hedr; - argsKernel[ck].cond_ = NULL; - - SgType *typeParams = indexTypeInKernel(rtTypes[ck]); - - if (acrossV == 1) - { - char *cond_ = new char[strlen("cond_") + strlen(loopAcrossSymb[0].symb->identifier()) + 1]; - cond_[0] = '\0'; - strcat(cond_, "cond_"); - strcat(cond_, loopAcrossSymb[0].symb->identifier()); - argsKernel[ck].cond_ = new SgSymbol(VARIABLE_NAME, cond_, typeParams, st_hedr); - - char *st = new char[strlen("steps_") + strlen(loopAcrossSymb[0].symb->identifier()) + 1]; - st[0] = '\0'; - strcat(st, "steps_"); - strcat(st, loopAcrossSymb[0].symb->identifier()); - argsKernel[ck].steps.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(st), typeParams, st_hedr)); - for (int i = 0; i < loopV; ++i) - { - st = new char[strlen("steps_") + strlen(loopSymb[i].symb->identifier()) + 1]; - st[0] = '\0'; - strcat(st, "steps_"); - strcat(st, loopSymb[i].symb->identifier()); - argsKernel[ck].steps.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(st), typeParams, st_hedr)); - } - } - - if (acrossV != 1 && options.isOn(AUTO_TFM)) - { - char *tmpS = new char[64]; - for (size_t i = 0; i < dvm_array_headers.size(); ++i) - { - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_x_axis"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_offset_x"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_Rx"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_y_axis"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_offset_y"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_Ry"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - tmpS[0] = '\0'; - strcat(tmpS, dvm_array_headers[i]); - strcat(tmpS, "_slash"); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(outTypeOfTransformation[i]->identifier()), typeParams, st_hedr)); - } - argsKernel[ck].arrayNames = dvm_array_headers; - } - - if (acrossV == 2) - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_elem_across"), typeParams, st_hedr)); - else if (acrossV >= 3) - { - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("max_z"), typeParams, st_hedr)); - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("SE"), typeParams, st_hedr)); // SE - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var1"), typeParams, st_hedr)); // var1 - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var2"), typeParams, st_hedr)); // var2 - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var3"), typeParams, st_hedr)); // var3 - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emax"), typeParams, st_hedr)); // Emax - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emin"), typeParams, st_hedr)); // Emin - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("min_ij"), typeParams, st_hedr)); - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("swap_ij"), typeParams, st_hedr)); - } - - char *str = new char[32]; - for (int i = 0; i < acrossV; ++i) - { - argsKernel[ck].acrossS.push_back(new SgSymbol(VARIABLE_NAME, acrossBase[i]->identifier(), typeParams, st_hedr)); // acrossBase[i] - argsKernel[ck].symb.push_back(loopAcrossSymb[i]); - strcpy(str, "step"); - strcat(str, strchr(acrossBase[i]->identifier(), '_')); - argsKernel[ck].idxAcross.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(str), typeParams, st_hedr)); - } - for (int i = 0; i < loopV; ++i) - { - argsKernel[ck].notAcrossS.push_back(new SgSymbol(VARIABLE_NAME, loopBase[i]->identifier(), typeParams, st_hedr)); // loopBase[i] - argsKernel[ck].nSymb.push_back(loopSymb[i]); - strcpy(str, "step"); - strcat(str, strchr(loopBase[i]->identifier(), '_')); - argsKernel[ck].idxNotAcross.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(str), typeParams, st_hedr)); - strcpy(str, "num_elem"); - strcat(str, strchr(loopBase[i]->identifier(), '_')); - argsKernel[ck].sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(str), typeParams, st_hedr)); - } - - if (acrossV == 1 || acrossV == 2 || acrossV >= 3) - { - argsKernel[ck].otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("type_of_run"), typeParams, st_hedr)); - char *t = new char[32]; - for (int i = 0; i < acrossV + loopV; ++i) - { - char p[8]; - sprintf(p, "%d", i); - t[0] = '\0'; - strcat(t, "idxs_"); - strcat(t, p); - argsKernel[ck].baseIdxsInKer.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(t), typeParams, st_hedr)); - } - delete[]t; - } - - delete[]str; - - } - // end of creation args for kernel - - delete[]reduction_loc_ptr; - delete[]reduction_loc_symb; - delete[]reduction_ptr; - delete[]reduction_symb; - delete[]num_elems; - mywarn(" end Adapter Function"); - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(st_hedr, s_loop_ref, 0); - return argsKernel; -} - - -void MakeDeclarationsForKernel_On_C_Across(SgType *indexType) -{ - // declare do_variables - DeclareDoVars(indexType); - - // declare private(local in kernel) variables - DeclarePrivateVars(indexType); - - // declare variables, used in loop and passed by reference: - // & = *p_; - DeclareUsedVars(); -} - -void MakeDeclarationsForKernelAcross(SgType *indexType) -{ -#if debugMode - mywarn("strat: MakeDeclarations Function"); -#endif - - // declare do_variables - DeclareDoVars(); - - // declare private(local in kernel) variables - DeclarePrivateVars(indexType); - - // declare dummy arguments: - - // declare reduction dummy arguments - DeclareDummyArgumentsForReductions(NULL, indexType); - - // declare array coefficients - DeclareArrayCoeffsInKernel(indexType); - - // declare bases for arrays - DeclareArrayBases(); - - // declare variables, used in loop - DeclareUsedVars(); - -#if debugMode - mywarn(" end: MakeDeclarations Function"); -#endif -} - -SgExpression *CreateKernelDummyListAcross(ArgsForKernel *argsKer, SgType *idxTypeInKernel) //SgSymbol *s_red_count_k, -{ -#if debugMode - mywarn("strat: CreateKernelDummyListAcross Function"); -#endif - - SgExpression *arg_list, *ae; - arg_list = NULL; - - arg_list = AddListToList(CreateArrayDummyList(idxTypeInKernel), CreateRedDummyList(idxTypeInKernel)); - // base_ref + ... - // + [+red_var_2+...+red_var_M] + _grid [ + ...] - - // + 'blocks' - if (argsKer->symb.size() < 3) - { - for (int it = 0; it < argsKer->sizeVars.size(); ++it) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(argsKer->sizeVars[it]))); - } - - for (int it = 0; it < argsKer->acrossS.size(); ++it) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(argsKer->acrossS[it]))); - - for (int it = 0; it < argsKer->notAcrossS.size(); ++it) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(argsKer->notAcrossS[it]))); - - for (int it = 0; it < argsKer->idxAcross.size(); ++it) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(argsKer->idxAcross[it]))); - - for (int it = 0; it < argsKer->idxNotAcross.size(); ++it) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(argsKer->idxNotAcross[it]))); - - if (uses_list) - arg_list = AddListToList(arg_list, CreateUsesDummyList()); //[+ ] - - if (private_list) - arg_list = AddListToList(arg_list, CreatePrivateDummyList()); //[+ dummys for private arrays ] - - if (argsKer->symb.size() >= 3) - for (int it = 0; it < argsKer->sizeVars.size(); ++it) - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(argsKer->sizeVars[it]))); - - if (argsKer->acrossS.size() != 1) - { - for (size_t i = 0; i < argsKer->otherVars.size(); ++i) - { - ae = new SgExprListExp(*new SgVarRefExp(argsKer->otherVars[i])); - arg_list = AddListToList(arg_list, ae); - } - } - else if (argsKer->otherVars.size() != 0) - { - ae = new SgExprListExp(*new SgVarRefExp(argsKer->otherVars[argsKer->otherVars.size() - 1])); - arg_list = AddListToList(arg_list, ae); - } - - for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) - { - ae = new SgExprListExp(*new SgVarRefExp(argsKer->baseIdxsInKer[i])); - arg_list = AddListToList(arg_list, ae); - } - - if (argsKer->cond_ != NULL && options.isOn(GPU_O0)) - { - SgSymbol *tmp = argsKer->cond_; - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(tmp))); - - for (size_t i = 0; i < argsKer->steps.size(); ++i) - { - SgSymbol *tmp = argsKer->steps[i]; - arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(tmp))); - } - } - -#if debugMode - mywarn(" end: CreateKernelDummyListAcross Function"); -#endif - - return arg_list; -} - -SgStatement *CreateLoopKernelAcross(SgSymbol *skernel, ArgsForKernel* argsKer, SgType *idxTypeInKernel) -{ -#if debugMode - mywarn("strat: CreateLoopKernelAcross"); -#endif - - ACROSS_MOD_IN_KERNEL = 1; - -#if kerneloff - return NULL; -#endif - - int nloop = 0; - SgStatement *st = NULL, *st_end = NULL; - SgExpression *fe = NULL; - SgSymbol *tid = NULL, *s_red_count_k = NULL; - SgIfStmt *if_st = NULL; - SgType *longType = idxTypeInKernel; - - if (!skernel) - return(NULL); - nloop = ParLoopRank(); - - // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda - // creating Header and End Statement of Kernel - if (options.isOn(C_CUDA)) - { - kernel_st = Create_C_Kernel_Function(skernel); - fe = kernel_st->expr(0); - } - else - kernel_st = CreateKernelProcedure(skernel); - - kernel_st->addComment(LoopKernelComment()); - - st_end = kernel_st->lexNext(); - cur_in_kernel = st = kernelScope = kernel_st; - - // !!creating variables and making structures for reductions - CompleteStructuresForReductionInKernel(); - - if (red_list) - s_red_count_k = RedCountSymbol(kernel_st); - - // create dummy argument list of kernel: - if (options.isOn(C_CUDA)) - fe->setLhs(CreateKernelDummyListAcross(argsKer, longType)); //s_red_count_k, - else - // create dummy argument list and add it to kernel header statement (Fortran-Cuda) - kernel_st->setExpression(0, *CreateKernelDummyListAcross(argsKer, longType)); //s_red_count_k, - - // generating block of index variables calculation - -#if debugMode - mywarn("start: block4"); -#endif - - tid = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_x"), *longType, *cur_in_kernel); - - if (options.isOn(C_CUDA)) - st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, "x")) * - *new SgRecordRefExp(*s_blockdim, "x") + *new SgRecordRefExp(*s_threadidx, "x")); - else - st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, "x") - *new SgValueExp(1)) * - *new SgRecordRefExp(*s_blockdim, "x") + *new SgRecordRefExp(*s_threadidx, "x") - *new SgValueExp(1)); - - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - - size_t size = argsKer->otherVarsForOneTh.size(); - size_t size1 = argsKer->otherVars.size(); - SgForStmt *for_st = NULL, *inner_for_st = NULL; - SgFunctionCallExp *funcAbs = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcAbs->addArg(*new SgVarRefExp(argsKer->otherVars[size1 - 1])); - SgExpression *sign = &(*new SgVarRefExp(argsKer->otherVars[size1 - 1]) / *funcAbs); - - if (options.isOn(C_CUDA)) - for_st = new SgForStmt(&SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]), *new SgVarRefExp(argsKer->otherVars[size1 - 3])), &(*sign * *new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]) <= *sign * *new SgVarRefExp(argsKer->otherVars[size1 - 2])), &SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]), *new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]) + *new SgVarRefExp(argsKer->otherVars[size1 - 1])), NULL); - else - for_st = new SgForStmt(argsKer->otherVarsForOneTh[size - 1], new SgVarRefExp(argsKer->otherVars[size1 - 3]), new SgVarRefExp(argsKer->otherVars[size1 - 2]), new SgVarRefExp(argsKer->otherVars[size1 - 1]), NULL); - inner_for_st = for_st; - - for (int i = size - 2; i >= 0; i--) - { - SgForStmt *tmp = for_st; - funcAbs = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - funcAbs->addArg(*new SgVarRefExp(argsKer->otherVars[3 * i + 2])); - sign = &(*new SgVarRefExp(argsKer->otherVars[3 * i + 2]) / *funcAbs); - - if (options.isOn(C_CUDA)) - for_st = new SgForStmt(&SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[i]), *new SgVarRefExp(argsKer->otherVars[3 * i])), &(*sign * *new SgVarRefExp(argsKer->otherVarsForOneTh[i]) <= *sign * *new SgVarRefExp(argsKer->otherVars[3 * i + 1])), &(SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[i]), *new SgVarRefExp(argsKer->otherVarsForOneTh[i]) + *new SgVarRefExp(argsKer->otherVars[3 * i + 2]))), NULL); - else - for_st = new SgForStmt(argsKer->otherVarsForOneTh[i], new SgVarRefExp(argsKer->otherVars[3 * i]), new SgVarRefExp(argsKer->otherVars[3 * i + 1]), new SgVarRefExp(argsKer->otherVars[3 * i + 2]), NULL); - for_st->insertStmtAfter(*tmp); - } - - if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(*tid), *new SgValueExp(0)), *for_st); - cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); - -#if debugMode - mywarn(" end: block4"); - mywarn("start: block5"); -#endif - - // generating assign statements for MAXLOC, MINLOC reduction operations - if (red_list) - Do_Assign_For_Loc_Arrays(); - - // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables - -#if debugMode - mywarn(" end: block5"); - mywarn("strat: inserting loop body"); -#endif - - vector forDeclarationInKernel; - - - { - SgStatement *stk, *last; - block = CreateIfForRedBlack(loop_body, nloop); - last = inner_for_st->lastNodeOfStmt(); - inner_for_st->insertStmtAfter(*block); //cur_in_kernel is innermost IF statement - - if (options.isOn(C_CUDA)) - { - if (block->comments() == NULL) - block->addComment("// Loop body"); - } - else - block->addComment("! Loop body\n"); - - // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) - if (block != loop_body) - stk = last->lexPrev()->lexPrev(); - else - stk = last->lexPrev(); - - if (stk->variant() == CONTROL_END) - { - if (stk->hasLabel() || stk == loop_body) // when body of DO_ENDDO loop is empty, stk == loop_body - stk->setVariant(CONT_STAT); - else - { - st = stk->lexPrev(); - stk->extractStmt(); - stk = st; - } - } - - ReplaceExitCycleGoto(block, stk); - - for_kernel = 1; - last = cur_st; - - TranslateBlock(inner_for_st); - if (options.isOn(C_CUDA)) - { - //get info of arrays in private and locvar lists - swapDimentionsInprivateList(); - vector < stack < SgStatement*> > zero = vector < stack < SgStatement*> >(0); - Translate_Fortran_To_C(inner_for_st, inner_for_st->lastNodeOfStmt(), zero, 0); - } - - cur_st = last; - createBodyKernel = false; - } - -#if debugMode - mywarn(" end: inserting loop body"); - mywarn("start: create reduction block"); -#endif - - if (red_list) - { - int num; - reduction_operation_list *tmp_list = red_struct_list; - for (SgExpression *er = red_list; er; er = er->rhs()) - { - num = 0; - SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference - num = RedFuncNumber(er->lhs()->lhs()); // type of reduction - - SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); - redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); - - st = AssignStatement(*new SgArrayRefExp(*redGrid, *new SgValueExp(0)), red_expr_ref->copy()); - if_st->lastExecutable()->insertStmtAfter(*st); - tmp_list = tmp_list->next; - } - } -#if debugMode - mywarn(" end: create reduction block"); -#endif - - // make declarations - if (options.isOn(C_CUDA)) - MakeDeclarationsForKernel_On_C_Across(idxTypeInKernel); - else // Fortran-Cuda - MakeDeclarationsForKernelAcross(idxTypeInKernel); - for_kernel = 0; - - kernel_st->insertStmtAfter(*tid->makeVarDeclStmt()); - - if (!options.isOn(C_CUDA)) - { - for (size_t i = 0; i < argsKer->otherVars.size(); ++i) - { - st = argsKer->otherVars[i]->makeVarDeclStmt(); - st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); - kernel_st->insertStmtAfter(*st); - } - } -#if debugMode - mywarn(" end: CreateLoopKernelAcross"); -#endif - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(kernel_st, skernel, 1); - ACROSS_MOD_IN_KERNEL = 0; - return kernel_st; -} - -static SgStatement* makeBlockIdxAssigment(SgSymbol* tid, const char* XYZ) -{ - SgStatement* st = NULL; - if (options.isOn(C_CUDA)) - st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, XYZ)) * - *new SgRecordRefExp(*s_blockdim, XYZ) + *new SgRecordRefExp(*s_threadidx, XYZ)); - else - st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, XYZ) - *new SgValueExp(1)) * - *new SgRecordRefExp(*s_blockdim, XYZ) + *new SgRecordRefExp(*s_threadidx, XYZ) - *new SgValueExp(1)); - - return st; -} - -static void createDeclaration(SgSymbol* toDecl) -{ - SgStatement* st = toDecl->makeVarDeclStmt(); - st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); - kernel_st->insertStmtAfter(*st); -} - -static void createDeclaration(const vector& toDecl) -{ - for (int it = 0; it < toDecl.size(); ++it) - createDeclaration(toDecl[it]); -} - -SgStatement *CreateLoopKernelAcross(SgSymbol *skernel, ArgsForKernel* argsKer, int acrossNum, SgType *idxTypeInKernel) -{ -#if debugMode - mywarn("strat: CreateLoopKernelAcross"); -#endif - - ACROSS_MOD_IN_KERNEL = 1; - -#if kerneloff - return NULL; -#endif - - int nloop; - SgStatement *st = NULL, *st_end = NULL; - SgExpression *e = NULL, *fe = NULL; - SgSymbol *tid = NULL, *tid1 = NULL, *tid2 = NULL, *s_red_count_k = NULL, *coords = NULL; - SgIfStmt *if_st = NULL, *if_st1 = NULL, *if_st2 = NULL; - SgForStmt *mainFor = NULL; - SgSymbol *tmpvar1 = NULL; - SgExpression **leftExprs, **rightExprs; - SgType *longType = idxTypeInKernel; - - if (!skernel) - return(NULL); - nloop = ParLoopRank(); - - // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda - // creating Header and End Statement of Kernel - if (options.isOn(C_CUDA)) - { - kernel_st = Create_C_Kernel_Function(skernel); - fe = kernel_st->expr(0); - } - else - kernel_st = CreateKernelProcedure(skernel); - - if (!options.isOn(C_CUDA) && createConvert_XY && options.isOn(AUTO_TFM)) - { - kernel_st->addComment("!------------- dvmh_convert_XY() function ------------\n"); - kernel_st->addComment(funcDvmhConvXYfortVerLong); - kernel_st->addComment(funcDvmhConvXYfortVer); - - createConvert_XY = false; - } - kernel_st->addComment(LoopKernelComment()); - - st_end = kernel_st->lexNext(); - cur_in_kernel = st = kernelScope = kernel_st; - - // !!creating variables and making structures for reductions - CompleteStructuresForReductionInKernel(); //CompleteStructuresForReductionInKernelAcross(); - - if (red_list) - s_red_count_k = RedCountSymbol(kernel_st); - - // create dummy argument list of kernel: - if (options.isOn(C_CUDA)) - fe->setLhs(CreateKernelDummyListAcross(argsKer, idxTypeInKernel)); // s_red_count_k, - else - // create dummy argument list and add it to kernel header statement (Fortran-Cuda) - kernel_st->setExpression(0, *CreateKernelDummyListAcross(argsKer, idxTypeInKernel)); // s_red_count_k, - - // generating block of index variables calculation - -#if debugMode - mywarn("start: block4"); -#endif - - SgArrayType *tpArr = new SgArrayType(*longType); - SgValueExp *dimSize = new SgValueExp((int)(argsKer->symb.size() + argsKer->nSymb.size())); - tpArr->addDimension(dimSize); - - coords = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("coords"), *longType, *cur_in_kernel); - coords->setType(tpArr); - - tid = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_x"), *longType, *cur_in_kernel); - if (argsKer->symb.size() < 3) - { - if (argsKer->nSymb.size() == 1) - tid1 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_y"), *longType, *cur_in_kernel); - else if (argsKer->nSymb.size() >= 2) - { - tid1 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_y"), *longType, *cur_in_kernel); - tid2 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_z"), *longType, *cur_in_kernel); - } - } - else if (argsKer->symb.size() >= 3) - { - tid1 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_y"), *longType, *cur_in_kernel); - if (argsKer->nSymb.size() > 0) - tid2 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_z"), *longType, *cur_in_kernel); - } - - st = makeBlockIdxAssigment(tid, "x"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - - if (argsKer->symb.size() == 1) - { - if (argsKer->nSymb.size() == 2) - { - st = makeBlockIdxAssigment(tid1, "y"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - } - else if (argsKer->nSymb.size() >= 3) - { - st = makeBlockIdxAssigment(tid1, "y"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - - st = makeBlockIdxAssigment(tid2, "z"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - } - } - else if (argsKer->symb.size() == 2) - { - if (argsKer->nSymb.size() == 1) - { - st = makeBlockIdxAssigment(tid1, "y"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - } - else if (argsKer->nSymb.size() >= 2) - { - st = makeBlockIdxAssigment(tid1, "y"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - - st = makeBlockIdxAssigment(tid2, "z"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - } - } - else if (argsKer->symb.size() >= 3) - { - st = makeBlockIdxAssigment(tid1, "y"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - - if (argsKer->nSymb.size() > 0) - { - st = makeBlockIdxAssigment(tid2, "z"); - cur_in_kernel->insertStmtAfter(*st, *kernel_st); - cur_in_kernel = st; - } - } - -#if debugMode - mywarn(" end: block4"); - mywarn("start: block5"); -#endif - - if (argsKer->symb.size() == 1) // body for 1 dependence - { - int idx_exprs = 0; - int count_of_dims = argsKer->nSymb.size() + argsKer->symb.size(); - - vector::iterator itAcr = argsKer->symb.begin(); - vector::iterator it = argsKer->nSymb.begin(); - vector::iterator itAcrS = argsKer->acrossS.begin(); - vector::iterator itS = argsKer->notAcrossS.begin(); - vector::iterator it_sizeV = argsKer->sizeVars.begin(); - vector::iterator itIdxAcr = argsKer->idxAcross.begin(); - vector::iterator itIdx = argsKer->idxNotAcross.begin(); - - - leftExprs = new SgExpression*[count_of_dims]; - rightExprs = new SgExpression*[count_of_dims]; - - e = &(*new SgVarRefExp(*itAcrS)); - st = AssignStatement(*new SgVarRefExp((*itAcr).symb), *e); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*itAcr).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS)); - idx_exprs++; - - if (argsKer->nSymb.size() == 1) - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - } - else if (argsKer->nSymb.size() == 2) - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itIdx++; - itS++; - - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itIdx++; - itS++; - } - else if (argsKer->nSymb.size() >= 3) - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itIdx++; - itS++; - - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itIdx++; - itS++; - - SgExpression *e_z1, *e_z2, *tmp_exp; - it_sizeV = argsKer->sizeVars.begin(); - it_sizeV++; - it_sizeV++; - if (argsKer->nSymb.size() > 3) - { - SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); - e_z1 = new SgVarRefExp(*it_sizeV); - funCall->addArg(*new SgVarRefExp(*tid2)); - funCall->addArg(*e_z1); - tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - - st = AssignStatement(*new SgVarRefExp((*it).symb), *tmp_exp); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itS++; - itIdx++; - it_sizeV++; - e_z2 = new SgVarRefExp(*it_sizeV); - it_sizeV++; - for (unsigned i = 0; i < argsKer->nSymb.size() - 3; ++i, it++, itS++, itIdx++) - { - SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); - if (i == argsKer->nSymb.size() - 4) - tmp_exp = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); - else - { - funCall->addArg((*new SgVarRefExp(*tid2) / *e_z1)); - funCall->addArg(*e_z2); - tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - } - - st = AssignStatement(*new SgVarRefExp((*it).symb), *tmp_exp); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(tmp_exp->copy()); - idx_exprs++; - - e_z1 = &(*e_z1 * *e_z2); - if (i != argsKer->nSymb.size() - 4) - { - e_z2 = new SgVarRefExp(*it_sizeV); - it_sizeV++; - } - } - } - else - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = &(*new SgVarRefExp((*it).symb)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itIdx++; - itS++; - } - } - - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])), &(rightExprs[0]->copy())); - else - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), &(rightExprs[0]->copy())); - - // main IF - it_sizeV = argsKer->sizeVars.begin(); - if (argsKer->nSymb.size() == 0) - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgValueExp(1), *st); - else if (argsKer->nSymb.size() == 1) - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(*it_sizeV), *st); - else if (argsKer->nSymb.size() == 2) - { - SgSymbol *tmp = *it_sizeV; - it_sizeV++; - SgSymbol *tmp1 = *it_sizeV; - - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && - *new SgVarRefExp(*tid1) < *new SgVarRefExp(tmp1), *st); - } - else if (argsKer->nSymb.size() >= 3) - { - SgSymbol *tmp = *it_sizeV; - it_sizeV++; - SgSymbol *tmp1 = *it_sizeV; - it_sizeV++; - - SgExpression *if_mult = NULL; - for (unsigned i = 0; i < argsKer->nSymb.size() - 2; ++i) - { - if (i == 0) - if_mult = new SgVarRefExp(*it_sizeV); - else - if_mult = &((*if_mult) * *new SgVarRefExp(*it_sizeV)); - it_sizeV++; - } - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && - *new SgVarRefExp(*tid1) < *new SgVarRefExp(tmp1) && *new SgVarRefExp(*tid2) < *if_mult, *st); - } - - for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i])), &(rightExprs[i]->copy())); - else - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i]) + *new SgValueExp(1)), &(rightExprs[i]->copy())); - if_st->lastExecutable()->insertStmtAfter(*st); - } - - for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i)))); - else - st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i + 1)))); - if_st->lastExecutable()->insertStmtAfter(*st); - } - - if (options.isOn(GPU_O0)) - { - SgSymbol *cond_s = argsKer->cond_; - tmpvar1 = new SgSymbol(VARIABLE_NAME, "tmpV"); - SgExprListExp *listAss = new SgExprListExp(); - SgExprListExp *tmp = listAss; - listAss->setLhs(&SgAssignOp(leftExprs[0]->copy(), (*(&leftExprs[0]->copy())) + *new SgVarRefExp(argsKer->steps[0]))); - for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) - { - tmp->setRhs(new SgExprListExp()); - tmp = (SgExprListExp*)tmp->rhs(); - tmp->setLhs(&SgAssignOp(leftExprs[i]->copy(), (*(&leftExprs[i]->copy())) + *new SgVarRefExp(argsKer->steps[i]))); - } - tmp->setRhs(new SgExprListExp()); - tmp = (SgExprListExp*)tmp->rhs(); - tmp->setLhs(&SgAssignOp(*new SgVarRefExp(tmpvar1), *new SgVarRefExp(tmpvar1) + *new SgValueExp(1))); - - if (options.isOn(C_CUDA)) - mainFor = new SgForStmt(&SgAssignOp(*new SgVarRefExp(tmpvar1), *new SgValueExp(1)), &(*new SgVarRefExp(tmpvar1) <= *new SgVarRefExp(*cond_s)), listAss, NULL); - else - mainFor = new SgForStmt(tmpvar1, &(rightExprs[0]->copy()), new SgVarRefExp(cond_s), new SgVarRefExp(*itIdxAcr), NULL); - if_st->lastExecutable()->insertStmtAfter(*mainFor); - } - - cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); - if (options.isOn(GPU_O0)) - cur_in_kernel = mainFor->lastExecutable(); - else - cur_in_kernel = if_st->lastExecutable(); - - if (!options.isOn(C_CUDA) && options.isOn(GPU_O0)) - { - for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) - mainFor->lastExecutable()->insertStmtAfter(*AssignStatement(*&leftExprs[i]->copy(), (*(&leftExprs[i]->copy())) + *new SgVarRefExp(argsKer->steps[i])), *mainFor); - } - - delete []leftExprs; - delete []rightExprs; - } - else if (argsKer->symb.size() == 2) // body for 2 dependence - { - // attention!! adding to support all variants!! - if (argsKer->nSymb.size() != 0) - { - SgSymbol *tmp = tid1; - tid1 = tid; - tid = tmp; - } - - SgExpression **leftExprs, **rightExprs; - int idx_exprs = 0; - int count_of_dims = argsKer->nSymb.size() + argsKer->symb.size(); - leftExprs = new SgExpression*[count_of_dims]; - rightExprs = new SgExpression*[count_of_dims]; - - vector::iterator itAcr = argsKer->symb.begin(); - vector::iterator it = argsKer->nSymb.begin(); - vector::iterator itAcrS = argsKer->acrossS.begin(); - vector::iterator itS = argsKer->notAcrossS.begin(); - vector::iterator it_sizeV = argsKer->sizeVars.begin(); - vector::iterator itIdxAcr = argsKer->idxAcross.begin(); - vector::iterator itIdx = argsKer->idxNotAcross.begin(); - - e = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); - st = AssignStatement(*new SgVarRefExp((*itAcr).symb), *e); - leftExprs[idx_exprs] = new SgVarRefExp((*itAcr).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); - idx_exprs++; - - itAcr++; - itAcrS++; - itIdxAcr++; - - e = &(*new SgVarRefExp(*itAcrS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); - st = AssignStatement(*new SgVarRefExp((*itAcr).symb), *e); - leftExprs[idx_exprs] = new SgVarRefExp((*itAcr).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); - idx_exprs++; - - itAcr++; - itAcrS++; - itIdxAcr++; - - if (argsKer->nSymb.size() == 1) - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * - *new SgVarRefExp(*itIdx)); - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - } - else if (argsKer->nSymb.size() >= 2) - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * - *new SgVarRefExp(*itIdx)); - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itIdx++; - itS++; - - SgExpression *e_z1, *e_z2, *tmp_exp; - it_sizeV = argsKer->sizeVars.begin(); - it_sizeV++; - it_sizeV++; - if (argsKer->nSymb.size() > 2) - { - SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); - e_z1 = new SgVarRefExp(*it_sizeV); - funCall->addArg(*new SgVarRefExp(*tid2)); - funCall->addArg(*e_z1); - tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - - st = AssignStatement(*new SgVarRefExp((*it).symb), *tmp_exp); - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itS++; - itIdx++; - it_sizeV++; - e_z2 = new SgVarRefExp(*it_sizeV); - it_sizeV++; - for (; it != argsKer->nSymb.end(); it++, itS++, itIdx++) - { - SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); - it++; - if (it == argsKer->nSymb.end()) - { - tmp_exp = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); - } - else - { - funCall->addArg((*new SgVarRefExp(*tid2) / *e_z1)); - funCall->addArg(*e_z2); - tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - } - it--; - - st = AssignStatement(*new SgVarRefExp((*it).symb), *tmp_exp); - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - idx_exprs++; - - e_z1 = &(*e_z1 * *e_z2); - it++; - if (it != argsKer->nSymb.end()) - { - e_z2 = new SgVarRefExp(*it_sizeV); - it_sizeV++; - } - it--; - } - } - else - for (; it != argsKer->nSymb.end(); it++, itS++, itIdx++) - { - st = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * - *new SgVarRefExp(*itIdx)); - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - } - } - - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])), &(rightExprs[0]->copy())); - else - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), &(rightExprs[0]->copy())); - // main IF - it_sizeV = argsKer->sizeVars.begin(); - if (argsKer->nSymb.size() == 0) - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(*it_sizeV), *st); - else if (argsKer->nSymb.size() == 1) - { - SgSymbol *tmp = *it_sizeV; - it_sizeV++; - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && - *new SgVarRefExp(*tid1) < *new SgVarRefExp(*it_sizeV), *st); - } - else if (argsKer->nSymb.size() >= 2) - { - SgExpression *tmp_exp; - SgSymbol *tmp = *it_sizeV; - it_sizeV++; - SgSymbol *tmp1 = *it_sizeV; - it_sizeV++; - tmp_exp = new SgVarRefExp(*it_sizeV); - it_sizeV++; - for (; it_sizeV != argsKer->sizeVars.end(); it_sizeV++) - tmp_exp = &((*tmp_exp) * *new SgVarRefExp(*it_sizeV)); - - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && - *new SgVarRefExp(*tid1) < *new SgVarRefExp(tmp1) && - *new SgVarRefExp(*tid2) < *tmp_exp, *st); - } - - for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i])), &(rightExprs[i]->copy())); - else - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i]) + *new SgValueExp(1)), &(rightExprs[i]->copy())); - if_st->lastExecutable()->insertStmtAfter(*st); - } - - for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i)))); - else - st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i + 1)))); - if_st->lastExecutable()->insertStmtAfter(*st); - } - - cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); - cur_in_kernel = if_st->lastExecutable(); - delete[]leftExprs; - delete[]rightExprs; - } - else if (argsKer->symb.size() >= 3) // body for >3 dependence - { - // attention!! adding to support all variants!! - - if (argsKer->nSymb.size() >= 1) - { - SgSymbol *tmp = tid2; - tid2 = tid; - tid = tmp; - } - - SgStatement *st, *st1; - SgSymbol *max_z, *se, *emax, *emin, *v1, *v2, *v3, *min_ij, *swap_ij, *i, *j; - SgSymbol **num_elems; - SgIfStmt *if_st3; - - vector::iterator itAcr = argsKer->symb.begin(); - vector::iterator it = argsKer->nSymb.begin(); - vector::iterator itAcrS = argsKer->acrossS.begin(); - vector::iterator itS = argsKer->notAcrossS.begin(); - vector::iterator it_sizeV = argsKer->sizeVars.begin(); - vector::iterator itIdxAcr = argsKer->idxAcross.begin(); - vector::iterator itIdx = argsKer->idxNotAcross.begin(); - - SgExpression **leftExprs, **rightExprs; - int idx_exprs = 0; - int count_of_dims = argsKer->nSymb.size() + argsKer->symb.size(); - leftExprs = new SgExpression*[count_of_dims]; - rightExprs = new SgExpression*[count_of_dims]; - - num_elems = new SgSymbol*[argsKer->nSymb.size()]; - max_z = *it_sizeV; - it_sizeV++; - se = *it_sizeV; - it_sizeV++; - v1 = *it_sizeV; - it_sizeV++; - v2 = *it_sizeV; - it_sizeV++; - v3 = *it_sizeV; - it_sizeV++; - emax = *it_sizeV; - it_sizeV++; - emin = *it_sizeV; - it_sizeV++; - min_ij = *it_sizeV; - it_sizeV++; - swap_ij = *it_sizeV; - it_sizeV++; - - for (size_t i = 0; i < argsKer->nSymb.size(); ++i) - { - num_elems[i] = *it_sizeV; - it_sizeV++; - } - - e = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); - - st = AssignStatement(*new SgVarRefExp(*itAcrS), *new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*itIdxAcr) * - (*new SgVarRefExp(*se) + *new SgVarRefExp(*tid1) - *new SgVarRefExp(*emin))); - - itAcrS++; - itIdxAcr++; - st1 = AssignStatement(*new SgVarRefExp(*itAcrS), *new SgVarRefExp(*itAcrS) + *new SgVarRefExp(*itIdxAcr) * - (*new SgVarRefExp(*se) + *new SgVarRefExp(*tid1) - *new SgVarRefExp(*emin))); - - if_st2 = new SgIfStmt(SgEqOp(*new SgVarRefExp(*v3), *new SgValueExp(1)) && *new SgVarRefExp(emin) < *new SgVarRefExp(tid1) + *new SgVarRefExp(se), *st1); - if_st2->insertStmtAfter(*st); - - SgFunctionCallExp *funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("min")); - funcCall->addArg(*new SgVarRefExp(*se) + *new SgVarRefExp(*tid1)); - - itAcrS--; - itIdxAcr--; - - if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp((*itAcr).symb), *if_st2); - if (argsKer->nSymb.size() == 0) - if_st3 = new SgIfStmt(*new SgVarRefExp(*tid1) < *new SgVarRefExp(*max_z), *if_st); - else - { - SgExpression *tmp = new SgVarRefExp(num_elems[0]); - for (size_t i = 1; i < argsKer->nSymb.size(); ++i) - tmp = &(*tmp * *new SgVarRefExp(num_elems[i])); - - if_st3 = new SgIfStmt(*new SgVarRefExp(*tid1) < *new SgVarRefExp(*max_z) && *new SgVarRefExp(*tid2) < *tmp, *if_st); - } - cur_in_kernel->insertStmtAfter(*if_st3, *kernel_st); - cur_in_kernel = if_st->lexNext(); - - st1 = AssignStatement(*new SgVarRefExp((*itAcr).symb), *new SgVarRefExp(*min_ij)); - - st = AssignStatement(*new SgVarRefExp((*itAcr).symb), *new SgValueExp(2) * *new SgVarRefExp(*min_ij) - *new SgVarRefExp(se) - - *new SgVarRefExp(tid1) + *new SgVarRefExp(emax) - *new SgVarRefExp(emin) - *new SgValueExp(1)); - - if_st1 = new SgIfStmt(*new SgVarRefExp(*tid1) + *new SgVarRefExp(se) < *new SgVarRefExp(*emax), *st1, *st); - - st1 = AssignStatement(*new SgVarRefExp((*itAcr).symb), *new SgVarRefExp(*tid1) + *new SgVarRefExp(se)); - - if_st1 = new SgIfStmt(*new SgVarRefExp(*tid1) + *new SgVarRefExp(se) < *new SgVarRefExp(*emin), *st1, *if_st1); - if_st3->insertStmtAfter(*if_st1); - - i = (*itAcr).symb; - st1 = AssignStatement(*new SgVarRefExp((*itAcr).symb), *new SgVarRefExp(*itAcrS) + ((*new SgVarRefExp(tid1) * - (*new SgVarRefExp(v1) + *new SgVarRefExp(v3)) - *new SgVarRefExp(tid))) * *new SgVarRefExp(*itIdxAcr)); - - leftExprs[idx_exprs] = new SgVarRefExp((*itAcr).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) + ((*new SgVarRefExp(tid1) * - (*new SgVarRefExp(v1) + *new SgVarRefExp(v3)) - *new SgVarRefExp(tid))) * *new SgVarRefExp(*itIdxAcr)); - idx_exprs++; - - - itAcrS++; - itIdxAcr++; - itAcr++; - - j = (*itAcr).symb; - st1 = AssignStatement(*new SgVarRefExp((*itAcr).symb), *new SgVarRefExp(*itAcrS) + (*new SgVarRefExp(tid1) * - *new SgVarRefExp(v2) + *new SgVarRefExp(tid)) * *new SgVarRefExp(*itIdxAcr)); - - leftExprs[idx_exprs] = new SgVarRefExp((*itAcr).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) + (*new SgVarRefExp(tid1) * - *new SgVarRefExp(v2) + *new SgVarRefExp(tid)) * *new SgVarRefExp(*itIdxAcr)); - idx_exprs++; - - itAcrS++; - itIdxAcr++; - itAcr++; - - st1 = AssignStatement(*new SgVarRefExp((*itAcr).symb), *new SgVarRefExp(*itAcrS) - *new SgVarRefExp(tid1) * - *new SgVarRefExp(*itIdxAcr)); - - leftExprs[idx_exprs] = new SgVarRefExp((*itAcr).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(tid1) * *new SgVarRefExp(*itIdxAcr)); - idx_exprs++; - - if (argsKer->symb.size() > 3) - { - for (size_t i = 0; i < argsKer->symb.size() - 3; ++i) - { - itAcrS++; - itIdxAcr++; - itAcr++; - - leftExprs[idx_exprs] = new SgVarRefExp((*itAcr).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS)); - idx_exprs++; - } - } - - if (argsKer->nSymb.size() == 1) - { - st1 = AssignStatement(*new SgVarRefExp((*it).symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(tid2) * - *new SgVarRefExp(*itIdx)); - - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(tid2) * *new SgVarRefExp(*itIdx)); - idx_exprs++; - } - else if (argsKer->nSymb.size() > 1) - { - SgExpression *e_z1, *e_z2, *tmp_exp; - SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); - e_z1 = new SgVarRefExp(num_elems[0]); - funCall->addArg(*new SgVarRefExp(*tid2)); - funCall->addArg(*e_z1); - tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - - st = AssignStatement(*new SgVarRefExp((*it).symb), *tmp_exp); - - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - idx_exprs++; - - it++; - itS++; - itIdx++; - e_z2 = new SgVarRefExp(num_elems[1]); - for (int count = 2; it != argsKer->nSymb.end(); it++, itS++, itIdx++, ++count) - { - SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); - it++; - if (it == argsKer->nSymb.end()) - { - tmp_exp = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); - } - else - { - funCall->addArg((*new SgVarRefExp(*tid2) / *e_z1)); - funCall->addArg(*e_z2); - tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); - } - it--; - - st = AssignStatement(*new SgVarRefExp((*it).symb), *tmp_exp); - - leftExprs[idx_exprs] = new SgVarRefExp((*it).symb); - idx_exprs++; - - e_z1 = &(*e_z1 * *e_z2); - it++; - if (it != argsKer->nSymb.end()) - { - e_z2 = new SgVarRefExp(num_elems[count]); - } - it--; - } - } - - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])), &(rightExprs[0]->copy())); - else - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), &(rightExprs[0]->copy())); - // insert into MAIN If - if_st->lastExecutable()->insertStmtAfter(*st); - - for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i])), &(rightExprs[i]->copy())); - else - st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i]) + *new SgValueExp(1)), &(rightExprs[i]->copy())); - if_st->lastExecutable()->insertStmtAfter(*st); - } - - //insert swap block - if (options.isOn(C_CUDA)) - { - SgExpression *firstElem = new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])); - SgExpression *secondElem = new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[1])); - - if_st2 = new SgIfStmt(*new SgVarRefExp(swap_ij) * *new SgVarRefExp(v3), *new SgCExpStmt(*firstElem ^= *secondElem ^= *firstElem ^= *secondElem)); - } - else - { - st1 = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), new SgVarRefExp(v3)); - if_st2 = new SgIfStmt(*new SgVarRefExp(swap_ij) * *new SgVarRefExp(v3), *st1); - - st1 = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[1]) + *new SgValueExp(1)), - new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1))); - if_st2->insertStmtAfter(*st1); - - st1 = AssignStatement(new SgVarRefExp(v3), new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[1]) + *new SgValueExp(1))); - if_st2->insertStmtAfter(*st1); - } - if_st->lastExecutable()->insertStmtAfter(*if_st2); - - for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (options.isOn(C_CUDA)) - st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i)))); - else - st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i + 1)))); - if_st->lastExecutable()->insertStmtAfter(*st); - } - delete[]leftExprs; - delete[]rightExprs; - - cur_in_kernel = if_st->lastExecutable(); - } - - // generating assign statements for MAXLOC, MINLOC reduction operations - if (red_list) - Do_Assign_For_Loc_Arrays(); - - // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables - -#if debugMode - mywarn(" end: block5"); - mywarn("strat: inserting loop body"); -#endif - - SgStatement *currStForInsetGetXY = cur_in_kernel; - vector forDeclarationInKernel; - set uniqueNames; - - // create, insert, optimize and convert loop_body into kernel - { - SgStatement *stk, *last; - vector allNewInfo; - - if (argsKer->symb.size() == 1) - { - if (options.isOn(GPU_O0)) - optimizeLoopBodyForOne(allNewInfo); - oneCase = true; - } - else - oneCase = false; - - - block = CreateIfForRedBlack(loop_body, nloop); - last = cur_in_kernel->lexNext(); - - if (argsKer->symb.size() == 1 && allNewInfo.size() != 0 && options.isOn(GPU_O0)) //insert needed assigns - { - SgIfStmt *ifSt = new SgIfStmt(*new SgVarRefExp(argsKer->idxAcross[0]) > *new SgValueExp(0), *&allNewInfo[0].loadsBeforePlus[0]->copy(), *&allNewInfo[0].loadsBeforeMinus[0]->copy()); - for (size_t i = 0; i < allNewInfo.size(); ++i) - { - if (i == 0) - { - for (size_t k = 1; k < allNewInfo[i].loadsBeforePlus.size(); ++k) - { - ifSt->insertStmtAfter(*&allNewInfo[i].loadsBeforePlus[k]->copy(), *ifSt); - ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].loadsBeforeMinus[k]->copy(), *ifSt); - } - } - else - { - for (size_t k = 0; k < allNewInfo[i].loadsBeforePlus.size(); ++k) - { - ifSt->insertStmtAfter(*&allNewInfo[i].loadsBeforePlus[k]->copy(), *ifSt); - ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].loadsBeforeMinus[k]->copy(), *ifSt); - } - } - } - mainFor->insertStmtBefore(*ifSt); - } - - if (argsKer->symb.size() == 1 && options.isOn(GPU_O0)) - cur_in_kernel->insertStmtAfter(*block, *mainFor); //cur_in_kernel is innermost FOR stmt - else - cur_in_kernel->insertStmtAfter(*block, *if_st); //cur_in_kernel is innermost IF statement - - if (options.isOn(C_CUDA)) - { - if (block->comments() == NULL) - block->addComment("// Loop body"); - } - else - block->addComment("! Loop body\n"); - - // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) - if (block != loop_body) - stk = last->lexPrev()->lexPrev(); - else - stk = last->lexPrev(); - - if (stk->variant() == CONTROL_END) - { - if (stk->hasLabel() || stk == loop_body) // when body of DO_ENDDO loop is empty, stk == loop_body - stk->setVariant(CONT_STAT); - else - { - st = stk->lexPrev(); - stk->extractStmt(); - stk = st; - } - } - - ReplaceExitCycleGoto(block, stk); - - for_kernel = 1; - last = cur_st; - - if (argsKer->symb.size() == 1 && allNewInfo.size() != 0 && options.isOn(GPU_O0)) //insert needed assigns - { - SgIfStmt *ifSt = new SgIfStmt(*new SgVarRefExp(argsKer->idxAcross[0]) > *new SgValueExp(0), *&allNewInfo[0].loadsInForPlus[0]->copy(), *&allNewInfo[0].loadsInForMinus[0]->copy()); - - for (size_t i = 0; i < allNewInfo.size(); ++i) - { - size_t k; - if (i == 0) - k = 1; - else - k = 0; - for (; k < allNewInfo[i].loadsInForPlus.size(); ++k) - { - ifSt->insertStmtAfter(*&allNewInfo[i].loadsInForPlus[k]->copy(), *ifSt); - ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].loadsInForMinus[k]->copy(), *ifSt); - } - } - mainFor->insertStmtAfter(*ifSt); - - - for (size_t i = 0; i < allNewInfo.size(); ++i) - { - if (options.isOn(C_CUDA)) - { - for (size_t k = 0; k < allNewInfo[i].stores.size(); ++k) - mainFor->lastExecutable()->insertStmtAfter(*&allNewInfo[i].stores[k]->copy()); - } - else - { - for (size_t k = 0; k < allNewInfo[i].stores.size(); ++k) - mainFor->lastExecutable()->lexPrev()->lexPrev()->insertStmtBefore(*&allNewInfo[i].stores[k]->copy()); - } - } - - size_t k = allNewInfo[0].swapsUp.size() - 1; - ifSt = new SgIfStmt(*new SgVarRefExp(argsKer->idxAcross[0]) > *new SgValueExp(0), *&allNewInfo[0].swapsDown[k]->copy(), *&allNewInfo[0].swapsUp[k]->copy()); - for (size_t i = 0; i < allNewInfo.size(); ++i) - { - size_t last; - if (i == 0) - last = allNewInfo[i].swapsUp.size() - 1; - else - last = allNewInfo[0].swapsUp.size(); - for (size_t k = 0; k < last; ++k) - { - ifSt->insertStmtAfter(*&allNewInfo[i].swapsDown[last - 1 - k]->copy(), *ifSt); - ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].swapsUp[last - 1 - k]->copy(), *ifSt); - } - } - mainFor->lastExecutable()->insertStmtAfter(*ifSt); - } - - // insert dvmh_convert_XY calls directly into loop_body if some array accesses depend on its definitions (inserting right before accesses) - if (options.isOn(AUTO_TFM)) - { - if (acrossNum != 1) - { - map& arrays = currentLoop->getArrays(); - string funcDvmhConvXYname_type = funcDvmhConvXYname; - if (!options.isOn(C_CUDA)) - { - if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_INT)->symbol()->identifier()) == 0) - funcDvmhConvXYname_type += "_int"; - else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LONG)->symbol()->identifier()) == 0) - funcDvmhConvXYname_type += "_long"; - else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LLONG)->symbol()->identifier()) == 0) - funcDvmhConvXYname_type += "_llong"; - } - for (map::iterator it = arrays.begin(); it != arrays.end(); ++it) - { - Array* array = it->second; - set& privateList = currentLoop->getPrivateList(); - if (privateList.find(it->first) == privateList.end()) - { - for (map::iterator it2 = array->getAccesses().begin(); it2 != array->getAccesses().end(); ++it2) - analyzeArrayIndxs(array->getSymbol(), it2->second->getSubscripts()); - int numSymb = 0; - for (size_t i1 = 0; i1 < argsKer->arrayNames.size(); ++i1) - if (strcmp(argsKer->arrayNames[i1], array->getSymbol()->identifier()) == 0) - { - numSymb = (int)i1; - break; - } - array->generateAssigns( - new SgVarRefExp(argsKer->otherVars[8 * numSymb + 1]), - new SgVarRefExp(argsKer->otherVars[8 * numSymb + 4]), - new SgVarRefExp(argsKer->otherVars[8 * numSymb + 2]), - new SgVarRefExp(argsKer->otherVars[8 * numSymb + 5]), - new SgVarRefExp(argsKer->otherVars[8 * numSymb + 6])); - SgIfStmt* ifSt = NULL, *if1case = NULL, *if2case = NULL; - TfmInfo& tfmInfo = array->getTfmInfo(); - map >& ifCalls = tfmInfo.ifCalls; - map >& elseCalls = tfmInfo.elseCalls; - SgSymbol* x_axis = argsKer->otherVars[8 * numSymb]; - SgSymbol* y_axis = argsKer->otherVars[8 * numSymb + 3]; - int tfsDim1 = tfmInfo.transformDims[0]; - int tfsDim2 = tfmInfo.transformDims[1]; - for (map >::iterator it = ifCalls.begin(); it != ifCalls.end(); ++it) - { - if (it->first == NULL) - continue; - if (ifCalls[it->first].size() > 0) - { - if (options.isOn(C_CUDA)) - { - if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), *new SgCExpStmt(*(elseCalls[it->first][0]))); - if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), *new SgCExpStmt(*(ifCalls[it->first][0])), *if2case); - ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); - } - else - { - if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), - *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[it->first][0]->args()))); - if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), - *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[it->first][0]->args())), *if2case); - ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); - } - } - - for (size_t k = 1; k < ifCalls[it->first].size(); ++k) - { - if (options.isOn(C_CUDA)) - { - if1case->insertStmtAfter(*new SgCExpStmt(*(ifCalls[it->first][k]))); - if2case->insertStmtAfter(*new SgCExpStmt(*(elseCalls[it->first][k]))); - } - else - { - if1case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[it->first][k]->args()))); - if2case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[it->first][k]->args()))); - } - } - - if (ifSt != NULL) - { - if (loop_body == it->first) - loop_body->insertStmtBefore(*ifSt); - else - { - for (SgStatement* stmt = loop_body; stmt != NULL; stmt = stmt->lexNext()) - { - if (stmt->lexNext() == it->first) - { - stmt->insertStmtAfter(*ifSt); - break; - } - } - } - } - ifSt = NULL; - } - } - } - } - } - - TranslateBlock(if_st); - - if (options.isOn(C_CUDA)) - { - //get info of arrays in private and locvar lists - swapDimentionsInprivateList(); - if (argsKer->symb.size() == 1 && options.isOn(GPU_O0)) - { - Translate_Fortran_To_C(mainFor->lexPrev()->controlParent()); - Translate_Fortran_To_C(mainFor, mainFor->lastNodeOfStmt(), copyOfBody, 0); //countOfCopies - } - else - Translate_Fortran_To_C(if_st, if_st->lastNodeOfStmt(), copyOfBody, 0); // countOfCopies - } - - cur_st = last; - if (createBodyKernel == false) - createBodyKernel = true; - - } - - //insert dvmh_convert_XY before loop_body if its arguments depend only on loop indices - if (options.isOn(AUTO_TFM)) - { -#if debugMode - mywarn("strat: inserting transform calls"); -#endif - if (acrossNum != 1) - { - map& arrays = currentLoop->getArrays(); - string funcDvmhConvXYname_type = funcDvmhConvXYname; - if (!options.isOn(C_CUDA)) - { - if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_INT)->symbol()->identifier()) == 0) - funcDvmhConvXYname_type += "_int"; - else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LONG)->symbol()->identifier()) == 0) - funcDvmhConvXYname_type += "_long"; - else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LLONG)->symbol()->identifier()) == 0) - funcDvmhConvXYname_type += "_llong"; - } - for (map::iterator it = arrays.begin(); it != arrays.end(); ++it) - { - Array *array = it->second; - set& privateList = currentLoop->getPrivateList(); - if (privateList.find(it->first) == privateList.end()) - { - int numSymb = 0; - for (size_t i1 = 0; i1 < argsKer->arrayNames.size(); ++i1) - if (strcmp(argsKer->arrayNames[i1], array->getSymbol()->identifier()) == 0) - { - numSymb = (int)i1; - break; - } - SgIfStmt* ifSt = NULL, *if1case = NULL, *if2case = NULL; - TfmInfo& tfmInfo = array->getTfmInfo(); - vector& ifCalls = tfmInfo.ifCalls[NULL]; - vector& elseCalls = tfmInfo.elseCalls[NULL]; - SgSymbol* x_axis = argsKer->otherVars[8 * numSymb]; - SgSymbol* y_axis = argsKer->otherVars[8 * numSymb + 3]; - int tfsDim1 = tfmInfo.transformDims[0]; - int tfsDim2 = tfmInfo.transformDims[1]; - - if (ifCalls.size() > 0) - if (options.isOn(C_CUDA)) - { - if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), *new SgCExpStmt(*(elseCalls[0]))); - if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), *new SgCExpStmt(*(ifCalls[0])), *if2case); - ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); - } - else - { - if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), - *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[0]->args()))); - if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), - *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[0]->args())), *if2case); - ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); - } - for (size_t k = 1; k < ifCalls.size(); ++k) - { - if (options.isOn(C_CUDA)) - { - if1case->insertStmtAfter(*new SgCExpStmt(*(ifCalls[k]))); - if2case->insertStmtAfter(*new SgCExpStmt(*(elseCalls[k]))); - } - else - { - if1case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[k]->args()))); - if2case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[k]->args()))); - } - } - if (ifSt != NULL) - currStForInsetGetXY->insertStmtAfter(*ifSt); - - vector& zeroSt = tfmInfo.zeroSt; - for (size_t k = 0; k < zeroSt.size(); ++k) - currStForInsetGetXY->insertStmtAfter(zeroSt[k]->copy()); - - vector& coef = tfmInfo.coefficients; - for (unsigned z = 0; z < coef.size(); ++z) - forDeclarationInKernel.push_back(&(coef[z]->copy())); - } - } - } - -#if debugMode - mywarn("end: inserting transform calls"); -#endif - } - -#if debugMode - mywarn(" end: inserting loop body"); - mywarn("start: create reduction block"); -#endif - - if (red_list && argsKer->nSymb.size() == 0) - { - int num; - reduction_operation_list *tmp_list = red_struct_list; - int needComment = 1; - SgSymbol* overAll = OverallBlocksSymbol(); - SgSymbol* freeS = *argsKer->acrossS.begin(); - - for (SgExpression *er = red_list; er; er = er->rhs()) - { - num = 0; - int flag_func_call = 1; - SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference - SgExpression *loc_var_ref = NULL, *en = NULL; - int loc_el_num = 0; - if (isSgExprListExp(red_expr_ref)) - { - red_expr_ref = red_expr_ref->lhs(); // reduction variable reference - loc_var_ref = er->lhs()->rhs()->rhs()->lhs(); //location array reference - en = er->lhs()->rhs()->rhs()->rhs()->lhs(); // number of elements in location array - loc_el_num = LocElemNumber(en); - } - num = RedFuncNumber(er->lhs()->lhs()); // type of reduction - const char *str_operation = NULL; - if (num == 1) - flag_func_call = 0; // + - else if (num == 2) - flag_func_call = 0; // * - else if (num == 3) - str_operation = "max"; - else if (num == 4) - str_operation = "min"; - else if (num == 5) - flag_func_call = 0; // and - else if (num == 6) - flag_func_call = 0; // or - else if (num == 7) - flag_func_call = 0; // != - else if (num == 8) - flag_func_call = 0; // == - else if (num == 9) - flag_func_call = 0; // maxloc - else if (num == 10) - flag_func_call = 0; // minloc - - if (flag_func_call == 1) - { - SgFunctionCallExp *funcCall = new SgFunctionCallExp(*createNewFunctionSymbol(str_operation)); - if (argsKer->symb.size() < 3) - { - SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); - redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); - - if (tmp_list->redvar_size == 0) - { - funcCall->addArg(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid))); - funcCall->addArg(*new SgVarRefExp(*red_expr_ref->symbol())); - st = AssignStatement(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid)), *funcCall); - } - else if (tmp_list->redvar_size > 0 && options.isOn(C_CUDA)) //TODO for Fortran - { - SgExpression* idx = &(*new SgVarRefExp(freeS) * *new SgVarRefExp(overAll) + *new SgVarRefExp(*tid)); - funcCall->addArg(*new SgArrayRefExp(*redGrid, *idx)); - funcCall->addArg(*new SgArrayRefExp(*red_expr_ref->symbol(), *new SgVarRefExp(freeS))); - - SgExpression* start = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), new SgValueExp(0)); - SgExpression* end = &(*new SgVarRefExp(freeS) < *new SgValueExp(tmp_list->redvar_size)); - SgExpression* step = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), &(*new SgVarRefExp(freeS) + *new SgValueExp(1))); - st = new SgForStmt(start, end, step, AssignStatement(*new SgArrayRefExp(*redGrid, *idx), *funcCall)); - } - else - { - //TODO - } - } - else - { - SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); - redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); - - SgSymbol *emin = argsKer->sizeVars[6]; - funcCall->addArg(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*emin))); - funcCall->addArg(*new SgVarRefExp(red_expr_ref->symbol())); - st = AssignStatement(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*emin)), *funcCall); - } - } - else - { - SgExpression *e1 = NULL; - if (argsKer->symb.size() < 3) - { - if (tmp_list->redvar_size == 0) - e1 = new SgVarRefExp(*tid); - else if (tmp_list->redvar_size > 0) - e1 = &(*new SgVarRefExp(freeS) * *new SgVarRefExp(overAll) + *new SgVarRefExp(*tid)); - else - { - //TODO - } - } - else - { - SgSymbol *emin = argsKer->sizeVars[6]; - e1 = &(*new SgVarRefExp(*tid) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*emin)); - } - e = NULL; - SgIfStmt *ifSt = NULL; - SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); - redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); - - SgExpression* red_ref = NULL; - - if (tmp_list->redvar_size == 0) - red_ref = &red_expr_ref->copy(); - else // TODO - red_ref = new SgArrayRefExp(*red_expr_ref->symbol(), *new SgVarRefExp(freeS)); - - if (num == 1) - e = &(*new SgArrayRefExp(*redGrid, *e1) + *red_ref); - else if (num == 2) - e = &(*new SgArrayRefExp(*redGrid, *e1) * *red_ref); - else if (num == 5) - e = &(*new SgArrayRefExp(*redGrid, *e1) && *red_ref); - else if (num == 6) - e = &(*new SgArrayRefExp(*redGrid, *e1) || *red_ref); - else if (num == 7) - e = &SgNeqOp(*new SgArrayRefExp(*redGrid, *e1), *red_ref); - else if (num == 8) - e = &SgEqOp(*new SgArrayRefExp(*redGrid, *e1), *red_ref); - else if (num == 9 || num == 10) - { - st = AssignStatement(*new SgArrayRefExp(*redGrid, *e1), red_expr_ref->copy()); - if (num == 9) - ifSt = new SgIfStmt(red_expr_ref->copy() > *new SgArrayRefExp(*redGrid, *e1), *st); - else - ifSt = new SgIfStmt(red_expr_ref->copy() < *new SgArrayRefExp(*redGrid, *e1), *st); - - for (int i = loc_el_num - 1; i >= 0; i--) - { - SgSymbol *locGrid = new SgSymbol(VARIABLE_NAME, tmp_list->loc_grid->identifier()); - locGrid->setType(*new SgArrayType(*tmp_list->loc_grid->type())); - - if (options.isOn(C_CUDA)) - st = AssignStatement(*new SgArrayRefExp(*locGrid, *new SgValueExp(loc_el_num) * *e1 + *new SgValueExp(i)), *new SgArrayRefExp(*loc_var_ref->symbol(), *new SgValueExp(i))); - else - st = AssignStatement(*new SgArrayRefExp(*locGrid, *new SgValueExp(i + 1), *e1), *new SgArrayRefExp(*loc_var_ref->symbol(), *new SgValueExp(i + 1)));//TODO it like in C_Cuda - ifSt->insertStmtAfter(*st); - } - } - - if (num != 9 && num != 10) - { - if (tmp_list->redvar_size == 0) - st = AssignStatement(*new SgArrayRefExp(*redGrid, *e1), *e); - else if (tmp_list->redvar_size > 0 && options.isOn(C_CUDA)) // TODO for Fortran - { - SgExpression* start = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), new SgValueExp(0)); - SgExpression* end = &(*new SgVarRefExp(freeS) < *new SgValueExp(tmp_list->redvar_size)); - SgExpression* step = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), &(*new SgVarRefExp(freeS) + *new SgValueExp(1))); - st = new SgForStmt(start, end, step, AssignStatement(*new SgArrayRefExp(*redGrid, *e1), *e)); - } - else - { - //TODO - } - } - else - st = ifSt; - } - if (argsKer->symb.size() < 3) - if_st->lastExecutable()->insertStmtAfter(*st, *if_st); - else - if_st->lastExecutable()->insertStmtAfter(*st); - tmp_list = tmp_list->next; - if (needComment == 1) - { - if (options.isOn(C_CUDA)) - st->addComment("// Reduction"); - else - st->addComment("! Reduction\n"); - needComment = 0; - } - } - - DeclarationCreateReductionBlocksAcross(nloop, red_list); - } - else if (red_list && argsKer->nSymb.size() > 0) // generating reduction calculation blocks - CreateReductionBlocksAcross(st_end, nloop, red_list, new SgSymbol(*tid)); - -#if debugMode - mywarn(" end: create reduction block"); -#endif - - // make declarations - if (options.isOn(C_CUDA)) - MakeDeclarationsForKernel_On_C_Across(idxTypeInKernel); - else // Fortran-Cuda - MakeDeclarationsForKernelAcross(idxTypeInKernel); - for_kernel = 0; - - st = coords->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*st); - - st = tid->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*st); - - if (tmpvar1 != NULL) - addDeclExpList(tmpvar1, st->expr(0)); - - if (options.isOn(AUTO_TFM)) - { - for (size_t i = 0; i < forDeclarationInKernel.size(); ++i) - addDeclExpList(forDeclarationInKernel[i], st->expr(0)); - } - - if (argsKer->symb.size() == 1) - { - if (argsKer->nSymb.size() == 2) - addDeclExpList(tid1, st->expr(0)); - else if (argsKer->nSymb.size() >= 3) - { - addDeclExpList(tid1, st->expr(0)); - addDeclExpList(tid2, st->expr(0)); - } - } - else if (argsKer->symb.size() == 2) - { - if (argsKer->nSymb.size() == 1) - addDeclExpList(tid1, st->expr(0)); - else if (argsKer->nSymb.size() >= 2) - { - addDeclExpList(tid1, st->expr(0)); - addDeclExpList(tid2, st->expr(0)); - } - } - else if (argsKer->symb.size() >= 3) - { - addDeclExpList(tid1, st->expr(0)); - if (argsKer->nSymb.size() > 0) - addDeclExpList(tid2, st->expr(0)); - } - - if (!options.isOn(C_CUDA)) - { - createDeclaration(argsKer->sizeVars); - createDeclaration(argsKer->acrossS); - createDeclaration(argsKer->notAcrossS); - createDeclaration(argsKer->idxAcross); - createDeclaration(argsKer->idxNotAcross); - - for (size_t i = 0; i < argsKer->otherVars.size() / 8 * 8; i += 8) - { - createDeclaration(argsKer->otherVars[i]); - addDeclExpList(argsKer->otherVars[i + 3], st->expr(0)); - - createDeclaration(argsKer->otherVars[i + 1]); - addDeclExpList(argsKer->otherVars[i + 4], st->expr(0)); - - createDeclaration(argsKer->otherVars[i + 2]); - addDeclExpList(argsKer->otherVars[i + 5], st->expr(0)); - - createDeclaration(argsKer->otherVars[i + 6]); - addDeclExpList(argsKer->otherVars[i + 7], st->expr(0)); - } - - if (argsKer->otherVars.size() != 0 && argsKer->otherVars.size() % 8 != 0) - createDeclaration(argsKer->otherVars[argsKer->otherVars.size() - 1]); - - for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) - { - if (i == 0) - createDeclaration(argsKer->baseIdxsInKer[i]); - else - addDeclExpList(argsKer->baseIdxsInKer[i], st->expr(0)); - } - - if (argsKer->cond_ != NULL) - { - createDeclaration(argsKer->cond_); - for (size_t i = 0; i < argsKer->steps.size(); ++i) - addDeclExpList(argsKer->steps[i], st->expr(0)); - } - } -#if debugMode - mywarn(" end: CreateLoopKernelAcross"); -#endif - - // inserting IMPLICIT NONE - if (!options.isOn(C_CUDA)) // Fortran-Cuda - kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); - if (options.isOn(C_CUDA)) - RenamingCudaFunctionVariables(kernel_st, skernel, 1); - - ACROSS_MOD_IN_KERNEL = 0; - return kernel_st; -} - - -// -------------------------- Reduction block for Across ---------------------------- // - -SgSymbol *RedBlockSymbolInKernelAcross(SgSymbol *s, SgType *type) -{ - char *name = NULL; - SgSymbol *sb = NULL; - SgValueExp M0(0); - SgExpression *MD = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); - SgArrayType *typearray; - int i = 1; - - if (!type) - typearray = new SgArrayType(*s->type()->baseType()); - else if (isSgArrayType(s->type())) - typearray = (SgArrayType *)&(s->type()->copy()); - else - typearray = new SgArrayType(*type); - - if (!options.isOn(C_CUDA)) - typearray->addRange(*MD); - else - typearray->addDimension(NULL); - - name = new char[strlen(s->identifier()) + 8]; - sprintf(name, "%s_block", s->identifier()); - - while (isSameNameShared(name)) - sprintf(name, "%s_block%d", s->identifier(), i++); - - sb = new SgVariableSymb(name, *typearray, *kernel_st); // scope may be mod_gpu -#if 0 - shared_list = AddToSymbList(shared_list, sb); -#endif - delete[]name; - - return sb; -} - -void DeclarationOfReductionBlockInKernelAcross(SgExpression *ered, reduction_operation_list *rsl) -{ - SgStatement *newst, *current, *if_st, *while_st, *typedecl, *st, *do_st; - SgExpression *eatr, *cond, *ev; - SgSymbol *red_var, *red_var_k, *s_block, *loc_var, *sf; - SgType *rtype; - - //init block - newst = current = if_st = while_st = typedecl = st = do_st = NULL; - eatr = cond = ev = NULL; - red_var = red_var_k = s_block = loc_var = sf = NULL; - rtype = NULL; - loc_el_num = 0; - //end of init block - - // analys of reduction operation - // ered - reduction operation (variant==ARRAY_OP) - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - if (isSgExprListExp(ev)) // for MAXLOC,MINLOC - { - loc_var = ev->rhs()->lhs()->symbol(); //location array reference - ev = ev->lhs(); // reduction variable reference - } - else - loc_var = NULL; - - // _block([ k,] i) = [k=LowerBound:UpperBound] - // or for MAXLOC,MINLOC - // _block(i)% = - // _block(i)%(1) = (1) - // [_block(i)%(2) = (2) ] - // . . . - // create and declare array '_block' - red_var = ev->symbol(); - - if (rsl->locvar) - { - newst = Declaration_Statement(LocRedVariableSymbolInKernel(rsl)); //declare location variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - - if (rsl->redvar_size > 0) - { - newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->redvar,NULL,NULL)); //declare reduction variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - else if (rsl->redvar_size < 0) - { - red_var_k = RedVariableSymbolInKernel(rsl->redvar, rsl->dimSize_arg, rsl->lowBound_arg); - newst = Declaration_Statement(red_var_k); //declare reduction variable - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - - //XXX: shared memory doesnt use in ACROSS by C_Cuda - if (!options.isOn(C_CUDA)) - { - rtype = (rsl->redvar_size >= 0) ? TypeOfRedBlockSymbol(ered) : red_var_k->type(); - s_block = RedBlockSymbolInKernelAcross(red_var, rtype); - newst = Declaration_Statement(s_block); - eatr = new SgExprListExp(*new SgExpression(ACC_SHARED_OP)); - newst->setExpression(2, *eatr); - kernel_st->insertStmtAfter(*newst, *kernel_st); - - if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC - { - typedecl = MakeStructDecl(rtype->symbol()); - kernel_st->insertStmtAfter(*typedecl, *kernel_st); - } - } -} - -void DeclarationCreateReductionBlocksAcross(int nloop, SgExpression *red_op_list) -{ - SgStatement *newst, *dost; - SgExpression *er; - SgSymbol *i_var, *j_var; - reduction_operation_list *rsl; - int n; - - formal_red_grid_list = NULL; - - // index variables - dost = DoStmt(first_do_par, nloop); - i_var = dost->symbol(); - if (nloop > 1) - j_var = dost->controlParent()->symbol(); - else - { - j_var = IndVarInKernel(i_var); - newst = j_var->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - - //looking through the reduction_op_list - for (er = red_op_list, rsl = red_struct_list, n = 1; er; er = er->rhs(), rsl = rsl->next, n++) - { - DeclarationOfReductionBlockInKernelAcross(er->lhs(), rsl); - } -} - -void CreateReductionBlocksAcross(SgStatement *stat, int nloop, SgExpression *red_op_list, SgSymbol *red_count_symb) -{ - SgStatement *newst, *ass, *dost; - SgExpression *er, *re; - SgSymbol *i_var, *j_var; - reduction_operation_list *rsl; - int n; - - formal_red_grid_list = NULL; - - // index variables - dost = DoStmt(first_do_par, nloop); - i_var = dost->symbol(); - if (nloop > 1) - j_var = dost->controlParent()->symbol(); - else - { - j_var = IndVarInKernel(i_var); - newst = j_var->makeVarDeclStmt(); - kernel_st->insertStmtAfter(*newst, *kernel_st); - } - //create symbol 'syncthreads' - // declare '_block' array for each reduction var - // = threadIdx%x -1 + [ (threadIdx%y - 1) * blockDim%x [ + (threadIdx%z - 1) * blockDim%x * blockDim%y ] ] - // or C_Cuda - // = threadIdx%x + [ threadIdx%y * blockDim%x [ + threadIdx%z * blockDim%x * blockDim%y ] ] - - re = ThreadIdxRefExpr("x"); - if (nloop > 1) - re = &(*re + (*ThreadIdxRefExpr("y")) * (*new SgRecordRefExp(*s_blockdim, "x"))); - if (nloop > 2) - re = &(*re + (*ThreadIdxRefExpr("z")) * (*new SgRecordRefExp(*s_blockdim, "x") * (*new SgRecordRefExp(*s_blockdim, "y")))); - - if (options.isOn(C_CUDA)) // global cuda index - { - // gIDX = threadIdx.x + threadIdx.y * blockDim.x + threadIdx.z * blockDim.x * blockDim.y + (blockIdx.x + blockIdx.y * gridDim.x + blockIdx.z * gridDim.x * gridDim.y) * blockDim.x * blockDim.y * blockDim.z; - SgExpression& thrX = *new SgRecordRefExp(*s_threadidx, "x"); - SgExpression& thrY = *new SgRecordRefExp(*s_threadidx, "y"); - SgExpression& thrZ = *new SgRecordRefExp(*s_threadidx, "z"); - - SgExpression& blDimX = *new SgRecordRefExp(*s_blockdim, "x"); - SgExpression& blDimY = *new SgRecordRefExp(*s_blockdim, "y"); - SgExpression& blDimZ = *new SgRecordRefExp(*s_blockdim, "z"); - - SgExpression& blIdxX = *new SgRecordRefExp(*s_blockidx, "x"); - SgExpression& blIdxY = *new SgRecordRefExp(*s_blockidx, "y"); - SgExpression& blIdxZ = *new SgRecordRefExp(*s_blockidx, "z"); - - SgExpression& grX = *new SgRecordRefExp(*s_griddim, "x"); - SgExpression& grY = *new SgRecordRefExp(*s_griddim, "y"); - - ass = new SgAssignStmt(*new SgVarRefExp(i_var), thrX + thrY * blDimX + thrZ * blDimX * blDimY + (blIdxX + blIdxY * grX + blIdxZ * grX * grY) * blDimX * blDimY * blDimZ); - } - else - ass = AssignStatement(new SgVarRefExp(i_var), re); - stat->insertStmtBefore(*ass, *stat->controlParent()); - if (options.isOn(C_CUDA)) - ass->addComment("// Reduction"); - else - ass->addComment("! Reduction\n"); - - //looking through the reduction_op_list - - SgIfStmt* if_st = NULL; - SgIfStmt* if_del = NULL; - SgIfStmt* if_new = NULL; - int declArrayVars = 1; - - SgSymbol* s_warpsize = new SgVariableSymb("warpSize", *SgTypeInt(), *mod_gpu); - if (options.isOn(C_CUDA)) - if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var) % *new SgVarRefExp(s_warpsize), *new SgValueExp(0))); - - for (er = red_op_list, rsl = red_struct_list, n = 1; er; er = er->rhs(), rsl = rsl->next, n++) - { - if (options.isOn(C_CUDA)) - ReductionBlockInKernel_On_C_Cuda(stat, i_var, er->lhs(), rsl, if_st, if_del, if_new, declArrayVars, true, true); - else - ReductionBlockInKernel(stat, nloop, i_var, j_var, er->lhs(), rsl, red_count_symb, n); - } - - if (options.isOn(C_CUDA)) - stat->insertStmtBefore(*if_st, *stat->controlParent()); -} - -//end of Reduction block for Across - -#undef LongT -#undef debugMode -#undef kerneloff \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_across_analyzer.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_across_analyzer.cpp deleted file mode 100644 index 2c680ca..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_across_analyzer.cpp +++ /dev/null @@ -1,2249 +0,0 @@ - -#include "dvm.h" -#include "acc_across_analyzer.h" - -using namespace std; - -// special storages to avoid recomputing -static map lhs; -static map rhs; -static map unparsedLhs; -static map unparsedRhs; - -extern reduction_operation_list* red_struct_list; - -template -static inline OutIt difference(InIt1 first1, InIt1 last1, InIt2 first2, InIt2 last2, OutIt dest) -{ - for (; first1 != last1 && first2 != last2;) - { - if (*first1 < *first2) - { - *dest++ = *first1; - ++first1; - } - else if (*first2 < *first1) - ++first2; - else - { - ++first1; - ++first2; - } - } - - return copy(first1, last1, dest); -} - -template -static inline OutIt intersection(InIt1 first1, InIt1 last1, InIt2 first2, InIt2 last2, OutIt dest) -{ - for (; first1 != last1 && first2 != last2;) - { - if (*first1 < *first2) - ++first1; - else if (*first2 < *first1) - ++first2; - else - { - *dest++ = *first1++; - ++first2; - } - } - return dest; -} - -static int replace(SgExpression* expr, SgStatement* parent, SgExpression* patt, SgExpression* subst) -{ - if (ExpCompare(expr, patt) != 0) - { - *expr = subst->copy(); - if (ExpCompare(parent->expr(0), expr) != 0) - parent->setExpression(0, *expr); - else if (ExpCompare(parent->expr(1), expr) != 0) - parent->setExpression(1, *expr); - return 1; - } - int count = 0; - vector subexprs; - subexprs.push_back(NULL); - subexprs.push_back(expr); - int k = 1; - vector positions(2); - for (vector::iterator p = subexprs.begin() + 1; p != subexprs.end(); ++k, p = subexprs.begin() + k) - { - if (ExpCompare(*p, patt) == 0) - { - SgExpression* lhs = (*p)->lhs(); - SgExpression* rhs = (*p)->rhs(); - if (lhs != NULL) - { - subexprs.push_back(lhs); - positions.push_back(-k); - } - if (rhs != NULL) - { - subexprs.push_back(rhs); - positions.push_back(k); - } - } - else - { - if (positions[k] < 0) - subexprs[-positions[k]]->setLhs(subst->copyPtr()); - else - subexprs[positions[k]]->setRhs(subst->copyPtr()); - ++count; - } - } - return count; -} - -static int replaceInSubscripts(SgExpression* expr, SgStatement* parent, SgExpression* patt, SgExpression* subst) -{ - if (expr == NULL) - return 0; - int count = 0; - vector subexprs; - subexprs.push_back(expr); - int k = 0; - for (vector::iterator p = subexprs.begin(); p != subexprs.end(); ++k, p = subexprs.begin() + k) - { - if ((*p)->variant() == ARRAY_REF) - { - for (SgExpression* tmp = ((SgArrayRefExp*)* p)->subscripts(); tmp != NULL; tmp = tmp->rhs()) - count += replace(tmp->lhs(), parent, patt, subst); - } - else - { - SgExpression* lhs = (*p)->lhs(); - SgExpression* rhs = (*p)->rhs(); - if (lhs != NULL) - subexprs.push_back(lhs); - if (rhs != NULL) - subexprs.push_back(rhs); - } - } - return count; -} - -#define add(a, b) (a) + (b) -#define subtract(a, b) (a) - (b) -#define multiply(a, b) (a) * (b) -#define divide(a, b) (a) / (b) - -#define compute(lhs, rhs, parent, op, cast) \ -switch (lhs->variant()) \ -{ \ - case BOOL_VAL: \ - lhs = new SgValueExp(op(cast(((SgValueExp*)lhs)->boolValue() == true ? -1 : 0), rhs)); \ - break; \ - case INT_VAL: \ - lhs = new SgValueExp(op(cast((SgValueExp*)lhs)->intValue(), rhs)); \ - break; \ - case FLOAT_VAL: \ - lhs = new SgValueExp(op(cast strtod(((SgValueExp*)lhs)->floatValue(), NULL), rhs)); \ - break; \ - case DOUBLE_VAL: \ - lhs = new SgValueExp(op(cast strtod(((SgValueExp*)lhs)->doubleValue(), NULL), rhs)); \ - break; \ - default: \ - changed = false; \ - lhs = parent; \ - break; \ -} - -void Loop::getRPN(SgExpression* expr, list& rpn) const -{ - if (expr == NULL) - return; - stack stack; - stack.push(expr); - while (stack.empty() == false) - { - SgExpression* expr = stack.top(); - stack.pop(); - switch (expr->variant()) - { - case ARRAY_REF: - case FUNC_CALL: - break; - case SUBT_OP: - *expr = *expr->lhs() + *new SgExpression(MINUS_OP, expr->rhs(), NULL, NULL); - stack.push(expr->lhs()); - stack.push(expr->rhs()); - break; - default: - if (expr->lhs() != NULL) - stack.push(expr->lhs()); - if (expr->rhs() != NULL) - stack.push(expr->rhs()); - break; - } - rpn.push_front(expr); - } -} - -void Loop::unrollRPN(list& rpn, map& arity) const -{ - set visited; - for (list::iterator it = rpn.begin(); it != rpn.end();) - { - if (visited.find(*it) == visited.end()) - visited.insert(*it); - else - { - ++it; - continue; - } - switch ((*it)->variant()) - { - case ARRAY_REF: - case FUNC_CALL: - for (SgExpression* tmp = (*it)->lhs(); tmp != NULL; tmp = tmp->rhs()) - { - list subrpn; - getRPN(tmp->lhs(), subrpn); - optimizeRPN(subrpn, arity, false); - rpn.insert(it, subrpn.begin(), subrpn.end()); - } - it = rpn.begin(); - break; - default: - ++it; - break; - } - } -} - -void Loop::optimizeRPN(list& rpn, map& arity, bool unrolled) const -{ - for (list::iterator it = rpn.begin(); it != rpn.end();) - { - if ((*it)->lhs() != NULL) - { - if ((*it)->rhs() != NULL) - { - int _arity = 2; - int variant = (*it)->variant(); - switch (variant) - { - case ADD_OP: - case MULT_OP: - { - if (arity.find(*it) != arity.end()) - { - ++it; - break; - } - bool found = false; - list::iterator old = it, tmp = it; - for (++it; it != rpn.end(); ++it) - { - if ((*it)->variant() == variant && (((*it)->lhs() != NULL && (*it)->lhs()->variant() == variant) || ((*it)->rhs() != NULL && (*it)->rhs()->variant() == variant))) - { - rpn.erase(tmp); - tmp = it; - ++_arity; - } - else if ((*it)->lhs() != NULL || (unrolled && ((*it)->variant() == ARRAY_REF || (*it)->variant() == FUNC_CALL))) - break; - else if (found == false) - { - old = it; - found = true; - } - } - - arity[*tmp] = _arity; - if (found == true) - it = ++old; - break; - } - default: - arity[*it] = _arity; - ++it; - break; - } - } - else - { - if ((*it)->variant() == FUNC_CALL || (*it)->variant() == ARRAY_REF) - arity[*it] = ((SgExprListExp*)(*it)->lhs())->length(); - else - arity[*it] = 1; - ++it; - } - } - else - ++it; - } -} - -SgExpression* Loop::simplify(SgExpression* expr) const -{ - if (enable_opt == false || expr == NULL) - return expr; - - list rpn; - map arity; - - getRPN(expr, rpn); - optimizeRPN(rpn, arity, false); - unrollRPN(rpn, arity); - optimizeRPN(rpn, arity, true); - - bool changed = true; - while (changed == true) - { - changed = false; - stack stack; - for (list::iterator it = rpn.begin(); it != rpn.end(); ++it) - { - if ((*it)->lhs() != NULL) - { - if ((*it)->rhs() != NULL) - { - int _arity = arity[*it]; - vector args(_arity); - for (int i = _arity - 1; i >= 0; --i) - { - args[i] = stack.top(); - stack.pop(); - } - SgExpression* result = NULL; - switch ((*it)->variant()) - { - case ADD_OP: - { - result = new SgValueExp(0); - list _args; - for (int i = 0; i < _arity; ++i) - { - switch (args[i]->variant()) - { - case BOOL_VAL: - compute(result, ((SgValueExp*)args[i])->boolValue() == true ? -1 : 0, (*it), add, ); - break; - case INT_VAL: - compute(result, ((SgValueExp*)args[i])->intValue(), (*it), add, ); - break; - case FLOAT_VAL: - compute(result, (float)strtod(((SgValueExp*)args[i])->floatValue(), NULL), (*it), add, ); - break; - case DOUBLE_VAL: - compute(result, strtod(((SgValueExp*)args[i])->doubleValue(), NULL), (*it), add, ); - break; - default: - _args.push_back(args[i]); - break; - } - } - for (list::iterator it1 = _args.begin(); it1 != _args.end();) - { - bool cond = (*it1)->variant() == MINUS_OP; - bool changed = false; - for (list::iterator it2 = it1; it2 != _args.end();) - { - if (cond == true && ExpCompare((*it1)->lhs(), *it2) == 1 || cond == false && (*it2)->variant() == MINUS_OP && ExpCompare(*it1, (*it2)->lhs()) == 1) - { - it1 = _args.erase(it1); - if (it1 == it2) - { - it2 = _args.erase(it2); - it1 = it2; - } - else - it2 = _args.erase(it2); - changed = true; - } - else - ++it2; - } - if (changed == false) - ++it1; - } - if (_args.size() + 1 < args.size()) - changed = true; - bool zero = false; - switch (result->variant()) - { - case BOOL_VAL: - zero = ((SgValueExp*)result)->boolValue() == false; - break; - case INT_VAL: - zero = ((SgValueExp*)result)->intValue() == 0; - break; - case FLOAT_VAL: - zero = (float)strtod(((SgValueExp*)result)->floatValue(), NULL) == 0.0f; - break; - case DOUBLE_VAL: - zero = strtod(((SgValueExp*)result)->doubleValue(), NULL) == 0.0; - break; - default: - break; - } - if (zero == true) - { - if (_args.size() != 0) - { - result = *_args.begin(); - for (list::iterator it = ++_args.begin(); it != _args.end(); ++it) - result = &(**it + *result); - } - } - else - for (list::iterator it = _args.begin(); it != _args.end(); ++it) - result = &(**it + *result); - break; - } - case MULT_OP: - { - result = new SgValueExp(1); - list _args; - for (int i = 0; i < _arity; ++i) - { - switch (args[i]->variant()) - { - case BOOL_VAL: - compute(result, ((SgValueExp*)args[i])->boolValue() == true ? -1 : 0, (*it), multiply, ); - break; - case INT_VAL: - compute(result, ((SgValueExp*)args[i])->intValue(), (*it), multiply, ); - break; - case FLOAT_VAL: - compute(result, (float)strtod(((SgValueExp*)args[i])->floatValue(), NULL), (*it), multiply, ); - break; - case DOUBLE_VAL: - compute(result, strtod(((SgValueExp*)args[i])->doubleValue(), NULL), (*it), multiply, ); - break; - default: - _args.push_back(args[i]); - break; - } - } - - if (_args.size() + 1 < args.size()) - changed = true; - bool one = false; - switch (result->variant()) - { - case BOOL_VAL: - one = ((SgValueExp*)result)->boolValue() == true; - break; - case INT_VAL: - one = ((SgValueExp*)result)->intValue() == 1; - break; - case FLOAT_VAL: - one = (float)strtod(((SgValueExp*)result)->floatValue(), NULL) == 1.0f; - break; - case DOUBLE_VAL: - one = strtod(((SgValueExp*)result)->doubleValue(), NULL) == 1.0; - break; - default: - break; - } - - if (one == true) - { - if (_args.size() != 0) - { - result = *_args.begin(); - for (list::iterator it = ++_args.begin(); it != _args.end(); ++it) - result = &(**it * *result); - } - } - else - { - for (list::iterator it = _args.begin(); it != _args.end(); ++it) - result = &(**it * *result); - } - break; - } - case DIV_OP: - { - SgExpression* lhs = args[0]; - SgExpression* rhs = args[1]; - changed = true; - if (ExpCompare(lhs, rhs) == 1) - { - result = new SgValueExp(1); - break; - } - else if (lhs->variant() == MINUS_OP && ExpCompare(lhs->lhs(), rhs) == 1 || rhs->variant() == MINUS_OP && ExpCompare(lhs, rhs->lhs()) == 1) - { - result = new SgValueExp(-1); - break; - } - - result = new SgExpression(lhs->thellnd); - bool error = false; - switch (rhs->variant()) - { - case BOOL_VAL: - { - bool value = ((SgValueExp*)rhs)->boolValue(); - if (value == false) - { - error = true; - break; - } - compute(result, value == true ? -1 : 0, (*it), divide,); - break; - } - case INT_VAL: - { - int value = ((SgValueExp*)rhs)->intValue(); - if (value == 0) - { - error = true; - break; - } - compute(result, value, (*it), divide,); - break; - } - case FLOAT_VAL: - { - float value = (float)strtod(((SgValueExp*)rhs)->floatValue(), NULL); - if (value == 0.0f) - { - error = true; - break; - } - compute(result, value, (*it), divide,); - break; - } - case DOUBLE_VAL: - { - double value = strtod(((SgValueExp*)rhs)->doubleValue(), NULL); - if (value == 0.0) - { - error = true; - break; - } - compute(result, value, (*it), divide,); - break; - } - default: - changed = false; - delete result; - result = *it; - break; - } - if (error == true) - { - changed = false; - delete result; - result = *it; - } - break; - } - case EXP_OP: - { - SgExpression* lhs = args[0]; - SgExpression* rhs = args[1]; - result = new SgExpression(lhs->thellnd); - changed = true; - switch (rhs->variant()) - { - case BOOL_VAL: - compute(result, (((SgValueExp*)rhs)->boolValue() == true ? -1 : 0), (*it), pow, (float)); - break; - case INT_VAL: - compute(result, ((SgValueExp*)rhs)->intValue(), (*it), pow, (float)); - break; - case FLOAT_VAL: - compute(result, strtod(((SgValueExp*)rhs)->floatValue(), NULL), (*it), pow,); - break; - case DOUBLE_VAL: - compute(result, strtod(((SgValueExp*)rhs)->doubleValue(), NULL), (*it), pow,); - break; - default: - changed = false; - delete result; - result = *it; - break; - } - break; - } - default: - // unsupported node with two subtrees, let compiler deal with it - result = *it; - break; - } - stack.push(result); - } - else - { - switch ((*it)->variant()) - { - case FUNC_CALL: - { - vector args(arity[*it]); - for (int i = arity[*it] - 1; i >= 0; --i) - { - args[i] = stack.top(); - stack.pop(); - } - for (unsigned int i = 0; i < args.size(); ++i) - *((SgFunctionCallExp*)*it)->arg(i) = *args[i]; - - // probably can be evaluated - stack.push(*it); - break; - } - case ARRAY_REF: - { - vector subscripts(arity[*it]); - for (int i = arity[*it] - 1; i >= 0; --i) - { - subscripts[i] = stack.top(); - stack.pop(); - } - for (unsigned int i = 0; i < subscripts.size(); ++i) - *((SgArrayRefExp*)*it)->subscript(i) = *subscripts[i]; - - stack.push(*it); - break; - } - case MINUS_OP: - { - SgExpression* arg = stack.top(); - SgExpression* result; - stack.pop(); - changed = true; - switch (arg->variant()) - { - case BOOL_VAL: - result = new SgValueExp(((SgValueExp*)arg)->boolValue() == true ? 1 : 0); - break; - case INT_VAL: - result = new SgValueExp(-((SgValueExp*)arg)->intValue()); - break; - case FLOAT_VAL: - result = new SgValueExp(-(float)strtod(((SgValueExp*)arg)->floatValue(), NULL)); - break; - case DOUBLE_VAL: - result = new SgValueExp(-strtod(((SgValueExp*)arg)->doubleValue(), NULL)); - break; - case MINUS_OP: - result = arg->lhs(); - break; - case UNARY_ADD_OP: - result = new SgExpression(MINUS_OP, new SgExpression(arg->lhs()->thellnd), NULL, NULL); - default: - changed = false; - result = *it; - break; - } - stack.push(result); - break; - } - case UNARY_ADD_OP: - break; - default: - // unsupported node with one subtree, let compiler deal with it - stack.push(*it); - break; - } - } - } - else - stack.push(*it); - } - - if (changed == true) - { - rpn.clear(); - getRPN(stack.top(), rpn); - arity.clear(); - optimizeRPN(rpn, arity, false); - unrollRPN(rpn, arity); - optimizeRPN(rpn, arity, true); - } - else - *expr = *stack.top(); - } - return expr; -} - - -void Access::getReferences(SgExpression* expr, - set& references, - map& unparsedRefs, - map& refs) const -{ - vector subexprs; - subexprs.push_back(expr); - int k = 0; - for (vector::iterator p = subexprs.begin(); p != subexprs.end(); ++k, p = subexprs.begin() + k) - { - if ((*p)->variant() != VAR_REF && (*p)->variant() != ARRAY_REF) - { - SgExpression* lhs = (*p)->lhs(); - SgExpression* rhs = (*p)->rhs(); - if (lhs != NULL) - subexprs.push_back(lhs); - if (rhs != NULL) - subexprs.push_back(rhs); - } - else - { - // array reference subscripts are not real dependencies on loop indices - if ((*p)->variant() == ARRAY_REF) - continue; - string s((*p)->symbol()->identifier()); - refs[s] = *p; - unparsedRefs[*p] = s; - } - } - - for (map::iterator it = unparsedRefs.begin(); it != unparsedRefs.end(); ++it) - references.insert(refs[it->second]); -} - -void Access::analyze() -{ - const Loop* loop = array->getLoop(); - const vector& blocks = loop->getBlocks(); - const map& blockIn = loop->getBlockIn(); - const vector& symbols = loop->getSymbols(); - int dimension = array->getDimension(); - alignment = new int [dimension]; - - for (int i = 0; i < dimension; ++i) - alignment[i] = -1; - - int i = 0; - for (SgExpression* expr = this->expr; expr != NULL; ++i, expr = expr->rhs()) - { - map unparsedRefs; - map refs; - set references, result; - getReferences(expr->lhs(), references, unparsedRefs, refs); - result = references; - map > definitions; - definitions[expr->lhs()] = blocks[blockIndex].INrd; - bool changed = true; - while (changed == true) - { - changed = false; - set new_references; - map > new_definitions; - for (set::iterator ref = references.begin(); ref != references.end(); ++ref) - { - bool found = false; - for (size_t j = 0; j < symbols.size(); ++j) - { - if (symbols[j] == (*ref)->symbol()) - { - new_references.insert(*ref); - result.insert(*ref); - found = true; - break; - } - } - - if (found == false) - { - for (set::iterator def = definitions[*ref].begin(); def != definitions[*ref].end(); ++def) - { - if (unparsedLhs[(*def)->expr(0)] == unparsedRefs[*ref]) - { - getReferences(rhs[unparsedRhs[(*def)->expr(1)]], new_references, unparsedRefs, refs); - for (set::iterator it = new_references.begin(); it != new_references.end(); ++it) - new_definitions[*it].insert(blocks[blockIn.at(*def)].INrd.begin(), blocks[blockIn.at(*def)].INrd.end()); - found = true; - } - } - - if (found == true) - result.erase(*ref); - } - } - - if (new_references != references) - { - references = new_references; - definitions = new_definitions; - changed = true; - } - } - - references.clear(); - for (set::iterator it = result.begin(); it != result.end(); ++it) - references.insert(refs[unparsedRefs[*it]]); - - if (references.size() == 1) - { - for (size_t j = 0; j < symbols.size(); ++j) - { - if (symbols[j] == (*references.begin())->symbol()) - alignment[i] = j; - } - } - else if (references.size() > 1) - alignment[i] = -2; - } - - for (i = 0; i < symbols.size(); ++i) - { - int j; - for (j = 0; j < dimension; ++j) - { - if (alignment[j] == i) - break; - } - - if (j == dimension) - break; - } - - if (i != symbols.size()) - { - for (int i = 0; i < dimension; ++i) - { - if (alignment[i] == -2) - err((string("array '") + array->getSymbol()->identifier() + "': dependence on multiple loop indices").c_str(), 421, first_do_par); - } - } -} - -void Array::analyze() -{ - alignment = new int [dimension]; - for (int i = 0; i < dimension; ++i) - alignment[i] = -1; - if (accesses.size() == 0) - return; - for (map::iterator it = accesses.begin(); it != accesses.end(); ++it) - it->second->analyze(); - - int* tmp = new int [dimension]; - int* prev = new int [dimension]; - for (int i = 0; i < dimension; ++i) - { - prev[i] = -2; - tmp[i] = accesses.begin()->second->getAlignment()[i]; - } - - for (map::iterator it1 = accesses.begin(); it1 != accesses.end(); ++it1) - { - const int* alignment = it1->second->getAlignment(); - for (int i = 0; i < dimension; ++i) - { - if (alignment[i] > tmp[i]) - { - prev[i] = tmp[i]; - tmp[i] = alignment[i]; - } - } - } - - bool success = true; - for (int i = 0; i < dimension; ++i) - { - if (prev[i] >= 0) - { - success = false; - break; - } - } - - if (success == true) - { - for (int i = 0; i < dimension; ++i) - alignment[i] = tmp[i]; - } - else - err((string("array '") + symbol->identifier() + "': accesses with different subscripts' dependencies were found").c_str(), 422, first_do_par); -} - -void Array::analyzeTransformDimensions() -{ - int dimension = loop->getDimension(); - if (dimension <= 1 || loop->getAcrossType() <= 1) - return; - - int symbols[] = { -1, -1 }; - if (dimension == loop->getAcrossType()) - { - symbols[0] = dimension - 1; - symbols[1] = dimension - 2; - } - else - { - for (size_t i = acrossDims.size() - 1, j = 0; i != 0 && j != 2; --i) - { - if (acrossDims[i] == 1) - symbols[j++] = i; - } - } - - int indices[] = { -1, -1 }; - for (int i = 0; i < this->dimension; ++i) - { - if (symbols[0] == alignment[i]) - indices[0] = i; - else if (symbols[1] == alignment[i]) - indices[1] = i; - } - - if (indices[0] != -1 && indices[1] != -1) - { - indices[0] = this->dimension - indices[0]; - indices[1] = this->dimension - indices[1]; - } - tfmInfo.transformDims.push_back(indices[0]); - tfmInfo.transformDims.push_back(indices[1]); -} - -SgSymbol* Array::findAccess(SgExpression* subscripts, string& expr) -{ - size_t i = 0; - int j = 0; - string id; - for (SgExpression* tmp = subscripts; tmp != NULL && i < 2; ++j, tmp = tmp->rhs()) - { - if (dimension - j == tfmInfo.transformDims[0] || dimension - j == tfmInfo.transformDims[1]) - { - id.append(tmp->lhs()->unparse()).append("_"); - ++i; - } - } - - SgSymbol* result = NULL; - for (i = 0; i < tfmInfo.exprs.size(); ++i) - { - if (tfmInfo.exprs[i].first == id) - { - result = tfmInfo.coefficients[i]; - break; - } - } - - if (result == NULL) - expr = id; - return result; -} - -void Array::addCoefficient(SgExpression* subscripts, string& expr, SgSymbol* symbol) -{ - int i = 0; - for (SgExpression* tmp = subscripts; tmp != NULL; ++i, tmp = tmp->rhs()) - { - if (dimension - i == tfmInfo.transformDims[0]) - tfmInfo.first.push_back(tmp->lhs()); - else if (dimension - i == tfmInfo.transformDims[1]) - tfmInfo.second.push_back(tmp->lhs()); - } - - tfmInfo.exprs.push_back(pair(expr, subscripts->unparse())); - tfmInfo.coefficients.push_back(symbol); -} - -void Loop::analyzeAcrossClause() -{ - for (SgExpression* expr = dvm_parallel_dir->expr(1); expr != NULL; expr = expr->rhs()) - { - SgExpression* tmp = expr->lhs(); - if (tmp->variant() == ACROSS_OP) - { - vector toAnalyze; - SgExpression* list = tmp->lhs(); - while (list) - { - if (list->lhs()->variant() == ARRAY_REF) - toAnalyze.push_back(list->lhs()); - else if (list->lhs()->variant() == ARRAY_OP) - { - if (list->lhs()->lhs()->variant() == ARRAY_REF) - toAnalyze.push_back(list->lhs()->lhs()); - } - list = list->rhs(); - } - - for (int k = 0; k < toAnalyze.size(); ++k) - { - tmp = toAnalyze[k]; - if (arrays.find(tmp->symbol()) == arrays.end()) - warn((string("array '") + tmp->symbol()->identifier() + "': unused").c_str(), 900, first_do_par); - else if (privateList.find(tmp->symbol()) != privateList.end()) - err((string("array '") + tmp->symbol()->identifier() + "': incompatible qualifiers (ACROSS, PRIVATE)").c_str(), 423, first_do_par); - else - { - Array* array = arrays[tmp->symbol()]; - SgExpression* dep = tmp->lhs(); - int i = 0, raw, war, n = 0; - vector& acrossDims = array->getAcrossDims(); - - while (dep != NULL) - { - raw = dep->lhs()->lhs()->valueInteger(); - war = dep->lhs()->rhs()->valueInteger(); - acrossDims[i] = (raw != 0 || war != 0) ? 1 : 0; - n += acrossDims[i]; - i++; - dep = dep->rhs(); - } - - if (n != 0) - array->setAcrossType((1 << n) - 1); - - for (int j = 0; j < abs(dimension - array->getDimension()); ++j) - acrossDims.push_back(-1); - } - } - } - } -} - -void Loop::analyzeAcrossType() -{ - acrossDims = new int [dimension]; - for (int i = 0; i < dimension; ++i) - acrossDims[i] = -1; - - for (map::iterator it = arrays.begin(); it != arrays.end(); ++it) - { - const int* alignment = it->second->getAlignment(); - vector& _acrossDims = it->second->getAcrossDims(); - if (alignment != NULL) - { - for (int i = 0; i < it->second->getDimension(); ++i) - { - if (alignment[i] != -1) - acrossDims[alignment[i]] = max(acrossDims[alignment[i]], _acrossDims[alignment[i]]); - } - } - } - - for (int i = 0; i < dimension; ++i) - { - if (acrossDims[i] != -1) - ++acrossType; - } -} - -void Array::generateAssigns(SgVarRefExp* offsetX, SgVarRefExp* offsetY, SgVarRefExp* Rx, SgVarRefExp* Ry, SgVarRefExp* slash) -{ - if (tfmInfo.ifCalls.size() == 0 && tfmInfo.elseCalls.size() == 0 && tfmInfo.zeroSt.size() == 0) - { - for (size_t i = 0; i < tfmInfo.coefficients.size(); ++i) - { - tfmInfo.zeroSt.push_back(AssignStatement(new SgVarRefExp(tfmInfo.coefficients[i]->copy()), new SgValueExp(0))); - - SgFunctionCallExp* funcCallExpIf = createNewFCall(funcDvmhConvXYname); - SgFunctionCallExp* funcCallExpElse = createNewFCall(funcDvmhConvXYname); - - funcCallExpIf->addArg(*new SgCastExp(*offsetX->type(), tfmInfo.first[i]->copy()) - *offsetX); - funcCallExpIf->addArg(*new SgCastExp(*offsetY->type(), tfmInfo.second[i]->copy()) - *offsetY); - funcCallExpIf->addArg(*Rx); - funcCallExpIf->addArg(*Ry); - funcCallExpIf->addArg(*slash); - funcCallExpIf->addArg(*new SgVarRefExp(tfmInfo.coefficients[i]->copy())); - - funcCallExpElse->addArg(*new SgCastExp(*offsetX->type(), tfmInfo.second[i]->copy()) - *offsetX); - funcCallExpElse->addArg(*new SgCastExp(*offsetY->type(), tfmInfo.first[i]->copy()) - *offsetY); - funcCallExpElse->addArg(*Rx); - funcCallExpElse->addArg(*Ry); - funcCallExpElse->addArg(*slash); - funcCallExpElse->addArg(*new SgVarRefExp(tfmInfo.coefficients[i]->copy())); - - SgStatement* stmt = NULL; - set _accesses; - for (map::iterator it = accesses.begin(); it != accesses.end(); ++it) - { - bool found[2] = { false, false }; - string first(tfmInfo.first[i]->unparse()); - string second(tfmInfo.second[i]->unparse()); - for (SgExpression* tmp = it->second->getSubscripts(); tmp != NULL; tmp = tmp->rhs()) - { - string s(tmp->lhs()->unparse()); - if (s == first) - found[0] = true; - else if (s == second) - found[1] = true; - } - if (found[0] == true && found[1] == true) - _accesses.insert(it->second); - } - - map > blockIndices; - int minIndex = loop->getBlocks().size(); - for (set::iterator it = _accesses.begin(); it != _accesses.end(); ++it) - { - set symbols; - int j = 0; - for (SgExpression* tmp = (*it)->getSubscripts(); tmp != NULL; tmp = tmp->rhs()) - { - if (dimension - j != tfmInfo.transformDims[0] && dimension - j != tfmInfo.transformDims[1]) - continue; - vector _subtrees; - _subtrees.push_back(tmp->lhs()); - int k = 0; - for (vector::iterator p = _subtrees.begin(); p != _subtrees.end(); ++k, p = _subtrees.begin() + k) - { - if ((*p)->variant() == VAR_REF && (*p)->symbol() != NULL) - symbols.insert((*p)->symbol()); - else - { - SgExpression* lhs = (*p)->lhs(); - SgExpression* rhs = (*p)->rhs(); - if (lhs != NULL) - _subtrees.push_back(lhs); - if (rhs != NULL) - _subtrees.push_back(rhs); - } - } - } - - set _symbols(loop->getSymbols().begin(), loop->getSymbols().end()); - set diff; - difference(symbols.begin(), symbols.end(), _symbols.begin(), _symbols.end(), inserter(diff, diff.end())); - const vector& blocks = loop->getBlocks(); - - if (diff.size() != 0) - { - set preds(blocks[(*it)->getBlockIndex()].in.begin(), blocks[(*it)->getBlockIndex()].in.end()); - bool changed = true; - while (changed == true) - { - changed = false; - set new_preds(preds); - for (set::iterator pred = preds.begin(); pred != preds.end(); ++pred) - new_preds.insert(blocks[*pred].in.begin(), blocks[*pred].in.end()); - - if (preds != new_preds) - { - preds = new_preds; - changed = true; - } - } - blockIndices[*it].insert(preds.begin(), preds.end()); - } - else - blockIndices[*it].insert(0); - - minIndex = min(minIndex, (*it)->getBlockIndex()); - } - set common_preds; - for (set::iterator it = _accesses.begin(); it != _accesses.end(); ++it) - common_preds.insert(blockIndices[*it].begin(), blockIndices[*it].end()); - - for (set::iterator it = _accesses.begin(); it != _accesses.end(); ++it) - { - if (blockIndices[*it].size() == 1 && *blockIndices[*it].begin() == 0) - continue; - else - { - set tmp; - intersection(common_preds.begin(), common_preds.end(), blockIndices[*it].begin(), blockIndices[*it].end(), inserter(tmp, tmp.end())); - common_preds = tmp; - } - } - - int max = 0; - for (set::iterator it = common_preds.begin(); it != common_preds.end(); ++it) - { - if (*it < minIndex) - { - if (*it > max) - max = *it; - } - } - - stmt = loop->getBlocks()[max].head; - tfmInfo.ifCalls[stmt].push_back(funcCallExpIf); - tfmInfo.elseCalls[stmt].push_back(funcCallExpElse); - } - } -} - -bool Loop::irregularAnalysisIsOn() const -{ - return do_irreg_opt; -} - -static bool isOnlyParS(SgExpression* ex, SgSymbol* parS) -{ - bool ret = true; - if (ex) - { - if (ex->variant() != VAR_REF || ex->variant() == CONST_REF) - return false; - if (ex->variant() == VAR_REF) - if (ex->symbol()->identifier() != string(parS->identifier())) - return false; - - bool left = isOnlyParS(ex->lhs(), parS); - bool right = isOnlyParS(ex->rhs(), parS); - ret = left && right; - } - return ret; -} - -static void analyzeExpr(SgExpression* ex, SgSymbol* parS, int arrayLvl, bool& needOpt, bool& wasInderectAccess) -{ - if (ex) - { - if (ex->variant() == ARRAY_REF) - { - if (arrayLvl > 0) - wasInderectAccess = true; - arrayLvl++; - if (isOnlyParS(ex->lhs(), parS) == false) - needOpt = true; - } - - analyzeExpr(ex->lhs(), parS, arrayLvl, needOpt, wasInderectAccess); - analyzeExpr(ex->rhs(), parS, arrayLvl, needOpt, wasInderectAccess); - } -} - -void Loop::analyzeInderectAccess() -{ - if (symbols.size() != 1) - return; - - SgStatement* stmt = loop_body; - bool wasInderectAccess = false; - bool needOpt = false; - while (stmt) - { - for (int z = 0; z < 3; ++z) - analyzeExpr(stmt->expr(z), symbols[0], 0, needOpt, wasInderectAccess); - stmt = stmt->lexNext(); - } - - if (wasInderectAccess && needOpt) - do_irreg_opt = true; -} - -Loop::Loop(SgStatement* loop_body, bool enable_opt, bool irreg_access) : - irregular_acc_opt(irreg_access), enable_opt(enable_opt), loop_body(loop_body), - dimension(0), acrossType(0), acrossDims(NULL), do_irreg_opt(false) -{ - reduction_operation_list* rsl; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (rsl->locvar) //MAXLOC,MINLOC - redArrays.insert(rsl->locvar); - } - - lhs.clear(); - rhs.clear(); - unparsedLhs.clear(); - unparsedRhs.clear(); - - buildCFG(); - setupSubstitutes(); - for (int i = 2; i < blocks.size(); ++i) - if (blocks[i].head != NULL && (blocks[i].head->variant() == ASSIGN_STAT || blocks[i].head->variant() == PROC_STAT)) - analyzeAssignments(blocks[i].index, blocks[i].head); - - for (SgExpression* tmp = dvm_parallel_dir->expr(2); tmp != NULL; tmp = tmp->rhs()) - { - symbols.push_back(tmp->lhs()->symbol()); - ++dimension; - } - - for (SgExpression* tmp = dvm_parallel_dir->expr(1); tmp != NULL; tmp = tmp->rhs()) - { - SgExpression* t = tmp->lhs(); - if (t->variant() == ACC_PRIVATE_OP) - { - for (t = t->lhs(); t != NULL; t = t->rhs()) - { - if (isSgArrayType(t->lhs()->symbol()->type()) != NULL) - privateList.insert(t->lhs()->symbol()); - } - } - } - - SgSymbol* symbol = NULL; - SgExpression* subscripts = NULL; - - if (dvm_parallel_dir->expr(0)) - { - symbol = dvm_parallel_dir->expr(0)->symbol(); - subscripts = ((SgArrayRefExp*)dvm_parallel_dir->expr(0))->subscripts(); - } - else // TIE - { - SgExpression* arc = findDirect(dvm_parallel_dir->expr(1), ACROSS_OP); - SgExpression* tie = findDirect(dvm_parallel_dir->expr(1), ACC_TIE_OP); - - if (arc != NULL && tie == NULL) - { - err("internal error in across", 424, first_do_par); - exit(-1); - } - else if (arc && tie) - { - map acrossArrays, tieArrays; - SgExpression* ex = arc->lhs(); - while (ex) - { - acrossArrays[ex->lhs()->symbol()->identifier()] = ex->lhs(); - ex = ex->rhs(); - } - ex = tie->lhs(); - while (ex) - { - tieArrays[ex->lhs()->symbol()->identifier()] = ex->lhs(); - ex = ex->rhs(); - } - - bool errM = false; - for (map::iterator acrA = acrossArrays.begin(); acrA != acrossArrays.end(); acrA++) - { - if (tieArrays.find(acrA->first) == tieArrays.end()) - { - errM = true; - err((string("can not find array '") + acrA->first + "' in TIE clause").c_str(), 425, first_do_par); - } - } - if (errM) - exit(-1); - - //TODO: multiple arrays - for (map::iterator acrA = acrossArrays.begin(); acrA != acrossArrays.end(); acrA++) - { - SgExpression* firstTie = tieArrays[acrA->first]; - symbol = firstTie->symbol(); - subscripts = ((SgArrayRefExp*)firstTie)->subscripts(); - break; - } - } - else - { - if (irreg_access) - analyzeInderectAccess(); - return; - } - } - //TODO: tmp is undefined in this scope - if (arrays.find(symbol) == arrays.end()) - warn((string("array '") + symbol->identifier() + "': unused").c_str(), 900, first_do_par); - - for (map::iterator it1 = arrays.begin(); it1 != arrays.end(); ++it1) - { - if (privateList.find(it1->second->getSymbol()) == privateList.end()) - it1->second->analyze(); - } - - // ACROSS_ANALYZER - if (WithAcrossClause() == 0) - { - if (irreg_access) - analyzeInderectAccess(); - return; - } - - analyzeAcrossClause(); - vector acrossDims(symbols.size(), -1); - if (arrays.find(symbol) != arrays.end()) - acrossDims = arrays[symbol]->getAcrossDims(); - - size_t i; - for (i = 0; i < symbols.size(); ++i) - { - if (acrossDims[i] != -1) - break; - if (i == symbols.size()) - err((string("array '") + symbol->identifier() + "': mapped on different template than corresponding parallel loop").c_str(), 424, first_do_par); - } - - analyzeAcrossType(); - if (acrossType > 1) - { - for (map::iterator it1 = arrays.begin(); it1 != arrays.end(); ++it1) - { - if (privateList.find(it1->second->getSymbol()) == privateList.end()) - it1->second->analyzeTransformDimensions(); - } - } - -#if 0 - printf("Loop indices(%d):", dimension); - for (vector::iterator it = symbols.begin(); it != symbols.end(); ++it) - printf(" %s", (*it)->identifier()); - printf("\n"); - printf("Private arrays:"); - for (set::iterator it = privateList.begin(); it != privateList.end(); ++it) - printf(" \"%s\"", (*it)->identifier()); - printf("\n"); - for (map::iterator it1 = arrays.begin(); it1 != arrays.end(); ++it1) - { - if (privateList.find(it1->first) == privateList.end()) - { - printf("Array %s:", it1->second->getSymbol()->identifier()); - for (int i = 0; i < it1->second->getDimension(); ++i) - printf(" %d", it1->second->getAlignment()[i]); - printf("\n"); - } - printf(" AcrossDims:"); - for (vector::iterator it2 = it1->second->getAcrossDims().begin(); it2 != it1->second->getAcrossDims().end(); ++it2) - printf(" %d", *it2); - printf("\n"); - printf(" AcrossType: %d\n", it1->second->getAcrossType()); - if (privateList.find(it1->first) == privateList.end()) - { - printf(" TransformDims:"); - for (vector::iterator it2 = it1->second->getTfmInfo().transformDims.begin(); it2 != it1->second->getTfmInfo().transformDims.end(); ++it2) - printf(" %d", *it2); - printf("\n"); - for (map::iterator it2 = it1->second->getAccesses().begin(); it2 != it1->second->getAccesses().end(); ++it2) - { - printf(" Access:"); - for (int i = 0; i < it1->second->getDimension(); ++i) - printf(" %d", it2->second->getAlignment()[i]); - printf("\n"); - } - } - } - printf(" LoopAcrossType: %d\n", acrossType); - printf(" LoopAcrossDims:"); - for (int i = 0; i < dimension; ++i) - printf(" %d", acrossDims[i]); - printf("\n"); - char* scriptName = new char[64]; - sprintf(scriptName, "cfg.loop_%d.gv", first_do_par->lineNumber()); - visualize(scriptName); - delete[]scriptName; - printf("############################################################\n"); -#endif -} - -void Loop::analyzeAssignments(SgExpression* ex, const int blockIndex) -{ - if (ex->variant() != ARRAY_REF) - { - SgExpression* lhs = ex->lhs(); - SgExpression* rhs = ex->rhs(); - if (lhs) - analyzeAssignments(lhs, blockIndex); - if (rhs) - analyzeAssignments(rhs, blockIndex); - } - else - { - SgSymbol* symbol = ex->symbol(); - if (isSgArrayType(symbol->type()) != NULL && redArrays.find(symbol) == redArrays.end()) - { - SgExpression* subscripts = ((SgArrayRefExp*)(ex))->subscripts(); - if (!subscripts) - return; - - for (SgExpression* tmp = subscripts; tmp != NULL; tmp = tmp->rhs()) - tmp->setLhs(simplify(tmp->lhs())); - - string s(subscripts->unparse()); - if (arrays.find(symbol) == arrays.end()) - { - Array* array = new Array(symbol, isSgArrayType(symbol->type())->dimension(), this); - arrays[symbol] = array; - array->getAccesses()[s] = new Access(subscripts, s, array, blockIndex); - } - else - { - Array* array = arrays[symbol]; - if (array->getAccesses().find(s) == array->getAccesses().end()) - array->getAccesses()[s] = new Access(subscripts, s, array, blockIndex); - } - } - } -} - -void Loop::analyzeAssignments(int blockIndex, SgStatement* stmt) -{ - for (int i = 0; i < 3; ++i) - if (stmt->expr(i)) - analyzeAssignments(stmt->expr(i), blockIndex); -} - -inline bool Loop::IsTargetable(SgStatement* stmt) const -{ - return stmt != NULL - && stmt->variant() != ELSEIF_NODE - && stmt->variant() != CASE_NODE - && stmt->variant() != DEFAULT_NODE - && stmt->variant() != CONTROL_END; -} - -void Loop::buildCFG() -{ - SgStatement* stmt = loop_body; - map controlFlow; - map > blockOut; - - map > GENae, KILLae, INae, OUTae; - map > EXTRA; - map > GENrd, KILLrd; - map > blockAssignments; - map assignments; - set allStmts; - - BasicBlock entry; - entry.index = ENTRY; - BasicBlock exit; - exit.index = EXIT; - blockOut[ENTRY].push_back(stmt); - blockIn[NULL] = EXIT; - blocks.push_back(entry); - blocks.push_back(exit); - int i = 2; - - while (stmt != NULL) - { - BasicBlock block; - block.index = i; - block.head = stmt; - blockIn[stmt] = i; - vector& out = blockOut[i]; - list stmts; - - while (stmt != NULL) - { - bool tail = true; - switch (stmt->variant()) - { - case WHERE_NODE: - break; - case WHERE_BLOCK_STMT: - break; - case ELSEWH_NODE: - break; - case SWITCH_NODE: - { - SgSwitchStmt* _stmt = (SgSwitchStmt*)stmt; - controlFlow[_stmt] = IsTargetable(_stmt->lastNodeOfStmt()->lexNext()) - && _stmt->lastNodeOfStmt()->lexNext()->controlParent() == _stmt->controlParent() ? _stmt->lastNodeOfStmt()->lexNext() : controlFlow[_stmt->controlParent()]; - - if (_stmt->caseOption(0) == NULL) - { - if (_stmt->defOption() == NULL) - out.push_back(controlFlow[_stmt]); - else - out.push_back(_stmt->defOption()); - } - else - out.push_back(_stmt->caseOption(0)); - break; - } - case CASE_NODE: - { - SgSwitchStmt* switchStmt = ((SgSwitchStmt*)stmt->controlParent()); - controlFlow[stmt] = controlFlow[switchStmt]; - int i; - for (i = 0; i < switchStmt->numberOfCaseOptions() && stmt != switchStmt->caseOption(i); i++); - - SgStatement* nextStmt = stmt->lexNext(); - if (nextStmt->variant() != CASE_NODE && nextStmt->variant() != DEFAULT_NODE && nextStmt->variant() != CONTROL_END) - out.push_back(nextStmt); - - if (i == switchStmt->numberOfCaseOptions() - 1) - { - if (switchStmt->defOption() != NULL) - out.push_back(switchStmt->defOption()); - else - out.push_back(controlFlow[stmt]); - } - else - out.push_back(switchStmt->caseOption(i + 1)); - break; - } - case DEFAULT_NODE: - { - controlFlow[stmt] = controlFlow[stmt->controlParent()]; - SgStatement* nextStmt = stmt->lexNext(); - - if (nextStmt->variant() != CASE_NODE && nextStmt->variant() != CONTROL_END) - out.push_back(nextStmt); - out.push_back(controlFlow[stmt]); - break; - } - case ARITHIF_NODE: - // something wrong with SgArithIfStmt::label(...) method, this seems ok - out.push_back(StmtWithLabel(((SgLabelRefExp*)LlndMapping(getPositionInExprList(BIF_LL2(stmt->thebif), 0)))->label())); - out.push_back(StmtWithLabel(((SgLabelRefExp*)LlndMapping(getPositionInExprList(BIF_LL2(stmt->thebif), 1)))->label())); - out.push_back(StmtWithLabel(((SgLabelRefExp*)LlndMapping(getPositionInExprList(BIF_LL2(stmt->thebif), 2)))->label())); - break; - case IF_NODE: - { - SgStatement* falseBody = ((SgIfStmt*)stmt)->falseBody(); - SgStatement* _stmt = stmt; - while (falseBody != NULL && falseBody->variant() == ELSEIF_NODE) - { - _stmt = falseBody; - falseBody = ((SgIfStmt*)falseBody)->falseBody(); - } - - controlFlow[stmt] = IsTargetable(_stmt->lastNodeOfStmt()->lexNext()) - && _stmt->lastNodeOfStmt()->lexNext()->controlParent() == stmt->controlParent() ? _stmt->lastNodeOfStmt()->lexNext() : controlFlow[stmt->controlParent()]; - - SgStatement* trueBody = ((SgIfStmt*)stmt)->trueBody(); - falseBody = ((SgIfStmt*)stmt)->falseBody(); - bool trueBodyCond = trueBody != NULL && trueBody->variant() != CONTROL_END; - bool falseBodyCond = falseBody != NULL && falseBody->variant() != CONTROL_END; - - if (trueBodyCond == true) - out.push_back(trueBody); - - if (falseBodyCond == true) - out.push_back(falseBody); - - if (trueBodyCond == false || falseBodyCond == false) - out.push_back(controlFlow[stmt]); - break; - } - case ELSEIF_NODE: - { - controlFlow[stmt] = controlFlow[stmt->controlParent()]; - SgStatement* trueBody = ((SgIfStmt*)stmt)->trueBody(); - SgStatement* falseBody = ((SgIfStmt*)stmt)->falseBody(); - bool trueBodyCond = trueBody != NULL && trueBody->variant() != CONTROL_END; - bool falseBodyCond = falseBody != NULL && falseBody->variant() != CONTROL_END; - if (trueBodyCond == true) - out.push_back(trueBody); - - if (falseBodyCond == true) - out.push_back(falseBody); - - if (trueBodyCond == false || falseBodyCond == false) - out.push_back(controlFlow[stmt]); - break; - } - case LOGIF_NODE: - controlFlow[stmt] = IsTargetable(stmt->lastNodeOfStmt()->lexNext()) - && stmt->lastNodeOfStmt()->lexNext()->controlParent() == stmt->controlParent() ? stmt->lastNodeOfStmt()->lexNext() : controlFlow[stmt->controlParent()]; - out.push_back(((SgLogIfStmt*)stmt)->body()); - out.push_back(controlFlow[stmt]); - break; - case WHILE_NODE: - { - SgWhileStmt* _stmt = (SgWhileStmt*)stmt; - controlFlow[stmt] = stmt; - out.push_back(_stmt->body()); - SgStatement* st = _stmt->body(); - while (st != NULL && st->controlParent() != stmt->controlParent()) - st = st->lexNext(); - - SgStatement* nextStmt = IsTargetable(st) - && st->controlParent() == stmt->controlParent() ? st : controlFlow[stmt->controlParent()]; - - out.push_back(nextStmt); - break; - } - case COMGOTO_NODE: - { - SgComputedGotoStmt* _stmt = (SgComputedGotoStmt*)stmt; - controlFlow[_stmt] = IsTargetable(_stmt->lastNodeOfStmt()->lexNext()) - && _stmt->lastNodeOfStmt()->lexNext()->controlParent() == _stmt->controlParent() ? _stmt->lastNodeOfStmt()->lexNext() : controlFlow[_stmt->controlParent()]; - - SgExpression* labelList = _stmt->labelList(); - for (int i = 0; i < _stmt->numberOfTargets(); i++, labelList = labelList->rhs()) - out.push_back(StmtWithLabel(((SgLabelRefExp*)labelList->lhs())->label())); - - out.push_back(controlFlow[_stmt]); - break; - } - case FOR_NODE: - { - SgForStmt* _stmt = (SgForStmt*)stmt; - controlFlow[_stmt] = _stmt; - out.push_back(_stmt->body()); - SgStatement* st = _stmt->body(); - while (st != NULL && st->controlParent() != _stmt->controlParent()) - st = st->lexNext(); - SgStatement* nextStmt = IsTargetable(st) - && st->controlParent() == _stmt->controlParent() ? st : controlFlow[_stmt->controlParent()]; - out.push_back(nextStmt); - if (_stmt->symbol() != NULL) - { - SgStatement* inc = new SgAssignStmt(*new SgVarRefExp(_stmt->symbol()), *new SgVarRefExp(_stmt->symbol()) + (_stmt->step() != NULL ? *new SgValueExp(_stmt->step()->valueInteger()) : *new SgValueExp(1))); - blockAssignments[i][inc->expr(0)->unparse()] = inc; - for (list::iterator it = stmts.begin(); it != stmts.end();) - { - if (EXTRA[*it][0]->expr(1)->IsSymbolInExpression(*_stmt->symbol()) != NULL) - it = stmts.erase(it); - else - ++it; - } - } - break; - } - case GOTO_NODE: - out.push_back(StmtWithLabel(((SgGotoStmt*)stmt)->branchLabel())); - break; - case EXIT_STMT: - { - SgExitStmt* _stmt = (SgExitStmt*)stmt; - SgSymbol* constructName = _stmt->constructName(); - SgStatement* parent = _stmt->controlParent(); - if (constructName != NULL) - while (parent != NULL && ((parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) || strcmp(LlndMapping(BIF_LL3(parent->thebif))->unparse(), constructName->identifier()) != 0)) - parent = parent->controlParent(); - else - while (parent != NULL && parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) - parent = parent->controlParent(); - if (parent != NULL) - { - SgStatement* st = ((SgForStmt*)parent)->body(); - while (st != NULL && st->controlParent() != parent->controlParent()) - st = st->lexNext(); - out.push_back((IsTargetable(st) && st->controlParent() == parent->controlParent()) ? st : controlFlow[parent->controlParent()]); - } - else - out.push_back(NULL);//jump to parallel DOs - break; - } - case CYCLE_STMT: - { - SgCycleStmt* _stmt = (SgCycleStmt*)stmt; - SgSymbol* constructName = _stmt->constructName(); - SgStatement* parent = _stmt->controlParent(); - if (constructName != NULL) - while (parent != NULL && ((parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) || strcmp(LlndMapping(BIF_LL3(parent->thebif))->unparse(), constructName->identifier()) != 0)) - parent = parent->controlParent(); - else - while (parent != NULL && parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) - parent = parent->controlParent(); - out.push_back(parent); - break; - } - case ASSIGN_STAT: - { - string s0(simplify(stmt->expr(0))->unparse()); - string s1(simplify(stmt->expr(1))->unparse()); - unparsedLhs[stmt->expr(0)] = s0; - unparsedRhs[stmt->expr(1)] = s1; - lhs[s0] = stmt->expr(0); - rhs[s1] = stmt->expr(1); - if (s0 != s1) - { - if (stmt->expr(0)->variant() == ARRAY_REF) - { - bool success = true; - for (SgExpression* tmp = ((SgArrayRefExp*)stmt->expr(0))->subscripts(); tmp != NULL; tmp = tmp->rhs()) - { - if (tmp->lhs()->variant() != CONST_REF) - { - success = false; - break; - } - } - - if (success == true) - blockAssignments[i][s0] = stmt; - else - blockAssignments[i][stmt->expr(0)->symbol()->identifier()] = stmt; - } - else - blockAssignments[i][s0] = stmt; - - GENrd[i].insert(stmt); - assignments[stmt] = s1; - EXTRA[s1].push_back(stmt); - stmts.push_back(s1); - allStmts.insert(s1); - - for (list::iterator it = stmts.begin(); it != stmts.end();) - { - if (FindInExpr(stmt->expr(0), EXTRA[*it][0]->expr(1)) != 0) - it = stmts.erase(it); - else - ++it; - } - } - } - default: - { - if (stmt->hasLabel() == false) - tail = false; - else - { - SgStatement* parent = stmt->controlParent(); - while (parent != NULL && (parent->variant() == FOR_NODE || parent->variant() == WHILE_NODE)) - { - if (BIF_LABEL_USE(parent->thebif) != NULL && LABEL_STMTNO(BIF_LABEL_USE(parent->thebif)) == LABEL_STMTNO(stmt->label()->thelabel)) - out.push_back(parent); - parent = parent->controlParent(); - } - if (out.size() != 0) - break; - } - - SgStatement* _stmt = stmt->lexNext(); - if (_stmt != NULL) - { - switch (_stmt->variant()) - { - case FOR_NODE: - case WHILE_NODE: - case WHERE_NODE: - case WHERE_BLOCK_STMT: - tail = true; - out.push_back(_stmt); - break; - case ELSEIF_NODE: - case ELSEWH_NODE: - case CASE_NODE: - case DEFAULT_NODE: - case CONTROL_END: - tail = true; - out.push_back(controlFlow[_stmt->controlParent()]); - break; - case FORMAT_STAT: - tail = false; - break; - default: - if (_stmt->hasLabel() == false) - { - //tail = false;break;// builds CFG of Extended Basic Blocks - tail = true; - out.push_back(_stmt); - break; - } - else - { - SgStatement* parent = _stmt->controlParent(); - while (parent != NULL && (parent->variant() == FOR_NODE || parent->variant() == WHILE_NODE)) - { - if (BIF_LABEL_USE(parent->thebif) != NULL && LABEL_STMTNO(BIF_LABEL_USE(parent->thebif)) == LABEL_STMTNO(_stmt->label()->thelabel)) - { - tail = false; - break; - } - parent = parent->controlParent(); - } - //can't find way to get stmts referencing this label - //just start new block even if label is not referenced - tail = true; - out.push_back(_stmt); - break; - } - break; - } - } - else - out.push_back(NULL); - break; - } - } - - if (tail == true) - { - GENae[i].insert(stmts.begin(), stmts.end()); - block.tail = stmt; - blocks.push_back(block); - } - - stmt = stmt->lexNext(); - while (stmt != NULL && stmt->variant() == CONTROL_END) - stmt = stmt->lexNext(); - - if (tail == true) - break; - } - i++; - } - - for (map >::iterator it1 = blockOut.begin(); it1 != blockOut.end(); ++it1) - { - for (vector::iterator it2 = it1->second.begin(); it2 != it1->second.end(); ++it2) - { - blocks[it1->first].out.push_back(blockIn[*it2]); - blocks[blockIn[*it2]].in.push_back(it1->first); - } - } - blockOut.clear(); - controlFlow.clear(); - - for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) - { - map* bAssignments = &blockAssignments[block->index]; - for (map::iterator it = assignments.begin(); it != assignments.end(); ++it) - { - SgStatement* stmt = NULL; - SgExpression* lhs = it->first->expr(0); - if (it->first->expr(0)->variant() == ARRAY_REF) - stmt = bAssignments->find(lhs->symbol()->identifier()) != bAssignments->end() ? - (*bAssignments)[lhs->symbol()->identifier()] : (*bAssignments)[unparsedLhs[lhs]]; - else - stmt = (*bAssignments)[unparsedLhs[lhs]]; - - if (stmt != NULL && stmt != it->first && blockIn[it->first] != block->index) - KILLrd[block->index].insert(it->first); - } - - for (SgStatement* stmt = block->head; stmt != block->tail->lexNext(); stmt = stmt->lexNext()) - { - if (stmt == NULL) - continue; - if (stmt->variant() == ASSIGN_STAT || stmt->variant() == FOR_NODE) - { - SgExpression* expr = stmt->variant() == ASSIGN_STAT ? stmt->expr(0) : (*bAssignments)[stmt->symbol()->identifier()]->expr(0); - for (map::iterator it = assignments.begin(); it != assignments.end(); ++it) - if (FindInExpr(expr, it->first->expr(1)) != 0) - KILLae[block->index].insert(it->second); - } - } - block->OUTrd.swap(GENrd[block->index]); - difference(allStmts.begin(), allStmts.end(), KILLae[block->index].begin(), KILLae[block->index].end(), inserter(OUTae[block->index], OUTae[block->index].end())); - } - allStmts.clear(); - assignments.clear(); - blockAssignments.clear(); - - - bool changed = true; - while (changed == true) - { - changed = false; - for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) - { - for (vector::iterator it = block->in.begin(); it != block->in.end(); ++it) - block->INrd.insert(blocks[*it].OUTrd.begin(), blocks[*it].OUTrd.end()); - set newOUTrd(GENrd[block->index].begin(), GENrd[block->index].end()); - difference(block->INrd.begin(), block->INrd.end(), KILLrd[block->index].begin(), KILLrd[block->index].end(), inserter(newOUTrd, newOUTrd.end())); - if (newOUTrd != block->OUTrd) - { - block->OUTrd.swap(newOUTrd); - changed = true; - } - } - } - GENrd.clear(); - KILLrd.clear(); - - changed = true; - while (changed == true) - { - changed = false; - for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) - { - if (block->in.size() != 0) - { - INae[block->index] = set(OUTae[block->in[0]].begin(), OUTae[block->in[0]].end()); - for (vector::iterator it = block->in.begin() + 1; it != block->in.end(); ++it) - { - set tmp; - intersection(INae[block->index].begin(), INae[block->index].end(), OUTae[*it].begin(), OUTae[*it].end(), inserter(tmp, tmp.end())); - INae[block->index].swap(tmp); - } - } - set _union(GENae[block->index].begin(), GENae[block->index].end()); - _union.insert(INae[block->index].begin(), INae[block->index].end()); - set newOUTae; - difference(_union.begin(), _union.end(), KILLae[block->index].begin(), KILLae[block->index].end(), inserter(newOUTae, newOUTae.end())); - if (newOUTae != OUTae[block->index]) - { - OUTae[block->index].swap(newOUTae); - changed = true; - } - } - } - GENae.clear(); - KILLae.clear(); - - for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) - { - for (set::iterator it1 = INae[block->index].begin(); it1 != INae[block->index].end(); ++it1) - block->INae.insert(EXTRA[*it1].begin(), EXTRA[*it1].end()); - - for (set::iterator it1 = OUTae[block->index].begin(); it1 != OUTae[block->index].end(); ++it1) - block->OUTae.insert(EXTRA[*it1].begin(), EXTRA[*it1].end()); - } -} - -Loop::Loop(SgStatement* stmt) : do_irreg_opt(false) -{ - reduction_operation_list* rsl; - for (rsl = red_struct_list; rsl; rsl = rsl->next) - { - if (rsl->locvar) //MAXLOC,MINLOC - redArrays.insert(rsl->locvar); - } - - lhs.clear(); rhs.clear(); unparsedLhs.clear(); unparsedRhs.clear(); - buildCFG(); -} - -set Loop::RDsAt(SgStatement* stmt) const -{ - if (blockIn.find(stmt) == blockIn.end() || !(0 <= blockIn.at(stmt) && blockIn.at(stmt) < blocks.size())) - { - return set(); - } - return blocks[blockIn.at(stmt)].INrd; -} - -set Loop::AEsAt(SgStatement* stmt) const -{ - if (blockIn.find(stmt) == blockIn.end() || !(0 <= blockIn.at(stmt) && blockIn.at(stmt) < blocks.size())) - { - return set(); - } - return blocks[blockIn.at(stmt)].INae; -} - -void Loop::setupSubstitutes() -{ - for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) - { - set ss; - intersection(block->INrd.begin(), block->INrd.end(), block->INae.begin(), block->INae.end(), inserter(ss, ss.end())); - block->OUTae.clear(); - block->OUTrd.clear(); - for (set::iterator it = ss.begin(); it != ss.end();) - { - if (FindInExpr((*it)->expr(0), (*it)->expr(1)) != 0) - ss.erase(it++); - else - ++it; - } - map parent; - map > INss; - for (set::iterator it = ss.begin(); it != ss.end(); ++it) - { - SgExpression* expr0 = lhs[unparsedLhs[(*it)->expr(0)]]; - SgExpression* expr1 = rhs[unparsedRhs[(*it)->expr(1)]]; - INss[expr0].insert(expr1); - parent[expr0] = *it; - parent[expr1] = *it; - } - - for (map >::iterator it1 = INss.begin(); it1 != INss.end(); ++it1) - { - for (set::iterator it2 = it1->second.begin(); it2 != it1->second.end(); ++it2) - { - SgExpression* rhs = (*it2)->copyPtr(); - block->INss[it1->first].insert(rhs); - parent[rhs] = parent[*it2]; - } - } - - for (map >::iterator it1 = block->INss.begin(); it1 != block->INss.end(); ++it1) - { - if (it1->second.size() != 1 || FindInExpr(it1->first, block->head->expr(1)) == 0) - continue; - bool changed = true; - SgExpression* expr = *it1->second.begin(); - SgStatement* stmt = parent[it1->first]; - while (changed == true) - { - changed = false; - for (map >::iterator it3 = block->INss.begin(); it3 != block->INss.end(); ++it3) - if (it3->second.size() == 1 && it1->first != it3->first) - changed |= replace(expr, stmt, it3->first, *it3->second.begin()) != 0; - } - } - } - - if (enable_opt == true) - { - for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) - { - for (map >::iterator it = block->INss.begin(); it != block->INss.end(); ++it) - { - if (it->second.size() == 1) - { - if (block->head->variant() == ASSIGN_STAT) - { - replaceInSubscripts(block->head->expr(0), block->head, it->first, *it->second.begin()); - replaceInSubscripts(block->head->expr(1), block->head, it->first, *it->second.begin()); - } - else if (block->head->variant() == PROC_CALL) - replaceInSubscripts(block->head->expr(0), block->head, it->first, *it->second.begin()); - } - } - } - } - - vector visited(blocks.size(), false); - visited[ENTRY] = true; - visited[EXIT] = true; - visited[2] = true; - vector _blocks; - map dfn; - dfn[ENTRY] = 0; - dfn[EXIT] = 1; - _blocks.push_back(2); - int k = 0; - int count = 2; - - for (vector::iterator p = _blocks.begin(); p != _blocks.end(); ++k, p = _blocks.begin() + k) - { - int index = *p; - visited[index] = true; - for (vector::iterator it = blocks[index].out.begin(); it != blocks[index].out.end(); ++it) - { - if (visited[*it] == false) - { - visited[*it] = true; - _blocks.push_back(*it); - } - } - dfn[index] = count; - count++; - } - - vector tmp(blocks.size()); - for (vector::iterator block = blocks.begin(); block != blocks.end(); ++block) - { - block->index = dfn[block->index]; - for (vector::iterator it = block->out.begin(); it != block->out.end(); ++it) - *it = dfn[*it]; - - for (vector::iterator it = block->in.begin(); it != block->in.end(); ++it) - *it = dfn[*it]; - tmp[block->index] = *block; - } - blocks.swap(tmp); -} - - -// graphviz script, for debug -void Loop::visualize(const char* scriptName) const -{ - FILE* f = fopen(scriptName, "w"); - if (f == NULL) - { - printf("Failed to open file \"%s\"\n", scriptName); - return; - } - fprintf(f, "digraph\n{\n0[label=\"{Entry|}\",shape=record]\n1[label=\"{Exit|}\",shape=record]\n"); - - for (size_t i = 2; i < blocks.size(); ++i) - { - fprintf(f, "%d[label=\"{B%d|", blocks[i].index, blocks[i].index); - for (SgStatement* stmt = blocks[i].head; stmt != NULL && stmt != blocks[i].tail->lexNext(); stmt = stmt->lexNext()) - { - switch (stmt->variant()) - { - case SWITCH_NODE: - if (stmt->label()) - fprintf(f, "%ld ", LABEL_STMTNO(stmt->label()->thelabel)); - fprintf(f, "select case (%s)\\n", ((SgSwitchStmt*)stmt)->expr(0)->unparse()); - break; - case IF_NODE: - if (stmt->label()) - fprintf(f, "%ld ", LABEL_STMTNO(stmt->label()->thelabel)); - fprintf(f, "if (%s) then\\n", ((SgIfStmt*)stmt)->conditional()->unparse()); - break; - case ELSEIF_NODE: - fprintf(f, "elseif (%s) then\\n", ((SgIfStmt*)stmt)->conditional()->unparse()); - break; - case LOGIF_NODE: - if (stmt->label()) - fprintf(f, "%ld ", LABEL_STMTNO(stmt->label()->thelabel)); - fprintf(f, "if (%s)\\n", ((SgLogIfStmt*)stmt)->conditional()->unparse()); - break; - case WHILE_NODE: - { - SgForStmt* _stmt = (SgForStmt*)stmt; - if (_stmt->hasLabel() == TRUE) - fprintf(f, "%ld ", LABEL_STMTNO(_stmt->label()->thelabel)); - if (LlndMapping(BIF_LL3(_stmt->thebif)) != NULL) - fprintf(f, "%s: ", LlndMapping(BIF_LL3(_stmt->thebif))->unparse()); - fprintf(f, "do "); - if (BIF_LABEL_USE(_stmt->thebif) != NULL) - fprintf(f, "%ld ", LABEL_STMTNO(BIF_LABEL_USE(_stmt->thebif))); - fprintf(f, "while "); - if (((SgWhileStmt*)stmt)->conditional() != NULL) - fprintf(f, "(%s)\\n", ((SgWhileStmt*)stmt)->conditional()->unparse()); - break; - } - case FOR_NODE: - { - SgForStmt* _stmt = (SgForStmt*)stmt; - if (_stmt->hasLabel() == TRUE) - fprintf(f, "%ld ", LABEL_STMTNO(_stmt->label()->thelabel)); - if (LlndMapping(BIF_LL3(_stmt->thebif)) != NULL) - fprintf(f, "%s: ", LlndMapping(BIF_LL3(_stmt->thebif))->unparse()); - fprintf(f, "do "); - if (BIF_LABEL_USE(_stmt->thebif) != NULL) - fprintf(f, "%ld ", LABEL_STMTNO(BIF_LABEL_USE(_stmt->thebif))); -#if __SPF - if (_stmt->doName()->identifier() != NULL) - fprintf(f, "%s = ", _stmt->doName()->identifier()); -#else - if (_stmt->doName().identifier() != NULL) - fprintf(f, "%s = ", _stmt->doName().identifier()); -#endif - if (_stmt->start() != NULL) - fprintf(f, "%s, ", _stmt->start()->unparse()); - if (_stmt->end() != NULL) - fprintf(f, "%s", _stmt->end()->unparse()); - if (_stmt->step() != NULL) - fprintf(f, ", %s\\n", _stmt->step()->unparse()); - break; - } - default: - fprintf(f, "%s\\n", stmt->unparse()); - break; - } - } - fprintf(f, "}\",shape=record]\n"); - } - - for (size_t i = 0; i < blocks.size(); ++i) - { - for (size_t j = 0; j < blocks[i].out.size(); ++j) - fprintf(f, "%d:out->%d:in\n", blocks[i].index, blocks[i].out[j]); - } - fprintf(f, "}"); - fclose(f); -} - - -extern SgStatement* kernelScope; - -SgExpression* analyzeArrayIndxs(SgSymbol* ar, SgExpression* subscripts) -{ - static int count = 0; - SgSymbol* varName = NULL; - if (subscripts == NULL || options.isOn(AUTO_TFM) == false || dontGenConvertXY || oneCase) - return NULL; - - map& arrays = currentLoop->getArrays(); - Array* array = NULL; - - string toFind = OriginalSymbol(ar)->identifier(); - for (map::iterator it = arrays.begin(); it != arrays.end(); it++) - { - if (OriginalSymbol(it->first)->identifier() == toFind) - { - array = it->second; - break; - } - } - - if (array != NULL) - { - string expr; - SgSymbol* symbol = array->findAccess(subscripts, expr); - if (symbol == NULL) - { - char* counter = new char[32]; - sprintf(counter, "%d", count); - ++count; - string name(ar->identifier() + string("_") + counter); - delete[] counter; - if (options.isOn(C_CUDA)) - varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name.c_str()), *C_DvmType(), *kernelScope); - else - { - if (undefined_Tcuda) - varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name.c_str()), *new SgType(T_INT, new SgExpression(LEN_OP, new SgValueExp(8), NULL, NULL), SgTypeInt()), *kernelScope); - else - varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name.c_str()), *SgTypeInt(), *kernelScope); - } - array->addCoefficient(subscripts, expr, varName); - } - else - varName = symbol; - } - return varName ? new SgVarRefExp(varName) : NULL; -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_analyzer.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_analyzer.cpp deleted file mode 100644 index 57e9a36..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_analyzer.cpp +++ /dev/null @@ -1,4325 +0,0 @@ -#include "leak_detector.h" - -#include "dvm.h" -#include "acc_analyzer.h" -#include "calls.h" -#include -#include - -using std::string; -using std::vector; -using std::map; -using std::list; -using std::make_pair; -using std::set; -using std::pair; - -#if __SPF -using std::wstring; -#include "Utils/AstWrapper.h" -#include "Utils/utils.h" -#include "Utils/errors.h" - -static pair getText(const char *s, const wchar_t *s1, const char *t, int num, SgStatement *stmt, int &line) -{ - pair ret; - - wchar_t bufW[1024]; -#if _WIN32 - swprintf(bufW, s1, to_wstring(t).c_str()); -#else - swprintf(bufW, 1024, s1, to_wstring(t).c_str()); -#endif - ret.first = bufW; - - char buf[1024]; - sprintf(buf, s, t); - ret.second = buf; - - line = stmt->lineNumber(); - if (line == 0) - { - line = 1; - if (stmt->variant() == DVM_PARALLEL_ON_DIR) - { - line = stmt->lexNext()->lineNumber(); - ret.first += RR158_1; - ret.second += " for this loop"; - } - } - - if (stmt->variant() == SPF_ANALYSIS_DIR) - { - ret.first += RR158_1; - ret.second += " for this loop"; - } - - return ret; -} - -static inline bool ifVarIsLoopSymb(SgStatement *stmt, const string symb) -{ - bool ret = false; - if (stmt == NULL) - return ret; - - int var = stmt->variant(); - if (var == SPF_ANALYSIS_DIR || var == SPF_PARALLEL_DIR || var == SPF_TRANSFORM_DIR || var == SPF_PARALLEL_REG_DIR || var == SPF_END_PARALLEL_REG_DIR) - stmt = stmt->lexNext(); - - SgForStmt *forS = isSgForStmt(stmt); - if (forS) - { - SgStatement *end = forS->lastNodeOfStmt(); - for (; stmt != end && !ret; stmt = stmt->lexNext()) - if (stmt->variant() == FOR_NODE) - if (isSgForStmt(stmt)->symbol()->identifier() == symb) - ret = true; - } - - return ret; -} - - -template void fillPrivatesFromComment(Statement *st, std::set &privates, int type = -1); - -inline void Warning(const char *s, const wchar_t *s1, const char *t, int num, SgStatement *stmt) -{ - //TODO: is it correct? - if (stmt == NULL) - return; - - if (num == PRIVATE_ANALYSIS_REMOVE_VAR) - { - SgStatement *found = SgStatement::getStatementByFileAndLine(string(stmt->fileName()), stmt->lineNumber()); - if (found != NULL) - { - if (ifVarIsLoopSymb(found, t)) - return; - } - - set privates; - fillPrivatesFromComment(new Statement(stmt), privates); - if (privates.find(t) != privates.end()) - return; - } - - - int line; - auto retVal = getText(s, s1, t, num, stmt, line); - printLowLevelWarnings(stmt->fileName(), line, retVal.first.c_str(), retVal.second.c_str(), 1029); -} - -inline void Note(const char *s, const wchar_t *s1, const char *t, int num, SgStatement *stmt) -{ - int line; - auto retVal = getText(s, s1, t, num, stmt, line); - printLowLevelNote(stmt->fileName(), line, retVal.first.c_str(), retVal.second.c_str(), 1030); -} -#endif - -// local functions -static ControlFlowItem* getControlFlowList(SgStatement*, SgStatement*, ControlFlowItem**, SgStatement**, doLoops*, CallData*, CommonData*); -static ControlFlowItem* processOneStatement(SgStatement** stmt, ControlFlowItem** pred, ControlFlowItem **list, ControlFlowItem* oldcur, doLoops*, CallData*, CommonData*); -static ControlFlowItem* switchItem(SgStatement* stmt, ControlFlowItem* empty, SgStatement** lastAnStmt, doLoops* loops, CallData* calls, CommonData*); -static ControlFlowItem* ifItem(SgStatement*, ControlFlowItem*, SgStatement** lastAnStmt, doLoops* loops, bool ins, CallData*, CommonData*); -static void setLeaders(ControlFlowItem*); -static void clearList(ControlFlowItem*); -static void fillLabelJumps(ControlFlowItem*); -static SgExpression* GetProcedureArgument(bool isF, void* f, int i); -static int GetNumberOfArguments(bool isF, void* f); -#if ACCAN_DEBUG -static void printControlFlowList(ControlFlowItem*, ControlFlowItem* last = NULL); -#endif - -//static ControlFlowGraph* GetControlFlowGraphWithCalls(bool, SgStatement*, CallData*, CommonData*); -//static void FillCFGSets(ControlFlowGraph*); -static void FillPrivates(ControlFlowGraph*); -static ControlFlowItem* AddFunctionCalls(SgStatement*, CallData*, ControlFlowItem**, CommonData*); - -const char* is_correct = NULL; -const char* failed_proc_name = NULL; -static PrivateDelayedItem* privateDelayedList = NULL; -static AnalysedCallsList* currentProcedure = NULL; -static AnalysedCallsList* mainProcedure = NULL; -static DoLoopDataList* doLoopList = NULL; -static CommonData* pCommons; -static CallData* pCalls; - -int total_privates = 0; -int total_pl = 0; - -static const IntrinsicSubroutineData intrinsicData[] = { - {"date_and_time", 4, { {-1, "date", INTRINSIC_OUT}, {-1, "time", INTRINSIC_OUT }, {-1, "zone", INTRINSIC_OUT }, {-1, "values", INTRINSIC_OUT } } }, - {"mod", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, - {"dvtime", 0, {}}, - {"abs", 1, { {1, NULL, INTRINSIC_IN} } }, - {"max", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, - {"min", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, - {"wtime", 1, { {1, NULL, INTRINSIC_IN} } }, - {"dble", 1, { {1, NULL, INTRINSIC_IN } } }, - {"dabs", 1, { {1, NULL, INTRINSIC_IN } } }, - {"dmax1", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN } } }, - {"dmin1", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN } } }, - {"dsqrt", 1, { {1, NULL, INTRINSIC_IN} } }, - {"dcos", 1, { {1, NULL, INTRINSIC_IN} } }, - {"datan2", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, - {"dsign", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, - {"dlog", 1, { {1, NULL, INTRINSIC_IN} } }, - {"dexp", 1, { {1, NULL, INTRINSIC_IN} } }, - {"omp_get_wtime", 0, {}}, - {"sqrt", 1, { {1, NULL, INTRINSIC_IN} } }, - {"int", 1, { {1, NULL, INTRINSIC_IN} } }, - {"iabs", 1, { {1, NULL, INTRINSIC_IN} } }, - {"fnpr", 4, { {1, NULL, INTRINSIC_IN},{ 2, NULL, INTRINSIC_IN },{ 3, NULL, INTRINSIC_IN },{ 4, NULL, INTRINSIC_IN } } }, - {"isnan", 1, { {1, NULL, INTRINSIC_IN } } } -}; - -//TODO: it does not work -//static map> CFG_cache; - - -static bool isIntrinsicFunctionNameACC(char* name) -{ -#if USE_INTRINSIC_DVM_LIST - return isIntrinsicFunctionName(name); -#else - return false; -#endif -} - -int SwitchFile(int file_id) -{ - if (file_id == current_file_id || file_id == -1) - return file_id; - int stored_file_id = current_file_id; - current_file_id = file_id; - current_file = &(CurrentProject->file(current_file_id)); - return stored_file_id; -} - -SgStatement * lastStmtOfDoACC(SgStatement *stdo) -{ - // is a copied function - SgStatement *st; - // second version (change 04.03.08) - st = stdo; -RE: st = st->lastNodeOfStmt(); - if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) - goto RE; - - else if (st->variant() == LOGIF_NODE) - return(st->lexNext()); - - else - return(st); - -} - -#ifdef __SPF -bool IsPureProcedureACC(SgSymbol* s) -#else -static bool IsPureProcedureACC(SgSymbol* s) -#endif -{ - // is a copied function - SgSymbol *shedr = NULL; - - shedr = GetProcedureHeaderSymbol(s); - if (shedr) - return(shedr->attributes() & PURE_BIT); - else - return 0; -} - -static bool IsUserFunctionACC(SgSymbol* s) -{ - // is a copied function - return(s->attributes() & USER_PROCEDURE_BIT); -} - -static const IntrinsicSubroutineData* IsAnIntrinsicSubroutine(const char* name) -{ - for (int i = 0; i < sizeof(intrinsicData) / sizeof(intrinsicData[0]); i++) - if (strcmp(name, intrinsicData[i].name) == 0) - return &(intrinsicData[i]); - return NULL; -} - -static SgExpression* CheckIntrinsicParameterFlag(const char* name, int arg, SgExpression* p, unsigned char flag) -{ - const IntrinsicSubroutineData* info = IsAnIntrinsicSubroutine(name); - if (!info) - return NULL; //better avoid this - for (int i = 0; i < info->args; i++) - { - const IntrinsicParameterData* pd = &(info->parameters[i]); - if (pd->index == arg + 1) - return (pd->status & flag) != 0 ? p : NULL; - - SgKeywordArgExp* kw = isSgKeywordArgExp(p); - if (kw) - { - SgExpression* a = kw->arg(); - SgExpression* val = kw->value(); - if (pd->name && strcmp(a->unparse(), pd->name) == 0) - return (pd->status & flag) != 0 ? val : NULL; - } - } - return NULL; -} -/* -//For parameters replacements in expressions -//#ifdef __SPF - -VarsKeeper varsKeeper; - -SgExpression* GetValueOfVar(SgExpression* var) -{ - return varsKeeper.GetValueOfVar(var); -} - -void VarsKeeper::GatherVars(SgStatement* start) -{ - pCommons = &(data->commons); - pCalls = &(data->calls); - currentProcedure = data->calls.AddHeader(start, false, start->symbol()); - mainProcedure = currentProcedure; - //stage 1: preparing graph data - data->graph = GetControlFlowGraphWithCalls(true, start, &(data->calls), &(data->commons)); - data->calls.AssociateGraphWithHeader(start, data->graph); - data->commons.MarkEndOfCommon(currentProcedure); - //calls.printControlFlows(); - //stage 2: data flow analysis - FillCFGSets(data->graph); - //stage 3: fulfilling loop data - FillPrivates(data->graph); - - if (privateDelayedList) - delete privateDelayedList; - privateDelayedList = NULL; -} - -SgExpression* VarsKeeper::GetValueOfVar(SgExpression* var) -{ - FuncData* curData = data; -} - -//#endif -*/ - - - -void SetUpVars(CommonData* commons, CallData* calls, AnalysedCallsList* m, DoLoopDataList* list) -{ - pCommons = commons; - pCalls = calls; - currentProcedure = m; - mainProcedure = currentProcedure; - doLoopList = list; -} - -AnalysedCallsList* GetCurrentProcedure() -{ - return currentProcedure; -} -//interprocedural analysis, called for main procedure -void Private_Vars_Analyzer(SgStatement* start) -{ -#ifndef __SPF - if (!options.isOn(PRIVATE_ANALYSIS)) { - return; - } -#endif - CallData calls; - CommonData commons; - DoLoopDataList doloopList; - SetUpVars(&commons, &calls, calls.AddHeader(start, false, start->symbol(), current_file_id), &doloopList); - - //stage 1: preparing graph data - ControlFlowGraph* CGraph = GetControlFlowGraphWithCalls(true, start, &calls, &commons); - calls.AssociateGraphWithHeader(start, CGraph); - commons.MarkEndOfCommon(currentProcedure); - - currentProcedure->graph->getPrivate(); -#if ACCAN_DEBUG - calls.printControlFlows(); -#endif - //stage 2: data flow analysis - FillCFGSets(CGraph); - //stage 3: fulfilling loop data - FillPrivates(CGraph); - - //test: graphvis - /*std::fstream fs; - fs.open("graph_old.txt", std::fstream::out); - fs << CGraph->GetVisualGraph(&calls); - fs.close();*/ - -#if !__SPF - delete CGraph; -#endif - - if (privateDelayedList) - delete privateDelayedList; - privateDelayedList = NULL; -} - -CallData::~CallData() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - /* - for (AnalysedCallsList* l = calls_list; l != NULL;) - { - if (!l->isIntrinsic && l->graph) - { - if (l->graph->RemoveRef() && !l->graph->IsMain()) - { - delete l->graph; - l->graph = NULL; - } - } - AnalysedCallsList *temp = l; - l = l->next; - delete temp; - temp = NULL; - }*/ -} - -CommonData::~CommonData() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - for (CommonDataItem* i = list; i != NULL;) { - for (CommonVarInfo* info = i->info; info != NULL;) { - CommonVarInfo* t = info; - info = info->next; - delete t; - } - CommonDataItem* tp = i; - i = i->next; - delete tp; - } -} - -ControlFlowGraph::~ControlFlowGraph() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - while (common_def != NULL) - { - CommonVarSet* t = common_def; - common_def = common_def->next; - delete t; - } - while (common_use != NULL) - { - CommonVarSet* t = common_use; - common_use = common_use->next; - delete t; - } - - if (def) - delete def; - - if (use) - delete use; - - if (!temp && pri) - delete pri; - - for (CBasicBlock *bb = first; bb != NULL;) - { - CBasicBlock *tmp = bb; - bb = bb->getLexNext(); - - delete tmp; - tmp = NULL; - } -} - -CBasicBlock::~CBasicBlock() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - - CommonVarSet* d = getCommonDef(); - while (d != NULL) - { - CommonVarSet* t = d; - d = d->next; - delete t; - } - - d = getCommonUse(); - while (d != NULL) - { - CommonVarSet* t = d; - d = d->next; - delete t; - } - - for (BasicBlockItem* bbi = prev; bbi != NULL;) - { - BasicBlockItem *tmp = bbi; - bbi = bbi->next; - delete tmp; - tmp = NULL; - } - - for (BasicBlockItem *bbi = succ; bbi != NULL;) - { - BasicBlockItem *tmp = bbi; - bbi = bbi->next; - delete tmp; - tmp = NULL; - } - - if (def) - delete def; - - if (use) - delete use; - - if (old_mrd_out) - delete old_mrd_out; - - if (old_mrd_in) - delete old_mrd_in; - - if (mrd_in) - delete mrd_in; - - if (mrd_out) - delete mrd_out; - - if (old_lv_out) - delete old_lv_out; - - if (old_lv_in) - delete old_lv_in; - - if (lv_in) - delete lv_in; - - if (lv_out) - delete lv_out; -} - -doLoops::~doLoops() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - for (doLoopItem *it = first; it != NULL; ) - { - doLoopItem *tmp = it; - it = it->getNext(); - delete tmp; - } -} - -PrivateDelayedItem::~PrivateDelayedItem() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - if (delay) - delete delay; - if (next) - delete next; -} - -VarSet::~VarSet() -{ -#if __SPF - removeFromCollection(this); -#endif - for (VarItem* it = list; it != NULL;) - { - VarItem* tmp = it; - it = it->next; - if (tmp->var) - if (tmp->var->RemoveReference()) - delete tmp->var; - delete tmp; - } -} - -CommonVarSet::CommonVarSet(const CommonVarSet& c) -{ - cvd = c.cvd; - if (c.next) - next = new CommonVarSet(*c.next); - else - next = NULL; - -#if __SPF - addToCollection(__LINE__, __FILE__, this, 22); -#endif -} - -std::string ControlFlowGraph::GetVisualGraph(CallData* calls) -{ - std::string result; - result += "digraph "; - char tmp[512]; - AnalysedCallsList* cd = calls->GetDataForGraph(this); - //if (cd == NULL || cd->header == NULL) - sprintf(tmp, "g_%llx", (uintptr_t)this); - //else - // sprintf(tmp, "g_%500s", cd->header->symbol()); - result += tmp; - result += "{ \n"; - for (CBasicBlock* b = this->first; b != NULL; b = b->getLexNext()) { - if (!b->IsEmptyBlock()) { - result += '\t' + b->GetGraphVisDescription() + "[shape=box,label=\""; - result += b->GetGraphVisData() + "\"];\n"; - } - } - for (CBasicBlock* b = first; b != NULL; b = b->getLexNext()) { - if (!b->IsEmptyBlock()) - result += b->GetEdgesForBlock(b->GetGraphVisDescription(), true, ""); - } - result += '}'; - ResetDrawnStatusForAllItems(); - return result; -} - -void ControlFlowGraph::ResetDrawnStatusForAllItems() { - for (CBasicBlock* b = first; b != NULL; b = b->getLexNext()) { - for (ControlFlowItem* it = b->getStart(); it != NULL && (it->isLeader() == false || it == b->getStart()); it = it->getNext()) { - it->ResetDrawnStatus(); - } - } -} - -std::string GetConditionWithLineNumber(ControlFlowItem* eit) -{ - std::string res; - if (eit->getOriginalStatement()) { - char tmp[16]; - sprintf(tmp, "%d: ", eit->getOriginalStatement()->lineNumber()); - res = tmp; - } - return res + eit->getExpression()->unparse(); -} - -std::string GetActualCondition(ControlFlowItem** pItem) { - std::string res = ""; - ControlFlowItem* eit = *pItem; - while (true) - { - if (eit == NULL || eit->getJump() != NULL || eit->getStatement() != NULL) - { - if (eit && eit->getJump() != NULL) - { - if (eit->getExpression() != NULL) - { - *pItem = eit; - return GetConditionWithLineNumber(eit); - } - else - { - *pItem = NULL; - return res; - } - break; - } - *pItem = NULL; - return res; - } - eit = eit->GetPrev(); - } - return res; -} - -std::string CBasicBlock::GetEdgesForBlock(std::string name, bool original, std::string modifier) -{ - std::string result; - for (BasicBlockItem* it = getSucc(); it != NULL; it = it->next) { - if (it->drawn) - continue; - it->drawn = true; - char lo = original; - std::string cond; - ControlFlowItem* eit = NULL; - bool pf = false; - if (it->jmp != NULL) { - if (it->jmp->getExpression() != NULL) { - eit = it->jmp; - cond = GetConditionWithLineNumber(eit); - } - else { - pf = true; - eit = it->jmp->GetPrev(); - cond = GetActualCondition(&eit); - } - } - if (eit && eit->GetFriend()) { - lo = false; - eit = eit->GetFriend(); - } - if (!it->block->IsEmptyBlock() || cond.length() != 0) { - if (cond.length() != 0 && eit && !pf){ - char tmp[32]; - sprintf(tmp, "c_%llx", (uintptr_t)eit); - if (!eit->IsDrawn()) { - result += '\t'; - result += tmp; - result += "[shape=diamond,label=\""; - result += cond; - result += "\"];\n"; - } - if (it->cond_value && !pf) { - result += '\t' + name + "->"; - result += tmp; - result += modifier; - result += '\n'; - } - eit->SetIsDrawn(); - } - if (cond.length() != 0) { - if (lo) { - char tmp[32]; - sprintf(tmp, "c_%llx", (uintptr_t)eit); - if (!it->block->IsEmptyBlock()) { - result += '\t'; - result += tmp; - result += "->" + it->block->GetGraphVisDescription(); - result += "[label="; - result += (!pf && it->cond_value) ? "T]" : "F]"; - result += ";\n"; - } - else { - std::string n = tmp; - std::string label; - label += "[label="; - label += (!pf && it->cond_value) ? "T]" : "F]"; - result += it->block->GetEdgesForBlock(n, original, label); - } - } - } - else { - result += '\t' + name + " -> " + it->block->GetGraphVisDescription(); - result += modifier; - result += ";\n"; - } - - } - else { - result += it->block->GetEdgesForBlock(name, original, ""); - } - } - return result; -} - -std::string CBasicBlock::GetGraphVisDescription() -{ - if (visname.length() != 0) - return visname; - char tmp[16]; - sprintf(tmp, "%d", num); - visname = tmp; - return visname; -} - -std::string CBasicBlock::GetGraphVisData() -{ - if (visunparse.length() != 0) - return visunparse; - std::string result; - for (ControlFlowItem* it = start; it != NULL && (it->isLeader() == false || it == start); it = it->getNext()) { - if (it->getStatement() != NULL) { - int ln = it->GetLineNumber(); - char tmp[16]; - sprintf(tmp, "%d: ", ln); - result += tmp; - result += it->getStatement()->unparse(); - } - } - visunparse = result; - return result; -} - -int ControlFlowItem::GetLineNumber() -{ - if (getStatement() == NULL) - return 0; - if (getStatement()->lineNumber() == 0){ - if (getOriginalStatement() == NULL) - return 0; - return getOriginalStatement()->lineNumber(); - } - return getStatement()->lineNumber(); -} - -bool CBasicBlock::IsEmptyBlock() -{ - for (ControlFlowItem* it = start; it != NULL && (it->isLeader() == false || it == start); it = it->getNext()) { - if (!it->IsEmptyCFI()) - return false; - } - return true; -} - -AnalysedCallsList* CallData::GetDataForGraph(ControlFlowGraph* s) -{ - for (AnalysedCallsList* it = calls_list; it != NULL; it = it->next) { - if (it->graph == s) - return it; - } - return NULL; -} - -ControlFlowGraph* GetControlFlowGraphWithCalls(bool main, SgStatement* start, CallData* calls, CommonData* commons) -{ - if (start == NULL) - { - //is_correct = "no body for call found"; - return NULL; - } - - ControlFlowGraph *cfgRet = NULL; - /* -#if __SPF - auto itF = CFG_cache.find(start); - if (itF != CFG_cache.end()) - { - calls = std::get<1>(itF->second); - commons = std::get<2>(itF->second); - return std::get<0>(itF->second); - } -#endif*/ - doLoops l; - ControlFlowItem *funcGraph = getControlFlowList(start, start->lastNodeOfStmt(), NULL, NULL, &l, calls, commons); - fillLabelJumps(funcGraph); - setLeaders(funcGraph); - - - cfgRet = new ControlFlowGraph(false, main, funcGraph, NULL); - //CFG_cache[start] = std::make_tuple(cfgRet, calls, commons); - return cfgRet; -} - -void FillCFGSets(ControlFlowGraph* graph) -{ - graph->privateAnalyzer(); -} - -static void ClearMemoryAfterDelay(ActualDelayedData* d) -{ - while (d != NULL) { - CommonVarSet* cd = d->commons; - while (cd != NULL) { - CommonVarSet* t = cd; - cd = cd->next; - delete t; - } - delete d->buse; - ActualDelayedData* tmp = d; - d = d->next; - delete tmp; - } -} - -static void FillPrivates(ControlFlowGraph* graph) -{ - ActualDelayedData* d = graph->ProcessDelayedPrivates(pCommons, mainProcedure, NULL, NULL, false, -1); - ClearMemoryAfterDelay(d); - if (privateDelayedList) - privateDelayedList->PrintWarnings(); -} - -ActualDelayedData* CBasicBlock::GetDelayedDataForCall(CallAnalysisLog* log) -{ - for (ControlFlowItem* it = start; it != NULL && (!it->isLeader() || it == start); it = it->getNext()) - { - AnalysedCallsList* c = it->getCall(); - void* cf = it->getFunctionCall(); - bool isFun = true; - if (!cf) { - cf = it->getStatement(); - isFun = false; - } - if (c != NULL && c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c->graph != NULL) - return c->graph->ProcessDelayedPrivates(pCommons, c, log, cf, isFun, it->getProc()->file_id); - } - return NULL; -} - -void PrivateDelayedItem::MoveFromPrivateToLastPrivate(CVarEntryInfo* var) -{ - VarItem* el = detected->belongs(var); - if (el) { - eVariableType storedType = el->var->GetVarType(); - detected->remove(el->var); - lp->addToSet(var, NULL); - } -} - -void ActualDelayedData::RemoveVarFromCommonList(CommonVarSet* c) -{ - if (commons == NULL || c == NULL) - return; - if (c == commons) - { - commons = commons->next; - delete c; - return; - } - CommonVarSet* prev = c; - for (CommonVarSet* cur = c->next; cur != NULL; cur = cur->next) - { - if (cur == c) - { - prev->next = c->next; - delete c; - return; - } - else - prev = cur; - } -} - -void ActualDelayedData::MoveVarFromPrivateToLastPrivate(CVarEntryInfo* var, CommonVarSet* c, VarSet* vs) -{ - original->MoveFromPrivateToLastPrivate(var); - RemoveVarFromCommonList(c); - if (vs) - { - if (vs->belongs(var)) - vs->remove(var); - } -} - -int IsThisVariableAParameterOfSubroutine(AnalysedCallsList* lst, SgSymbol* s) -{ - if (!lst->header) - return -1; - int stored = SwitchFile(lst->file_id); - SgProcHedrStmt* h = isSgProcHedrStmt(lst->header); - if (!h) - return -1; - for (int i = 0; i < h->numberOfParameters(); i++) { - SgSymbol* par = h->parameter(i); - if (par == s) { - SwitchFile(stored); - return i; - } - } - SwitchFile(stored); - return -1; -} - -ActualDelayedData* ControlFlowGraph::ProcessDelayedPrivates(CommonData* commons, AnalysedCallsList* call, CallAnalysisLog* log, void* c, bool isFun, int file_id) -{ - for (CallAnalysisLog* i = log; i != NULL; i = i->prev) { - if (i->el == call) - { - //TODO: add name of common -#if __SPF - const wchar_t* rus = R158; - Warning("Recursion is not analyzed for privates in common blocks '%s'", rus, "TODO!", PRIVATE_ANALYSIS_NO_RECURSION_ANALYSIS, call->header); -#else - Warning("Recursion is not analyzed for privates in common blocks '%s'", "TODO!", PRIVATE_ANALYSIS_NO_RECURSION_ANALYSIS, call->header); -#endif - return NULL; - } - } - CallAnalysisLog* nl = new CallAnalysisLog(); - nl->el = call; - nl->prev = log; - if (log == NULL) - nl->depth = 0; - else - nl->depth = log->depth + 1; - log = nl; - ActualDelayedData* my = NULL; - for (CBasicBlock* bb = first; bb != NULL; bb = bb->getLexNext()) { - if (bb->containsParloopStart()) { - if (bb->GetDelayedData()) { - ActualDelayedData* data = new ActualDelayedData(); - data->original = bb->GetDelayedData(); - data->commons = commons->GetCommonsForVarSet(data->original->getDetected(), call); - VarSet* bu = new VarSet(); - bu->unite(data->original->getDelayed(), false); - VarSet* tbu = new VarSet(); - while (!bu->isEmpty()) { - if (IS_BY_USE(bu->getFirst()->var->GetSymbol())) - tbu->addToSet(bu->getFirst()->var, NULL); - else { - CVarEntryInfo* old = bu->getFirst()->var; - int arg_id = IsThisVariableAParameterOfSubroutine(call, bu->getFirst()->var->GetSymbol()); - if (arg_id != -1 && c != NULL) { - int stored = SwitchFile(file_id); - SgExpression* exp = GetProcedureArgument(isFun, c, arg_id); - if (isSgVarRefExp(exp) || isSgArrayRefExp(exp)) { - SgSymbol* sym = exp->symbol(); - CVarEntryInfo* v; - if (isSgVarRefExp(exp)) { - v = new CScalarVarEntryInfo(sym); - } - else { - v = old->Clone(sym); - } - tbu->addToSet(v, NULL, old); - } - SwitchFile(stored); - - } - } - bu->remove(bu->getFirst()->var); - } - data->buse = tbu; - delete bu; - data->next = my; - data->call = call; - my = data; - } - } - ActualDelayedData* calldata = bb->GetDelayedDataForCall(log); - while (calldata != NULL) { - CommonVarSet* nxt = NULL; - for (CommonVarSet* t = calldata->commons; t != NULL; t = nxt) { - nxt = t->next; - CommonVarInfo* cvd = t->cvd; - CommonDataItem* d = commons->IsThisCommonUsedInProcedure(cvd->parent, call); - if (!d || commons->CanHaveNonScalarVars(d)) - continue; - CommonVarInfo* j = cvd->parent->info; - CommonVarInfo* i = d->info; - while (j != cvd) { - j = j->next; - if (i) - i = i->next; - } - if (!i) - continue; - CVarEntryInfo* var = i->var; - if (bb->getLexNext()->getLiveIn()->belongs(var->GetSymbol()) && calldata->original->getDelayed()->belongs(cvd->var)) { - calldata->MoveVarFromPrivateToLastPrivate(cvd->var, t, NULL); - } - if (bb->IsVarDefinedAfterThisBlock(var, false)) { - calldata->RemoveVarFromCommonList(t); - } - - } - if (log->el->header == calldata->call->header) { - VarSet* pr = new VarSet(); - pr->unite(calldata->original->getDelayed(), false); - pr->intersect(bb->getLexNext()->getLiveIn(), false, true); - for (VarItem* exp = pr->getFirst(); exp != NULL; pr->getFirst()) { - calldata->MoveVarFromPrivateToLastPrivate(exp->var, NULL, NULL); - pr->remove(exp->var); - } - delete pr; - } - VarSet* tmp_use = new VarSet(); - tmp_use->unite(calldata->buse, false); - while (!tmp_use->isEmpty()) { - VarItem* v = tmp_use->getFirst(); - CVarEntryInfo* tmp = v->var->Clone(OriginalSymbol(v->var->GetSymbol())); - if (bb->getLexNext()->getLiveIn()->belongs(tmp->GetSymbol(), true)) { - calldata->MoveVarFromPrivateToLastPrivate(v->ov ? v->ov : v->var, NULL, calldata->buse); - } - if (bb->IsVarDefinedAfterThisBlock(v->var, true)) { - calldata->buse->remove(v->ov ? v->ov : v->var); - } - delete tmp; - tmp_use->remove(v->var); - } - delete tmp_use; - ActualDelayedData* tmp = calldata->next; - calldata->next = my; - my = calldata; - calldata = tmp; - } - } - nl = log; - log = log->prev; - - delete nl; - return my; -} - -extern graph_node* node_list; -void Private_Vars_Function_Analyzer(SgStatement* start); - -void Private_Vars_Project_Analyzer() -{ - graph_node* node = node_list; - while (node) { - if (node->st_header) { - int stored_file_id = SwitchFile(node->file_id); - Private_Vars_Function_Analyzer(node->st_header); - SwitchFile(stored_file_id); - } - node = node->next; - } -} - -// CALL function for PRIVATE analyzing -void Private_Vars_Function_Analyzer(SgStatement* start) -{ - //temporary state -#ifndef __SPF - if (!options.isOn(PRIVATE_ANALYSIS)){ - return; - } -#endif - - if (start->variant() == PROG_HEDR) { - Private_Vars_Analyzer(start); - } - /* - ControlFlowItem* funcGraph = getControlFlowList(start, start->lastNodeOfStmt(), NULL, NULL, new doLoops()); - fillLabelJumps(funcGraph); - setLeaders(funcGraph); -#if ACCAN_DEBUG - printControlFlowList(funcGraph); -#endif - ControlFlowItem* p = funcGraph; - ControlFlowItem* pl_start = NULL; - ControlFlowItem* pl_end = NULL; - ControlFlowGraph* graph = new ControlFlowGraph(funcGraph, NULL); - graph->privateAnalyzer(); - */ -} -/* -// CALL function for PRIVATE analyzing -void Private_Vars_Analyzer(SgStatement *firstSt, SgStatement *lastSt) -{ - // temporary state - //return; - SgExpression* par_des = firstSt->expr(2); - SgSymbol* l; - SgForStmt* chk; - int correct = 1; - firstSt = firstSt->lexNext(); - while (correct && (par_des != NULL) && (par_des->lhs() != NULL) && ((l = par_des->lhs()->symbol()) != NULL)){ - if (firstSt->variant() == FOR_NODE){ - chk = isSgForStmt(firstSt); - if (chk->symbol() != l) - correct = 0; - firstSt = firstSt->lexNext(); - par_des = par_des->rhs(); - } - else{ - correct = 0; - } - } - if (correct){ - doLoops* loops = new doLoops(); - ControlFlowItem* cfList = getControlFlowList(firstSt, lastSt, NULL, NULL, loops); - fillLabelJumps(cfList); - setLeaders(cfList); -#if ACCAN_DEBUG - printControlFlowList(cfList); -#endif - VarSet* priv = ControlFlowGraph(cfList, NULL).getPrivate(); -#if ACCAN_DEBUG - priv->print(); -#endif - clearList(cfList); - } -} -*/ - -static void fillLabelJumps(ControlFlowItem* cfList) -{ - if (cfList != NULL){ - ControlFlowItem* temp = cfList; - ControlFlowItem* temp2; - unsigned int label_no = 0; - while (temp != NULL){ - if (temp->getLabel() != NULL) - label_no++; - temp = temp->getNext(); - } - LabelCFI* table = new LabelCFI[label_no + 1]; - unsigned int li = 0; - for (temp = cfList; temp != NULL; temp = temp->getNext()){ - SgLabel* label; - if ((label = temp->getLabel()) != NULL){ - table[li].item = temp; - table[li++].l = label->id(); - } - temp2 = temp; - } - temp = new ControlFlowItem(currentProcedure); - temp2->AddNextItem(temp); - table[label_no].item = temp2; - table[label_no].l = -1; - for (temp = cfList; temp != NULL; temp = temp->getNext()){ - SgLabel* jump = temp->getLabelJump(); - int l; - if (jump != NULL){ - l = jump->id(); - for (unsigned int i = 0; i < label_no + 1; i++){ - if (table[i].l == l || i == label_no){ - temp->initJump(table[i].item); - break; - } - } - } - } - delete[] table; - } -} - -static void setLeaders(ControlFlowItem* cfList) -{ - if (cfList != NULL) - cfList->setLeader(); - while (cfList != NULL) - { - if (cfList->getJump() != NULL) - { - cfList->getJump()->setLeader(); - if (cfList->getNext() != NULL) - cfList->getNext()->setLeader(); - } - if (cfList->getCall() != NULL) - { - if (cfList->getNext() != NULL) - cfList->getNext()->setLeader(); - } - cfList = cfList->getNext(); - } -} - -static void clearList(ControlFlowItem *list) -{ - if (list != NULL) - { - if (list->getNext() != NULL) - clearList(list->getNext()); - - delete list; - } -} - -static ControlFlowItem* ifItem(SgStatement* stmt, ControlFlowItem* empty, SgStatement** lastAnStmt, doLoops* loops, bool ins, CallData* calls, CommonData* commons) -{ - if (stmt == NULL) - return empty; - SgIfStmt* cond; - if (stmt->variant() == ELSEIF_NODE) - cond = (SgIfStmt*)stmt; - if (stmt->variant() == ELSEIF_NODE || (!ins && (cond = isSgIfStmt(stmt)) != NULL)) - { - SgExpression* c = &(SgNotOp((cond->conditional()->copy()))); - ControlFlowItem *n, *j; - ControlFlowItem* last; - if ((n = getControlFlowList(cond->trueBody(), NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) - return NULL; - j = ifItem(cond->falseBody(), empty, lastAnStmt, loops, cond->falseBody() != NULL ? cond->falseBody()->variant() == IF_NODE : false, calls, commons); - ControlFlowItem* gotoEmpty = new ControlFlowItem(NULL, empty, j, NULL, currentProcedure); - if (last != NULL) - last->AddNextItem(gotoEmpty); - else - n = gotoEmpty; - ControlFlowItem* tn = new ControlFlowItem(c, j, n, stmt->label(), currentProcedure); - tn->setOriginalStatement(stmt); - return tn; - } - else - { - ControlFlowItem* last; - ControlFlowItem* ret; - if ((ret = getControlFlowList(stmt, NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) - return NULL; - last->AddNextItem(empty); - return ret; - } -} - -static ControlFlowItem* switchItem(SgStatement* stmt, ControlFlowItem* empty, SgStatement** lastAnStmt, doLoops* loops, CallData* calls, CommonData* commons) -{ - SgSwitchStmt* sw = isSgSwitchStmt(stmt); - SgExpression* sw_cond = (sw->selector()); - stmt = stmt->lexNext(); - *lastAnStmt = stmt; - ControlFlowItem* last_sw = NULL; - ControlFlowItem* first = NULL; - bool is_def_last = false; - SgStatement* not_def_last; - while (stmt->variant() == CASE_NODE || stmt->variant() == DEFAULT_NODE) - { - if (stmt->variant() == DEFAULT_NODE){ - while (stmt->variant() != CONTROL_END && stmt->variant() != CASE_NODE) - stmt = stmt->lexNext(); - if (stmt->variant() == CONTROL_END) - stmt = stmt->lexNext(); - is_def_last = true; - continue; - } - SgExpression* c = ((SgCaseOptionStmt*)stmt)->caseRange(0); - SgExpression *lhs = NULL; - SgExpression *rhs = NULL; - if (c->variant() == DDOT){ - lhs = c->lhs(); - rhs = c->rhs(); - if (rhs == NULL) - c = &(*lhs <= *sw_cond); - else if (lhs == NULL) - c = &(*sw_cond <= *rhs); - else - c = &(*lhs <= *sw_cond && *sw_cond <= *rhs); - } - else - c = &SgNeqOp(*sw_cond, *c); - ControlFlowItem *n, *j; - ControlFlowItem* last; - if ((n = getControlFlowList(stmt->lexNext(), NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) - return NULL; - j = new ControlFlowItem(currentProcedure); - ControlFlowItem* gotoEmpty = new ControlFlowItem(NULL, empty, j, NULL, currentProcedure); - if (last != NULL) - last->AddNextItem(gotoEmpty); - else - n = gotoEmpty; - ControlFlowItem* cond = new ControlFlowItem(c, j, n, stmt->label(), currentProcedure); - cond->setOriginalStatement(stmt); - if (last_sw == NULL) - first = cond; - else - last_sw->AddNextItem(cond); - last_sw = j; - is_def_last = false; - not_def_last = *lastAnStmt; - stmt = *lastAnStmt; - } - SgStatement* def = sw->defOption(); - if (def != NULL){ - ControlFlowItem* last; - ControlFlowItem* n; - if ((n = getControlFlowList(def->lexNext(), NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) - return NULL; - if (last != NULL) - last->AddNextItem(empty); - if (last_sw == NULL) - first = n; - else - last_sw->AddNextItem(n); - last_sw = last; - } - last_sw->AddNextItem(empty); - if (!is_def_last) - *lastAnStmt = not_def_last; - return first; -} - -static ControlFlowItem* getControlFlowList(SgStatement *firstSt, SgStatement *lastSt, ControlFlowItem **last, SgStatement **lastAnStmt, doLoops* loops, CallData* calls, CommonData* commons) -{ - ControlFlowItem *list = new ControlFlowItem(currentProcedure); - ControlFlowItem *cur = list; - ControlFlowItem *pred = list; - SgStatement *stmt; - for (stmt = firstSt; ( - stmt != lastSt - && stmt->variant() != CONTAINS_STMT - && (lastSt != NULL || stmt->variant() != ELSEIF_NODE) - && (lastSt != NULL || stmt->variant() != CASE_NODE) - && (lastSt != NULL || stmt->variant() != DEFAULT_NODE)); - stmt = stmt->lexNext()) - { - if (stmt->variant() == CONTROL_END) - { - if (isSgExecutableStatement(stmt)) - break; - } - - cur = processOneStatement(&stmt, &pred, &list, cur, loops, calls, commons); - if (cur == NULL) - { - clearList(list); - return NULL; - } - } - if (cur == NULL){ - cur = list = new ControlFlowItem(currentProcedure); - } - if (last != NULL) - *last = cur; - if (lastAnStmt != NULL) - *lastAnStmt = stmt; - return list; -} - -AnalysedCallsList* CallData::IsHeaderInList(SgStatement* header) -{ - if (header == NULL) - return NULL; - AnalysedCallsList* p = calls_list; - while (p != NULL) { - if (p->header == header) - return p; - p = p->next; - } - return NULL; -} - -void CallData::AssociateGraphWithHeader(SgStatement* st, ControlFlowGraph* gr) -{ - AnalysedCallsList* l = calls_list; - while (l != NULL) { - if (l->header == st) { - if (gr == l->graph && gr != NULL) - gr->AddRef(); - l->graph = gr; - return; - } - l = l->next; - } - delete gr; -} - -AnalysedCallsList* CallData::AddHeader(SgStatement* st, bool isFun, SgSymbol* name, int fid) -{ - //test - bool add_intr = IsAnIntrinsicSubroutine(name->identifier()) != NULL; - AnalysedCallsList* l = new AnalysedCallsList(st, (isIntrinsicFunctionNameACC(name->identifier()) || add_intr) && !IsUserFunctionACC(name), IsPureProcedureACC(name), isFun, name->identifier(), fid); - l->next = calls_list; - calls_list = l; - return l; -} - -extern int isStatementFunction(SgSymbol *s); - -AnalysedCallsList* CallData::getLinkToCall(SgExpression* e, SgStatement* s, CommonData* commons) -{ - SgStatement* header = NULL; - SgSymbol* name; - bool isFun; - graph_node* g = NULL; - if (e == NULL) { - //s - procedure call - SgCallStmt* f = isSgCallStmt(s); - SgSymbol* fdaf = f->name(); - if (ATTR_NODE(f->name()) != NULL) - g = GRAPHNODE(f->name()); - if (g == NULL) { - - is_correct = "no header for procedure"; - failed_proc_name = f->name()->identifier(); - return (AnalysedCallsList*)(-1); - - } - if (g) - header = isSgProcHedrStmt(g->st_header); - name = f->name(); - isFun = false; - //intr = isIntrinsicFunctionNameACC(f->name()->identifier()) && !IsUserFunctionACC(f->name()); - //IsPureProcedureACC(f->name()); - } - else { - //e - function call - SgFunctionCallExp* f = isSgFunctionCallExp(e); - if (isStatementFunction(f->funName())) - return (AnalysedCallsList*)(-2); - if (ATTR_NODE(f->funName()) != NULL) - g = GRAPHNODE(f->funName()); - if (g == NULL) { - is_correct = "no header for function"; - failed_proc_name = f->funName()->identifier(); - return (AnalysedCallsList*)(-1); - } - header = isSgFuncHedrStmt(g->st_header); - name = f->funName(); - isFun = true; - } - AnalysedCallsList* p; - if ((p = IsHeaderInList(header))) { - recursion_flag = recursion_flag || p->graph != NULL; - return p; - } - AnalysedCallsList* prev = currentProcedure; - currentProcedure = p = AddHeader(header, isFun, name, g->file_id); - if (!p->isIntrinsic) { - int stored = SwitchFile(g->file_id); - - ControlFlowGraph* graph = GetControlFlowGraphWithCalls(false, header, this, commons); - //if (graph == NULL) - //failed_proc_name = name->identifier(); - - SwitchFile(stored); - - AssociateGraphWithHeader(header, graph); - commons->MarkEndOfCommon(p); - } - currentProcedure = prev; - return p; -} - -static ControlFlowItem* GetFuncCallsForExpr(SgExpression* e, CallData* calls, ControlFlowItem** last, CommonData* commons, SgStatement* os) -{ - if (e == NULL) { - *last = NULL; - return NULL; - } - SgFunctionCallExp* f = isSgFunctionCallExp(e); - if (f) { - ControlFlowItem* head = new ControlFlowItem(NULL, NULL, currentProcedure, calls->getLinkToCall(e, NULL, commons)); - head->setOriginalStatement(os); - ControlFlowItem* curl = head; - head->setFunctionCall(f); - ControlFlowItem* l1, *l2; - ControlFlowItem* tail1 = GetFuncCallsForExpr(e->lhs(), calls, &l1, commons, os); - ControlFlowItem* tail2 = GetFuncCallsForExpr(e->rhs(), calls, &l2, commons, os); - *last = head; - if (tail2 != NULL) { - l2->AddNextItem(head); - head = tail2; - } - if (tail1 != NULL) { - l1->AddNextItem(head); - head = tail1; - } - - return head; - } - f = isSgFunctionCallExp(e->lhs()); - if (f) { - ControlFlowItem* head = new ControlFlowItem(NULL, NULL, currentProcedure, calls->getLinkToCall(e->lhs(), NULL, commons)); - head->setOriginalStatement(os); - head->setFunctionCall(f); - ControlFlowItem* l1, *l2, *l3; - ControlFlowItem* tail1 = GetFuncCallsForExpr(e->lhs()->lhs(), calls, &l1, commons, os); - ControlFlowItem* tail2 = GetFuncCallsForExpr(e->lhs()->rhs(), calls, &l2, commons, os); - ControlFlowItem* tail3 = GetFuncCallsForExpr(e->rhs(), calls, &l3, commons, os); - *last = head; - if (tail2 != NULL) { - l2->AddNextItem(head); - head = tail2; - } - if (tail1 != NULL) { - l1->AddNextItem(head); - head = tail1; - } - if (tail3 != NULL) { - (*last)->AddNextItem(tail3); - *last = l3; - } - return head; - } - return GetFuncCallsForExpr(e->rhs(), calls, last, commons, os); -} - -static ControlFlowItem* AddFunctionCalls(SgStatement* st, CallData* calls, ControlFlowItem** last, CommonData* commons) -{ - ControlFlowItem* retv = GetFuncCallsForExpr(st->expr(0), calls, last, commons, st); - ControlFlowItem* l2 = NULL; - ControlFlowItem* second = GetFuncCallsForExpr(st->expr(1), calls, &l2, commons, st); - if (retv == NULL) { - retv = second; - *last = l2; - } - else if (second != NULL) { - (*last)->AddNextItem(second); - *last = l2; - } - ControlFlowItem* l3 = NULL; - ControlFlowItem* third = GetFuncCallsForExpr(st->expr(2), calls, &l3, commons, st); - if (retv == NULL) { - retv = third; - *last = l3; - } - else if (third != NULL) { - (*last)->AddNextItem(third); - *last = l3; - } - return retv; -} - -void DoLoopDataList::AddLoop(int file_id, SgStatement* st, SgExpression* l, SgExpression* r, SgExpression* step, SgSymbol* lv) -{ - DoLoopDataItem* nt = new DoLoopDataItem(); - nt->file_id = file_id; - nt->statement = st; - nt->l = l; - nt->r = r; - nt->st = step; - nt->loop_var = lv; - nt->next = list; - list = nt; -} - -DoLoopDataList::~DoLoopDataList() -{ -#if __SPF - removeFromCollection(this); - return; -#endif - while (list != NULL) { - DoLoopDataItem* t = list->next; - delete list; - list = t; - } -} - -static ControlFlowItem* processOneStatement(SgStatement** stmt, ControlFlowItem** pred, ControlFlowItem **list, ControlFlowItem* oldcur, doLoops* loops, CallData* calls, CommonData* commons) -{ - ControlFlowItem* lastf; - ControlFlowItem* funcs = AddFunctionCalls(*stmt, calls, &lastf, commons); - if (funcs != NULL) { - if (*pred != NULL) - (*pred)->AddNextItem(funcs); - else - *list = funcs; - *pred = lastf; - } - - switch ((*stmt)->variant()) - { - case IF_NODE: - { - ControlFlowItem* emptyAfterIf = new ControlFlowItem(currentProcedure); //empty item to avoid second pass - /* - if ((*stmt)->hasLabel()){ - ControlFlowItem* emptyBeforeIf = new ControlFlowItem(); - emptyBeforeIf->setLabel((*stmt)->label()); - if (*pred != NULL) - (*pred)->AddNextItem(emptyBeforeIf); - else - *list = emptyBeforeIf; - *pred = emptyBeforeIf; - } - */ - ControlFlowItem* cur = ifItem(*stmt, emptyAfterIf, stmt, loops, false, calls, commons); - emptyAfterIf->setLabel((*stmt)->label()); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - return (*pred = emptyAfterIf); - } - case ASSIGN_STAT: - case POINTER_ASSIGN_STAT: - case PROC_STAT: - case PRINT_STAT: - case READ_STAT: - case WRITE_STAT: - case ALLOCATE_STMT: - case DEALLOCATE_STMT: - { - ControlFlowItem* cur = new ControlFlowItem(*stmt, NULL, currentProcedure, (*stmt)->variant() == PROC_STAT ? calls->getLinkToCall(NULL, *stmt, commons) : NULL); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - return (*pred = loops->checkStatementForLoopEnding(cur->getLabel() ? cur->getLabel()->id() : -1, cur)); - } - case LOGIF_NODE: - { - ControlFlowItem* emptyAfterIf = new ControlFlowItem(currentProcedure); //empty item to avoid second pass - SgLogIfStmt* cond = isSgLogIfStmt(*stmt); - SgLabel* lbl = (*stmt)->label(); - SgExpression* c = &(SgNotOp((cond->conditional()->copy()))); - ControlFlowItem* cur = new ControlFlowItem(c, emptyAfterIf, NULL, (*stmt)->label(), currentProcedure); - cur->setOriginalStatement(*stmt); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - *stmt = (*stmt)->lexNext(); - ControlFlowItem* body; - if ((body = processOneStatement(stmt, &cur, list, cur, loops, calls, commons)) == NULL){ - return NULL; - } - body->AddNextItem(emptyAfterIf); - return (*pred = loops->checkStatementForLoopEnding(lbl ? lbl->id() : -1, emptyAfterIf)); - } - case WHILE_NODE: - { - SgWhileStmt* cond = isSgWhileStmt(*stmt); - bool isEndDo = (*stmt)->lastNodeOfStmt()->variant() == CONTROL_END; - SgExpression* c; - if (cond->conditional()) - c = &(SgNotOp((cond->conditional()->copy()))); - else - c = new SgValueExp(1); - ControlFlowItem* emptyAfterWhile = new ControlFlowItem(currentProcedure); - ControlFlowItem* emptyBeforeBody = new ControlFlowItem(currentProcedure); - ControlFlowItem* cur = new ControlFlowItem(c, emptyAfterWhile, emptyBeforeBody, (*stmt)->label(), currentProcedure); - cur->setOriginalStatement(cond); - ControlFlowItem* gotoStart = new ControlFlowItem(NULL, cur, emptyAfterWhile, NULL, currentProcedure); - ControlFlowItem* emptyBefore = new ControlFlowItem(NULL, (ControlFlowItem*)NULL, cur, cond->label(), currentProcedure); - SgVarRefExp* doName = (isSgVarRefExp((*stmt)->expr(2))); - int lbl = -1; - if (!isEndDo){ - SgStatement* end = lastStmtOfDoACC(cond); - if (end->controlParent() && end->controlParent()->variant() == LOGIF_NODE) - lbl = end->controlParent()->label()->id(); - else - lbl = end->label()->id(); - } - loops->addLoop(lbl, doName ? doName->symbol() : NULL, gotoStart, emptyAfterWhile); - ControlFlowItem* n, *last; - if (isEndDo){ - if ((n = getControlFlowList((*stmt)->lexNext(), NULL, &last, stmt, loops, calls, commons)) == NULL) - return NULL; - emptyBeforeBody->AddNextItem(n); - loops->endLoop(last); - } - if (*pred != NULL) - (*pred)->AddNextItem(emptyBefore); - else - *list = emptyBefore; - if (isEndDo) - return (*pred = emptyAfterWhile); - return (*pred = emptyBeforeBody); - } - case FOR_NODE: - { - SgForStmt* fst = isSgForStmt(*stmt); -#if __SPF - SgStatement *p = NULL; - for (int i = 0; i < fst->numberOfAttributes(); ++i) - { - if (fst->attributeType(i) == SPF_ANALYSIS_DIR) - { - p = (SgStatement *)(fst->getAttribute(i)->getAttributeData()); - break; - } - } - bool isParLoop = (p && p->variant() == SPF_ANALYSIS_DIR); -#else - SgStatement* p = (*stmt)->lexPrev(); - bool isParLoop = (p && p->variant() == DVM_PARALLEL_ON_DIR); -#endif - SgExpression* pl = NULL; - SgExpression* pPl = NULL; - bool pl_flag = true; - if (isParLoop){ -#if __SPF - SgExpression* el = p->expr(0); -#else - SgExpression* el = p->expr(1); -#endif - pPl = el; - while (el != NULL) { - SgExpression* e = el->lhs(); - if (e->variant() == ACC_PRIVATE_OP) { - pl = e; - break; - } - pPl = el; - pl_flag = false; - el = el->rhs(); - } - //pl->unparsestdout(); - } - bool isEndDo = fst->isEnddoLoop(); - SgExpression* lh = new SgVarRefExp(fst->symbol()); - SgStatement* fa = new SgAssignStmt(*lh, *fst->start()); - bool needs_goto = true; -#if !__SPF - // create goto edge if can not calculate count of loop's iterations - if (fst->start()->variant() == INT_VAL && fst->end()->variant() == INT_VAL && fst->start()->valueInteger() < fst->end()->valueInteger()) - needs_goto = false; -#endif - //fa->setLabel(*(*stmt)->label()); - ControlFlowItem* last; - ControlFlowItem* emptyAfterDo = new ControlFlowItem(currentProcedure); - ControlFlowItem* emptyBeforeDo = new ControlFlowItem(currentProcedure); - ControlFlowItem* gotoEndInitial = NULL; - if (needs_goto) { - SgExpression* sendc = new SgExpression(GT_OP, new SgVarRefExp(fst->symbol()), fst->end(), NULL); - gotoEndInitial = new ControlFlowItem(sendc, emptyAfterDo, emptyBeforeDo, NULL, currentProcedure, true); - gotoEndInitial->setOriginalStatement(fst); - } - ControlFlowItem* stcf = new ControlFlowItem(fa, needs_goto ? gotoEndInitial : emptyBeforeDo, currentProcedure); - stcf->setOriginalStatement(fst); - stcf->setLabel((*stmt)->label()); - SgExpression* rh = new SgExpression(ADD_OP, new SgVarRefExp(fst->symbol()), new SgValueExp(1), NULL); - SgStatement* add = new SgAssignStmt(*lh, *rh); - SgExpression* endc = new SgExpression(GT_OP, new SgVarRefExp(fst->symbol()), fst->end(), NULL); - ControlFlowItem* gotoStart = new ControlFlowItem(NULL, emptyBeforeDo, emptyAfterDo, NULL, currentProcedure); - ControlFlowItem* gotoEnd = new ControlFlowItem(endc, emptyAfterDo, gotoStart, NULL, currentProcedure); - gotoEnd->setOriginalStatement(fst); - if (needs_goto) { - gotoEnd->SetConditionFriend(gotoEndInitial); - } - ControlFlowItem* loop_d = new ControlFlowItem(add, gotoEnd, currentProcedure); - loop_d->setOriginalStatement(fst); - ControlFlowItem* loop_emp = new ControlFlowItem(NULL, loop_d, currentProcedure); - SgVarRefExp* doName = (isSgVarRefExp((*stmt)->expr(2))); - int lbl = -1; - if (!isEndDo){ - SgStatement* end = lastStmtOfDoACC(fst); - if (end->variant() == LOGIF_NODE) - lbl = end->controlParent()->label()->id(); - else - lbl = end->label()->id(); - } - loops->addLoop(lbl, doName ? doName->symbol() : NULL, loop_emp, emptyAfterDo); - doLoopList->AddLoop(current_file_id, *stmt, fst->start(), fst->end(), fst->step(), fst->symbol()); - if (isParLoop) { -#if __SPF - // all loop has depth == 1 ? is it correct? - int k = 1; -#else - SgExpression* par_des = p->expr(2); - int k = 0; - while (par_des != NULL && par_des->lhs() != NULL) { - k++; - par_des = par_des->rhs(); - } -#endif - loops->setParallelDepth(k, pl, p, pPl, pl_flag); - } - - if (loops->isLastParallel()) { - SgExpression* ex = loops->getPrivateList(); - emptyBeforeDo->MakeParloopStart(); - bool f; - SgExpression* e = loops->getExpressionToModifyPrivateList(&f); - emptyBeforeDo->setPrivateList(ex, loops->GetParallelStatement(), e, f); - loop_d->MakeParloopEnd(); - } - if (isEndDo){ - ControlFlowItem* body; - if ((body = getControlFlowList(fst->body(), NULL, &last, stmt, loops, calls, commons)) == NULL) - return NULL; - emptyBeforeDo->AddNextItem(body); - loops->endLoop(last); - } - if (*pred != NULL) - (*pred)->AddNextItem(stcf); - else - *list = stcf; - if (isEndDo) - return (*pred = emptyAfterDo); - return (*pred = emptyBeforeDo); - } - case GOTO_NODE: - { - SgGotoStmt* gst = isSgGotoStmt(*stmt); - ControlFlowItem* gt = new ControlFlowItem(NULL, gst->branchLabel(), NULL, gst->label(), currentProcedure); - if (*pred != NULL) - (*pred)->AddNextItem(gt); - else - *list = gt; - return (*pred = gt); - } - case ARITHIF_NODE: - { - SgArithIfStmt* arif = (SgArithIfStmt*)(*stmt); - ControlFlowItem* gt3 = new ControlFlowItem(NULL, ((SgLabelRefExp*)(*stmt)->expr(1)->rhs()->rhs()->lhs())->label(), NULL, NULL, currentProcedure); - ControlFlowItem* gt2 = new ControlFlowItem(&SgEqOp(*(arif->conditional()), *new SgValueExp(0)), ((SgLabelRefExp*)(*stmt)->expr(1)->rhs()->lhs())->label(), gt3, NULL, currentProcedure); - gt2->setOriginalStatement(arif); - ControlFlowItem* gt1 = new ControlFlowItem(&(*arif->conditional() < *new SgValueExp(0)), ((SgLabelRefExp*)(*stmt)->expr(1)->lhs())->label(), gt2, (*stmt)->label(), currentProcedure); - gt1->setOriginalStatement(arif); - if (*pred != NULL) - (*pred)->AddNextItem(gt1); - else - *list = gt1; - return (*pred = gt3); - } - case COMGOTO_NODE: - { - SgComputedGotoStmt* cgt = (SgComputedGotoStmt*)(*stmt); - SgExpression* label = cgt->labelList(); - int i = 0; - SgLabel* lbl = ((SgLabelRefExp *)(label->lhs()))->label(); - ControlFlowItem* gt = new ControlFlowItem(&SgEqOp(*(cgt->exp()), *new SgValueExp(++i)), lbl, NULL, cgt->label(), currentProcedure); - gt->setOriginalStatement(cgt); - if (*pred != NULL) - (*pred)->AddNextItem(gt); - else - *list = gt; - ControlFlowItem* old = gt; - while ((label = label->rhs())) - { - lbl = ((SgLabelRefExp *)(label->lhs()))->label(); - gt = new ControlFlowItem(&SgEqOp(*(cgt->exp()), *new SgValueExp(++i)), lbl, NULL, NULL, currentProcedure); - gt->setOriginalStatement(cgt); - old->AddNextItem(gt); - old = gt; - } - return (*pred = gt); - } - case SWITCH_NODE: - { - ControlFlowItem* emptyAfterSwitch = new ControlFlowItem(currentProcedure); - ControlFlowItem* cur = switchItem(*stmt, emptyAfterSwitch, stmt, loops, calls, commons); - emptyAfterSwitch->setLabel((*stmt)->label()); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - return (*pred = emptyAfterSwitch); - } - case CONT_STAT: - { - ControlFlowItem* cur = new ControlFlowItem(NULL, (ControlFlowItem*)NULL, NULL, (*stmt)->label(), currentProcedure); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - return (*pred = loops->checkStatementForLoopEnding(cur->getLabel() ? cur->getLabel()->id() : -1, cur)); - } - case CYCLE_STMT: - { - SgSymbol* ref = (*stmt)->symbol(); - ControlFlowItem* cur = new ControlFlowItem(NULL, loops->getSourceForCycle(ref), NULL, (*stmt)->label(), currentProcedure); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - return (*pred = cur); - } - case EXIT_STMT: - { - SgSymbol* ref = (*stmt)->symbol(); - ControlFlowItem* cur = new ControlFlowItem(NULL, loops->getSourceForExit(ref), NULL, (*stmt)->label(), currentProcedure); - if (*pred != NULL) - (*pred)->AddNextItem(cur); - else - *list = cur; - return (*pred = cur); - } - case COMMENT_STAT: - return *pred; - case COMM_STAT: - { - commons->RegisterCommonBlock(*stmt, currentProcedure); - return *pred; - } - default: - return *pred; - //return NULL; - } -} - -ControlFlowGraph::ControlFlowGraph(bool t, bool m, ControlFlowItem* list, ControlFlowItem* end) : temp(t), main(m), refs(1), def(NULL), use(NULL), pri(NULL), common_def(NULL), common_use(NULL), hasBeenAnalyzed(false) -#ifdef __SPF -, pointers(set()) -#endif -{ -#if __SPF - addToCollection(__LINE__, __FILE__, this, 30); -#endif - int n = 0; - ControlFlowItem* orig = list; - CBasicBlock* prev = NULL; - CBasicBlock* start = NULL; - int stmtNo = 0; - bool ns = list->isEnumerated(); - if (list != NULL && !ns){ - while (list != NULL && list != end) - { - list->setStmtNo(++stmtNo); - list = list->getNext(); - } - } - ControlFlowItem* last_prev = NULL; - list = orig; - while (list != NULL && list != end) - { - CBasicBlock* bb = new CBasicBlock(t, list, ++n, this, list->getProc()); - last = bb; - bb->setPrev(prev); - if (prev != NULL){ - prev->setNext(bb); - if (!last_prev->isUnconditionalJump()){ - bb->addToPrev(prev, last_prev->IsForJumpFlagSet(), false, last_prev); - prev->addToSucc(bb, last_prev->IsForJumpFlagSet(), false, last_prev); - } - } - if (start == NULL) - start = bb; - prev = bb; - while (list->getNext() != NULL && list->getNext() != end && !list->getNext()->isLeader()){ - list->setBBno(n); - list = list->getNext(); - } - list->setBBno(n); - last_prev = list; - list = list->getNext(); - } - list = orig; - while (list != NULL && list != end) - { - ControlFlowItem* target; - if ((target = list->getJump()) != NULL) - { -// //no back edges -// if (target->getBBno() > list->getBBno()) -// { - CBasicBlock* tmp1 = start; - CBasicBlock* tmp2 = start; - for (int i = 1; i < target->getBBno() || i < list->getBBno(); i++) - { - if (i < list->getBBno()) { - tmp2 = tmp2->getLexNext(); - if (!tmp2) - break; - } - if (i < target->getBBno()) { - tmp1 = tmp1->getLexNext(); - if (!tmp1) - break; - } - } - if (tmp1 && tmp2) { - tmp1->addToPrev(tmp2, list->IsForJumpFlagSet(), true, list); - tmp2->addToSucc(tmp1, list->IsForJumpFlagSet(), true, list); - } -// } - } - list = list->getNext(); - } - start->markAsReached(); - first = start; - common_use = NULL; - cuf = false; - common_def = NULL; - cdf = false; -} - -CommonDataItem* CommonData::IsThisCommonVar(VarItem* item, AnalysedCallsList* call) -{ - for (CommonDataItem* it = list; it != NULL; it = it->next) { - if (it->proc == call) { - for (CommonVarInfo* inf = it->info; inf != NULL; inf = inf->next) { - if (inf->var && item->var && *inf->var == *item->var) - return it; - } - } - } - return NULL; -} - -CommonDataItem* CommonData::GetItemForName(const string &name, AnalysedCallsList *call) -{ - for (CommonDataItem* it = list; it != NULL; it = it->next) { - if (it->name == name && it->proc == call) - return it; - } - return NULL; -} - -void CommonData::RegisterCommonBlock(SgStatement *st, AnalysedCallsList *cur) -{ - //TODO: multiple common blocks in one procedure with same name - for (SgExpression *common = st->expr(0); common; common = common->rhs()) - { - bool newBlock = false; - SgExprListExp* vars = (SgExprListExp*)common->lhs(); - if (vars == NULL) - continue; - - const string currCommonName = (common->symbol()) ? common->symbol()->identifier() : "spf_unnamed"; - - CommonDataItem* it = GetItemForName(currCommonName, cur); - if (!it) { - it = new CommonDataItem(); - it->cb = st; - it->name = currCommonName; - it->isUsable = true; - it->proc = cur; - it->first = cur; - it->onlyScalars = true; - newBlock = true; - - for (CommonDataItem *i = list; i != NULL; i = i->next) - if (i->name == currCommonName && i->isUsable) - it->first = i->first; - } - it->commonRefs.push_back(common); - - for (int i = 0; i < vars->length(); ++i) - { - SgVarRefExp *e = isSgVarRefExp(vars->elem(i)); - if (e && !IS_ARRAY(e->symbol())) - { - CommonVarInfo* c = new CommonVarInfo(); - c->var = new CScalarVarEntryInfo(e->symbol()); - c->isPendingLastPrivate = false; - c->isInUse = false; - c->parent = it; - c->next = it->info; - it->info = c; - } - else if (isSgArrayRefExp(vars->elem(i))) { - it->onlyScalars = false; - } - else { - CommonVarInfo* c = new CommonVarInfo(); - c->var = new CArrayVarEntryInfo(vars->elem(i)->symbol(), isSgArrayRefExp(vars->elem(i))); - c->isPendingLastPrivate = false; - c->isInUse = false; - c->parent = it; - c->next = it->info; - it->info = c; - it->onlyScalars = false; - } - } - - if (newBlock) - { - it->next = list; - list = it; - } - } -} - -void CommonData::MarkEndOfCommon(AnalysedCallsList* cur) -{ - for (CommonDataItem* i = list; i != NULL; i = i->next) - { - if (i->first == cur) - i->isUsable = false; - } -} - -void CBasicBlock::markAsReached() -{ - prev_status = 1; - BasicBlockItem* s = succ; - while (s != NULL){ - CBasicBlock* b = s->block; - if (b->prev_status == -1) - b->markAsReached(); - s = s->next; - } -} - -bool ControlFlowGraph::ProcessOneParallelLoop(ControlFlowItem* lstart, CBasicBlock* of, CBasicBlock*& p, bool first) -{ - int stored_fid = SwitchFile(lstart->getProc()->file_id); - ControlFlowItem* lend; - if (is_correct != NULL) - { - const char* expanded_log; - char* tmp = NULL; - if (failed_proc_name) - { - tmp = new char[strlen(is_correct) + 2 + strlen(failed_proc_name) + 1]; - strcpy(tmp, is_correct); - strcat(tmp, ": "); - strcat(tmp, failed_proc_name); - expanded_log = tmp; - } - else - expanded_log = is_correct; -#if __SPF - const wchar_t* rus = R159; - Warning("Private analysis is not conducted for loop: '%s'", rus, expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); -#else - Warning("Private analysis is not conducted for loop: '%s'", expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); -#endif - if (tmp) - delete[] tmp; - - } - else - { - while ((lend = p->containsParloopEnd()) == NULL) - { - p->PrivateAnalysisForAllCalls(); - p = p->getLexNext(); - ControlFlowItem* mstart; - if ((mstart = p->containsParloopStart()) != NULL) - { - CBasicBlock* mp = p; - if (first) { - if (!ProcessOneParallelLoop(mstart, of, mp, false)) { - SwitchFile(stored_fid); - return false; - } - } - } - } - CBasicBlock* afterParLoop = p->getLexNext()->getLexNext(); - VarSet* l_pri = ControlFlowGraph(true, false, lstart, lend).getPrivate(); - if (is_correct != NULL) - { - const char* expanded_log; - char* tmp = NULL; - if (failed_proc_name) - { - tmp = new char[strlen(is_correct) + 2 + strlen(failed_proc_name) + 1]; - strcpy(tmp, is_correct); - strcat(tmp, ": "); - strcat(tmp, failed_proc_name); - expanded_log = tmp; - } - else - expanded_log = is_correct; - -#if __SPF - const wchar_t* rus = R159; - Warning("Private analysis is not conducted for loop: '%s'", rus, expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); -#else - Warning("Private analysis is not conducted for loop: '%s'", expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); -#endif - if (tmp) - delete[] tmp; - SwitchFile(stored_fid); - return false; - } - VarSet* p_pri = new VarSet(); - SgExpression* ex_p = lstart->getPrivateList(); - if (ex_p != NULL) - ex_p = ex_p->lhs(); - for (; ex_p != NULL; ex_p = ex_p->rhs()) - { - SgVarRefExp* pr; - if (pr = isSgVarRefExp(ex_p->lhs())) - { - CScalarVarEntryInfo* tmp = new CScalarVarEntryInfo(pr->symbol()); - p_pri->addToSet(tmp, NULL); - delete tmp; - } - SgArrayRefExp* ar; - if (ar = isSgArrayRefExp(ex_p->lhs())) - { - CArrayVarEntryInfo* tmp = new CArrayVarEntryInfo(ar->symbol(), ar); - p_pri->addToSet(tmp, NULL); - delete tmp; - } - } - - VarSet* live = afterParLoop->getLiveIn(); - VarSet* adef = afterParLoop->getDef(); - VarSet* pri = new VarSet(); - VarSet* tmp = new VarSet(); - VarSet* delay = new VarSet(); - tmp->unite(l_pri, false); - - for (VarItem* exp = tmp->getFirst(); exp != NULL; exp = tmp->getFirst()) - { - if (!afterParLoop->IsVarDefinedAfterThisBlock(exp->var, false)) - delay->addToSet(exp->var, NULL); - tmp->remove(exp->var); - } - delete tmp; - pri->unite(l_pri, false); - pri->minus(live, true); - privateDelayedList = new PrivateDelayedItem(pri, p_pri, l_pri, lstart, privateDelayedList, this, delay, current_file_id); - of->SetDelayedData(privateDelayedList); - } - SwitchFile(stored_fid); - return true; -} - -void ControlFlowGraph::privateAnalyzer() -{ - if (hasBeenAnalyzed) - return; - CBasicBlock* p = first; - /* - printf("GRAPH:\n"); - while (p != NULL){ - printf("block %d: ", p->getNum()); - if (p->containsParloopStart()) - printf("start"); - if (p->containsParloopEnd()) - printf("end"); - p->print(); - p = p->getLexNext(); - } - */ - p = first; - liveAnalysis(); - while (1) - { - ControlFlowItem* lstart; - CBasicBlock* of = p; - p->PrivateAnalysisForAllCalls(); - if ((lstart = p->containsParloopStart()) != NULL) - { - if (!ProcessOneParallelLoop(lstart, of, p, true)) - break; - } - if (p == last) - break; - p = p->getLexNext(); - } - hasBeenAnalyzed = true; -} - -/*#ifdef __SPF -void PrivateDelayedItem::PrintWarnings() -{ - if (next) - next->PrintWarnings(); - lp->minus(detected); - while (!detected->isEmpty()) { - SgVarRefExp* var = detected->getFirst(); - detected->remove(var); - Warning("Variable '%s' detected as private", var->unparse(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); - } - while (!lp->isEmpty()) { - SgVarRefExp* var = lp->getFirst(); - lp->remove(var); - Warning("Variable '%s' detected as last private", var->unparse(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); - } - if (detected) - delete detected; - if (original) - delete original; - if (lp) - delete lp; -} -#else*/ - -bool CArrayVarEntryInfo::HasActiveElements() const -{ - bool result = false; - if (disabled) - return false; - if (subscripts == 0) - return true; - for (int i = 0; i < subscripts; i++) - { - if (!data[i].defined) - return false; - if (data[i].left_bound != data[i].right_bound) - result = true; - if (data[i].left_bound == data[i].right_bound && data[i].bound_modifiers[0] <= data[i].bound_modifiers[1]) - result = true; - } - return result; -} - -void CArrayVarEntryInfo::MakeInactive() -{ - disabled = true; - for (int i = 0; i < subscripts; i++) - { - data[i].left_bound = data[i].right_bound = NULL; - data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = 0; - } -} - -void PrivateDelayedItem::PrintWarnings() -{ - if (next) - next->PrintWarnings(); - int stored_fid = SwitchFile(file_id); - total_privates += detected->count(); - total_pl++; - lp->minus(detected); - detected->LeaveOnlyRecords(); - detected->RemoveDoubtfulCommonVars(lstart->getProc()); - VarSet* test1 = new VarSet(); - test1->unite(detected, false); - VarSet* test2 = new VarSet(); - test2->unite(original, false); - test2->minus(detected); - test1->minus(original); - int extra = 0, missing = 0; - SgExpression* prl = lstart->getPrivateList(); - SgStatement* prs = lstart->getPrivateListStatement(); - if (prl == NULL && !test1->isEmpty()) - { - SgExpression* lst = new SgExprListExp(); - prl = new SgExpression(ACC_PRIVATE_OP); - lst->setLhs(prl); - lst->setRhs(NULL); -#if __SPF - SgExpression* clauses = prs->expr(0); -#else - SgExpression* clauses = prs->expr(1); -#endif - if (clauses) { - while (clauses->rhs() != NULL) - clauses = clauses->rhs(); - clauses->setRhs(lst); - } - else { -#if __SPF - prs->setExpression(0, *lst); -#else - prs->setExpression(1, *lst); -#endif - } - } - SgExpression* op = prl; - - while (!test2->isEmpty()) { - //printf("EXTRA IN PRIVATE LIST: "); - //test2->print(); - extra = 1; - VarItem* var = test2->getFirst(); - CVarEntryInfo* syb = var->var->Clone(); - int change_fid = var->file_id; - test2->remove(var->var); - int stored_fid = SwitchFile(change_fid); - if (syb->GetVarType() != VAR_REF_ARRAY_EXP) - { -#if __SPF - const wchar_t* rus = R160; - Warning("var '%s' from private list wasn't classified as private", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); -#else - Warning("var '%s' from private list wasn't classified as private", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); -#endif - } - else - { - CArrayVarEntryInfo* tt = (CArrayVarEntryInfo*)syb; - if (tt->HasActiveElements()) - { -#if __SPF - const wchar_t* rus = R161; - Warning("array '%s' from private list wasn't classified as private", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); -#else - Warning("array '%s' from private list wasn't classified as private", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); -#endif - } - } - delete(syb); - SwitchFile(stored_fid); - } - while (!test1->isEmpty()) { - //printf("MISSING IN PRIVATE LIST: "); - //test1->print(); - missing = 1; - VarItem* var = test1->getFirst(); - CVarEntryInfo* syb = var->var->Clone(); - int change_fid = var->file_id; - test1->remove(var->var); - int stored_fid = SwitchFile(change_fid); - if (syb->GetVarType() != VAR_REF_ARRAY_EXP) { -#if __SPF - const wchar_t* rus = R162; - Note("add private scalar '%s'", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); -#else - Warning("var '%s' was added to private list", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); -#endif - SgExprListExp* nls = new SgExprListExp(); - SgVarRefExp* nvr = new SgVarRefExp(syb->GetSymbol()); - nls->setLhs(nvr); - nls->setRhs(prl->lhs()); - prl->setLhs(nls); - } - else - { - CArrayVarEntryInfo* tt = (CArrayVarEntryInfo*)syb; - if (tt->HasActiveElements()) - { -#if __SPF - const wchar_t* rus = R163; - Note("add private array '%s'", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); -#else - Warning("var '%s' was added to private list", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); -#endif - -// TODO: need to check all situation before commit it to release -#if !__SPF - SgExprListExp *nls = new SgExprListExp(); - SgArrayRefExp *nvr = new SgArrayRefExp(*syb->GetSymbol()); - nls->setLhs(nvr); - nls->setRhs(prl->lhs()); - prl->setLhs(nls); -#endif - } - } - delete(syb); - SwitchFile(stored_fid); - - /*printf("modified parallel stmt:\n"); - prs->unparsestdout(); - printf("\n");*/ - } - if (extra == 0 && missing == 0) { -#if ACCAN_DEBUG - Warning("Correct", "", 0, lstart->getPrivateListStatement()); -#endif - } - //printf("PRIVATE VARS: "); - //detected->print(); - //printf("DECLARATION: "); - //p_pri->print(); - //printf("LAST PRIVATE VARS: "); - //lp->print(); - if (test1) - delete test1; - - - if (test2) - delete test2; - - if (detected) - delete detected; - - if (original) - delete original; - - if (lp) - delete lp; - - SwitchFile(stored_fid); -} -//#endif - -ControlFlowItem* doLoops::checkStatementForLoopEnding(int label, ControlFlowItem* last) -{ - - if (current == NULL || label == -1 || label != current->getLabel()) - return last; - return checkStatementForLoopEnding(label, endLoop(last)); -} - -doLoopItem* doLoops::findLoop(SgSymbol* s) -{ - doLoopItem* l = first; - while (l != NULL){ - if (l->getName() == s) - return l; - l = l->getNext(); - } - return NULL; -} - -void doLoops::addLoop(int l, SgSymbol* s, ControlFlowItem* i, ControlFlowItem* e) -{ - doLoopItem* nl = new doLoopItem(l, s, i, e); - if (first == NULL) - first = current = nl; - else{ - current->setNext(nl); - nl->HandleNewItem(current); - current = nl; - } -} - -ControlFlowItem* doLoops::endLoop(ControlFlowItem* last) -{ - doLoopItem* removed = current; - if (first == current) - first = current = NULL; - else{ - doLoopItem* prev = first; - while (prev->getNext() != current) - prev = prev->getNext(); - prev->setNext(NULL); - current = prev; - } - last->AddNextItem(removed->getSourceForCycle()); - ControlFlowItem* empty = removed->getSourceForExit(); - delete removed; - return empty; -} - -VarSet* ControlFlowGraph::getPrivate() -{ - //printControlFlowList(first->getStart(), last->getStart()); - if (pri == NULL) - { - bool same = false; - int it = 0; - CBasicBlock* p = first; - /* - printf("GRAPH:\n"); - while (p != NULL){ - printf("block %d: ", p->getNum()); - p->print(); - p = p->getLexNext(); - } - */ - p = first; - while (!same){ - p = first; - same = true; - while (p != NULL){ - same = p->stepMrdIn(false) && same; - same = p->stepMrdOut(false) && same; - p = p->getLexNext(); - } - it++; - //printf("iters: %d\n", it); - } - p = first; - while (p != NULL) { - p->stepMrdIn(true); - p->stepMrdOut(true); - //p->getMrdIn(false)->print(); - p = p->getLexNext(); - } - - p = first; - VarSet* res = new VarSet(); - VarSet* loc = new VarSet(); - bool il = false; - while (p != NULL) - { - res->unite(p->getUse(), false); - loc->unite(p->getDef(), false); - p = p->getLexNext(); - } - //printf("USE: "); - //res->print(); - //printf("LOC: "); - //loc->print(); - res->unite(loc, false); - //printf("GETUSE: "); - //getUse()->print(); - - //res->minus(getUse()); //test! - res->minusFinalize(getUse(), true); - pri = res; - } - return pri; -} - -void ControlFlowGraph::liveAnalysis() -{ - bool same = false; - int it = 0; - CBasicBlock* p = first; - p = first; - while (!same){ - p = last; - same = true; - while (p != NULL){ - same = p->stepLVOut() && same; - same = p->stepLVIn() && same; - p = p->getLexPrev(); - } - it++; - //printf("iters: %d\n", it); - } -} - -VarSet* ControlFlowGraph::getUse() -{ - if (use == NULL) - { - CBasicBlock* p = first; - VarSet* res = new VarSet(); - while (p != NULL) - { - VarSet* tmp = new VarSet(); - tmp->unite(p->getUse(), false); - tmp->minus(p->getMrdIn(false)); - //printf("BLOCK %d INSTR %d USE: ", p->getNum(), p->getStart()->getStmtNo()); - //tmp->print(); - res->unite(tmp, false); - delete tmp; - p = p->getLexNext(); - } - use = res; - - } - if (!cuf) - { - AnalysedCallsList* call = first->getStart()->getProc(); - cuf = true; - if (call) { - CommonVarSet* s = pCommons->GetCommonsForVarSet(use, call); - common_use = s; - for (CBasicBlock* i = first; i != NULL; i = i->getLexNext()){ - for (CommonVarSet* c = i->getCommonUse(); c != NULL; c = c->next) { - /* - CommonVarSet* n = new CommonVarSet(); - n->cvd = c->cvd; - n->cvd->refs++; - */ - CommonVarSet* n = new CommonVarSet(*c); - CommonVarSet* t; - for (t = n; t->next != NULL; t = t->next); - t->next = common_use; - common_use = n; - } - } - } - } - return use; -} - -VarSet* ControlFlowGraph::getDef() -{ - if (def == NULL) { - def = new VarSet(); - def->unite(last->getMrdOut(false), true); - } - if (!cdf) - { - AnalysedCallsList* call = first->getStart()->getProc(); - if (call) { - cdf = true; - CommonVarSet* s = pCommons->GetCommonsForVarSet(def, call); - common_def = s; - for (CBasicBlock* i = first; i != NULL; i = i->getLexNext()) { - for (CommonVarSet* c = i->getCommonDef(); c != NULL; c = c->next) { - /* - CommonVarSet* n = new CommonVarSet(); - n->cvd = c->cvd; - n->cvd->refs++; - */ - CommonVarSet *n = new CommonVarSet(*c); - CommonVarSet* t; - for (t = n; t->next != NULL; t = t->next); - t->next = common_def; - common_def = n; - } - } - } - } - return def; -} - -CommonVarSet* CommonData::GetCommonsForVarSet(VarSet* set, AnalysedCallsList* call) -{ - CommonVarSet* res = NULL; - for (CommonDataItem* i = list; i != NULL; i = i->next) { - if (i->proc == call) { - for (CommonVarInfo* v = i->info; v != NULL; v = v->next) { - if (set->belongs(v->var)) { - CommonVarSet* n = new CommonVarSet(); - n->cvd = v; - n->next = res; - res = n; - } - } - } - } - return res; -} - -void CBasicBlock::PrivateAnalysisForAllCalls() -{ - ControlFlowItem* p = start; - while (p != NULL && (p == start || !p->isLeader())) { - AnalysedCallsList* c = p->getCall(); - const char* oic = is_correct; - const char* fpn = failed_proc_name; - is_correct = NULL; - failed_proc_name = NULL; - if (c != NULL && c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c->header != NULL && !c->hasBeenAnalysed) { - c->hasBeenAnalysed = true; - - int stored_fid = SwitchFile(c->file_id); - - c->graph->privateAnalyzer(); - - SwitchFile(stored_fid); - - } - is_correct = oic; - failed_proc_name = fpn; - p = p->getNext(); - } - return; -} - -ControlFlowItem* CBasicBlock::containsParloopEnd() -{ - ControlFlowItem* p = start; - while (p != NULL && (p == start || !p->isLeader())){ - if (p->IsParloopEnd()) - return p; - p = p->getNext(); - } - return NULL; -} - -ControlFlowItem* CBasicBlock::containsParloopStart() -{ - ControlFlowItem* p = start; - while (p != NULL && (p == start || !p->isLeader())){ - if (p->IsParloopStart()) - return p; - p = p->getNext(); - } - return NULL; -} - -void CBasicBlock::print() -{ - printf("block %d: prev: ", num); - BasicBlockItem* p = prev; - while (p != NULL){ - printf("%d ", p->block->num); - p = p->next; - } - printf("\n"); -} - -ControlFlowItem* CBasicBlock::getStart() -{ - return start; -} - -ControlFlowItem* CBasicBlock::getEnd() -{ - ControlFlowItem* p = start; - ControlFlowItem* end = p; - while (p != NULL && (p == start || !p->isLeader())){ - end = p; - p = p->getNext(); - } - return end; -} - -VarSet* CBasicBlock::getLVOut() -{ - if (lv_out == NULL) - { - VarSet* res = new VarSet(); - BasicBlockItem* p = succ; - bool first = true; - while (p != NULL) - { - CBasicBlock* b = p->block; - if (b != NULL && !b->lv_undef) - { - res->unite(b->getLVIn(), false); - } - p = p->next; - } - lv_out = res; - } - return lv_out; -} - -VarSet* CBasicBlock::getLVIn() -{ - if (lv_in == NULL) - { - VarSet* res = new VarSet(); - res->unite(getLVOut(), false); - res->minus(getDef()); - res->unite(getUse(), false); - lv_in = res; - } - return lv_in; -} - -bool CBasicBlock::IsVarDefinedAfterThisBlock(CVarEntryInfo* var, bool os) -{ - findentity = var; - if (def->belongs(var, os)) { - findentity = NULL; - return true; - } - BasicBlockItem* p = succ; - while (p != NULL) - { - CBasicBlock* b = p->block; - if (b->ShouldThisBlockBeCheckedAgain(var) && b->IsVarDefinedAfterThisBlock(var, os)) { - findentity = NULL; - return true; - } - p = p->next; - } - findentity = NULL; - return false; -} - -bool CBasicBlock::stepLVOut() -{ - if (old_lv_out) - delete old_lv_out; - - old_lv_out = lv_out; - lv_out = NULL; - getLVOut(); - lv_undef = false; - //printf("block %d\n", num); - //old_mrd_out->print(); - //mrd_out->print(); - return (lv_out->equal(old_lv_out)); - //return true; -} - -bool CBasicBlock::stepLVIn() -{ - if (old_lv_in) - delete old_lv_in; - - old_lv_in = lv_in; - lv_in = NULL; - getLVIn(); - return (lv_in->equal(old_lv_in)); - //return true; -} - -VarSet* CBasicBlock::getMrdIn(bool la) -{ - if (mrd_in == NULL) - { - VarSet* res = new VarSet(); - BasicBlockItem* p = prev; - bool first = true; - - while (p != NULL) - { - CBasicBlock* b = p->block; - if (b != NULL && !b->undef && b->hasPrev()) - { - if (first) { - res->unite(b->getMrdOut(la), la); - first = false; - } - else - res->intersect(b->getMrdOut(la), la, true); - } - p = p->next; - } - mrd_in = res; - } - return mrd_in; -} - -bool CBasicBlock::hasPrev() -{ - return prev_status == 1; -} - -VarSet* CBasicBlock::getMrdOut(bool la) -{ - if (mrd_out == NULL) - { - VarSet* res = new VarSet(); - res->unite(getMrdIn(la), la); - res->unite(getDef(), la); - mrd_out = res; - //printf("BLOCK %d INSTR %d MRDOUT: ", num, start->getStmtNo()); - //mrd_out->print(); - //print(); - } - return mrd_out; -} - -bool CBasicBlock::stepMrdOut(bool la) -{ - if (old_mrd_out) - delete old_mrd_out; - - old_mrd_out = mrd_out; - mrd_out = NULL; - getMrdOut(la); - undef = false; - //printf("block %d\n", num); - //old_mrd_out->print(); - //mrd_out->print(); - return (mrd_out->equal(old_mrd_out)); - //return true; -} - -bool CBasicBlock::stepMrdIn(bool la) -{ - if (old_mrd_in) - delete old_mrd_in; - - old_mrd_in = mrd_in; - mrd_in = NULL; - getMrdIn(la); - return (mrd_in->equal(old_mrd_in)); - //return true; -} - -bool IsPresentInExprList(SgExpression* ex, CExprList* lst) -{ - while (lst != NULL) { - if (lst->entry == ex) - return true; - lst = lst->next; - } - return false; -} - -CRecordVarEntryInfo* AddRecordVarRef(SgRecordRefExp* ref) -{ - if (isSgRecordRefExp(ref->lhs())) { - CVarEntryInfo* parent = AddRecordVarRef(isSgRecordRefExp(ref->lhs())); - if (parent) - return new CRecordVarEntryInfo(ref->rhs()->symbol(), parent); - return NULL; - } - if (isSgVarRefExp(ref->lhs())) { - CVarEntryInfo* parent = new CScalarVarEntryInfo(isSgVarRefExp(ref->lhs())->symbol()); - return new CRecordVarEntryInfo(ref->rhs()->symbol(), parent); - } - if (isSgArrayRefExp(ref->lhs())) { - CVarEntryInfo* parent = new CArrayVarEntryInfo(isSgArrayRefExp(ref->lhs())->symbol(), isSgArrayRefExp(ref->lhs())); - return new CRecordVarEntryInfo(ref->rhs()->symbol(), parent); - } - return NULL; -} - -void CBasicBlock::AddOneExpressionToUse(SgExpression* ex, SgStatement* st, CArrayVarEntryInfo* v) -{ - CVarEntryInfo* var = NULL; - SgVarRefExp* r; - if ((r = isSgVarRefExp(ex))) - var = new CScalarVarEntryInfo(r->symbol()); - SgArrayRefExp* ar; - if ((ar = isSgArrayRefExp(ex))) { - if (!v) - var = new CArrayVarEntryInfo(ar->symbol(), ar); - else { - var = v->Clone(); - var->SwitchSymbol(ar->symbol()); - } - } - SgRecordRefExp* rr; - if ((rr = isSgRecordRefExp(ex))) - var = AddRecordVarRef(rr); - if (var) { - var->RegisterUsage(def, use, st); - delete var; - } -} - -void CBasicBlock::AddOneExpressionToDef(SgExpression* ex, SgStatement* st, CArrayVarEntryInfo* v) -{ - CVarEntryInfo* var = NULL; - SgVarRefExp* r; - if ((r = isSgVarRefExp(ex))) - var = new CScalarVarEntryInfo(r->symbol()); - SgRecordRefExp* rr; - if ((rr = isSgRecordRefExp(ex))) - var = AddRecordVarRef(rr); - SgArrayRefExp* ar; - if ((ar = isSgArrayRefExp(ex))) { - if (!v) - var = new CArrayVarEntryInfo(ar->symbol(), ar); - else { - var = v->Clone(); - var->SwitchSymbol(ar->symbol()); - } - } - if (var) { - var->RegisterDefinition(def, use, st); - delete var; - } -} - -void CBasicBlock::addExprToUse(SgExpression* ex, CArrayVarEntryInfo* v = NULL, CExprList* lst = NULL) -{ - if (ex != NULL) - { - CExprList* cur = new CExprList(); - cur->entry = ex; - cur->next = lst; - SgFunctionCallExp* f = isSgFunctionCallExp(ex); - if (!f) { - if (!IsPresentInExprList(ex->lhs(), cur)) - addExprToUse(ex->lhs(), v, cur); - if (!isSgUnaryExp(ex)) - if (!IsPresentInExprList(ex->rhs(), cur)) - addExprToUse(ex->rhs(), v, cur); - AddOneExpressionToUse(ex, NULL, v); - } - delete cur; - /* - SgVarRefExp* r; - //printf(" %s\n", f->funName()->identifier()); - bool intr = isIntrinsicFunctionNameACC(f->funName()->identifier()) && !IsUserFunctionACC(f->funName()); - bool pure = IsPureProcedureACC(f->funName()); - if (!intr && !pure){ - printf("function not intristic or pure: %s\n", f->funName()->identifier()); - is_correct = false; - return; - } - if (intr) { - ProcessIntristicProcedure(true, f->numberOfArgs(), f); - return; - } - ProcessProcedureHeader(true, isSgProcHedrStmt(GRAPHNODE(f->funName())->st_header), f); - */ - } -} - -void CBasicBlock::ProcessIntrinsicProcedure(bool isF, int narg, void* f, const char* name) -{ - for (int i = 0; i < narg; i++) { - SgExpression* ar = GetProcedureArgument(isF, f, i); - if (IsAnIntrinsicSubroutine(name)) - { - SgExpression* v = CheckIntrinsicParameterFlag(name, i, ar, INTRINSIC_IN); - if (v) - addExprToUse(v); - } - else - addExprToUse(ar); - - AddOneExpressionToDef(CheckIntrinsicParameterFlag(name, i, ar, INTRINSIC_OUT), NULL, NULL); - } -} - -void CBasicBlock::ProcessProcedureWithoutBody(bool isF, void* f, bool out) -{ - for (int i = 0; i < GetNumberOfArguments(isF, f); i++){ - addExprToUse(GetProcedureArgument(isF, f, i)); - if (out) - AddOneExpressionToDef(GetProcedureArgument(isF, f, i), NULL, NULL); - } -} - -SgSymbol* CBasicBlock::GetProcedureName(bool isFunc, void* f) -{ - if (isFunc) { - SgFunctionCallExp* fc = (SgFunctionCallExp*)f; - return fc->funName(); - } - SgCallStmt* pc = (SgCallStmt*)f; - return pc->name(); -} - -int GetNumberOfArguments(bool isF, void* f) -{ - if (isF) { - SgFunctionCallExp* fc = (SgFunctionCallExp*)f; - return fc->numberOfArgs(); - } - SgCallStmt* pc = (SgCallStmt*)f; - return pc->numberOfArgs(); -} - -SgExpression* GetProcedureArgument(bool isF, void *f, const int i) -{ - SgExpression *arg = NULL; - if (isF) - { - SgFunctionCallExp* fc = (SgFunctionCallExp*)f; - arg = fc->arg(i); - } - else - { - SgCallStmt *pc = (SgCallStmt*)f; - arg = pc->arg(i); - } - return arg; -} - -void CBasicBlock::ProcessProcedureHeader(bool isF, SgProcHedrStmt *header, void *f, const char* name) -{ - if (!header) - { - is_correct = "no header found"; - failed_proc_name = name; - return; - } - - for (int i = 0; i < header->numberOfParameters(); ++i) - { - int stored = SwitchFile(header->getFileId()); - SgSymbol *arg = header->parameter(i); - SwitchFile(stored); - - if (arg->attributes() & (IN_BIT)) - { - SgExpression *ar = GetProcedureArgument(isF, f, i); - addExprToUse(ar); - } - else if (arg->attributes() & (INOUT_BIT)) - { - addExprToUse(GetProcedureArgument(isF, f, i)); - AddOneExpressionToDef(GetProcedureArgument(isF, f, i), NULL, NULL); - } - else if (arg->attributes() & (OUT_BIT)) - AddOneExpressionToDef(GetProcedureArgument(isF, f, i), NULL, NULL); - else - { - is_correct = "no bitflag set for pure procedure"; - break; - } - } -} - -bool AnalysedCallsList::isArgIn(int i, CArrayVarEntryInfo** p) -{ - int stored = SwitchFile(this->file_id); - SgProcHedrStmt* h = isSgProcHedrStmt(header); - VarSet* use = graph->getUse(); - SgSymbol* par = h->parameter(i); - /* - CScalarVarEntryInfo* var = new CScalarVarEntryInfo(par); - bool result = false; - if (use->belongs(var)) - result = true; - delete var; - */ - VarItem* result = use->belongs(par); - if (result && result->var->GetVarType() == VAR_REF_ARRAY_EXP && p) - *p = (CArrayVarEntryInfo*)result->var; - SwitchFile(stored); - - return result; -} - -bool AnalysedCallsList::isArgOut(int i, CArrayVarEntryInfo** p) -{ - int stored = SwitchFile(this->file_id); - SgProcHedrStmt* h = isSgProcHedrStmt(header); - graph->privateAnalyzer(); - VarSet* def = graph->getDef(); - SgSymbol* par = h->parameter(i); - /* - CScalarVarEntryInfo* var = new CScalarVarEntryInfo(par); - bool result = false; - if (def->belongs(var)) - result = true; - delete var; - */ - VarItem* result = def->belongs(par); - if (result && result->var->GetVarType() == VAR_REF_ARRAY_EXP && p) - *p = (CArrayVarEntryInfo*)result->var; - SwitchFile(stored); - - return result; -} - -void CommonData::MarkAsUsed(VarSet* use, AnalysedCallsList* lst) -{ - for (CommonDataItem* it = list; it != NULL; it = it->next) { - if (it->proc == lst) { - for (CommonVarInfo* v = it->info; v != NULL; v = v->next) { - CVarEntryInfo* r = v->var; - if (use->belongs(r)) - v->isInUse = true; - } - } - } -} - -void CBasicBlock::ProcessUserProcedure(bool isFun, void* call, AnalysedCallsList* c) -{ - /* - if (c == NULL || c->graph == NULL) { - is_correct = "no body found for procedure"; - if (c != NULL) - failed_proc_name = c->funName; - else - failed_proc_name = NULL; - return; - } - */ - if (c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c != NULL && c->graph != NULL) - { - int stored_file_id = SwitchFile(c->file_id); - c->graph->getPrivate(); //all sets actually - SgStatement *cp = c->header->controlParent(); - SwitchFile(stored_file_id); - - if (proc && proc->header->variant() == PROC_HEDR && cp == proc->header) { - VarSet* use_c = new VarSet(); - use_c->unite(c->graph->getUse(), false); - for (VarItem* exp = use_c->getFirst(); exp != NULL; exp = use_c->getFirst()) { - if (exp->var->GetSymbol()->scope() == proc->header) { - addExprToUse(new SgVarRefExp(exp->var->GetSymbol())); // TESTING - } - use_c->remove(exp->var); - } - delete use_c; - VarSet* def_c = new VarSet(); - def_c->unite(c->graph->getDef(), true); - for (VarItem* exp = def_c->getFirst(); exp != NULL; exp = def_c->getFirst()) { - if (exp->var->GetSymbol()->scope() == proc->header) { - def->addToSet(exp->var, NULL); - } - def_c->remove(exp->var); - } - delete def_c; - } - - pCommons->MarkAsUsed(c->graph->getUse(), c); - SgProcHedrStmt* header = isSgProcHedrStmt(c->header); - if (!header) { - is_correct = "no header for procedure"; - failed_proc_name = c->funName; - return; - } - } - - for (int i = 0; i < GetNumberOfArguments(isFun, call); i++) - { - SgExpression* ar = GetProcedureArgument(isFun, call, i); - CArrayVarEntryInfo* tp = NULL; - if (c == (AnalysedCallsList*)(-1) || c == (AnalysedCallsList*)(-2) || c == NULL || c->graph == NULL || c->isArgIn(i, &tp)) - addExprToUse(ar, tp); - tp = NULL; - if (c == (AnalysedCallsList*)(-1) || c == NULL || c->graph == NULL || c->isArgOut(i, &tp)) - AddOneExpressionToDef(GetProcedureArgument(isFun, call, i), NULL, tp); - } - - if (c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c != NULL && c->graph != NULL) { - for (CommonVarSet* cu = c->graph->getCommonUse(); cu != NULL; cu = cu->next) { - CommonVarInfo* v = cu->cvd; - AnalysedCallsList* tp = start->getProc(); - CommonDataItem* p = v->parent; - if (CommonDataItem* it = pCommons->IsThisCommonUsedInProcedure(p, tp)) { - if (pCommons->CanHaveNonScalarVars(it)) - continue; - CommonVarInfo* i = it->info; - CommonVarInfo* j = p->info; - while (j != v) { - j = j->next; - if (i) - i = i->next; - else - continue; - } - if (!i) - continue; - SgVarRefExp* var = new SgVarRefExp(i->var->GetSymbol()); - addExprToUse(var); - } - else { - common_use = new CommonVarSet(*cu); - } - } - for (CommonVarSet* cd = c->graph->getCommonDef(); cd != NULL; cd = cd->next) { - CommonVarInfo* v = cd->cvd; - AnalysedCallsList* tp = start->getProc(); - CommonDataItem* p = v->parent; - if (CommonDataItem* it = pCommons->IsThisCommonUsedInProcedure(p, tp)) { - if (pCommons->CanHaveNonScalarVars(it)) - continue; - CommonVarInfo* i = it->info; - CommonVarInfo* j = p->info; - while (j != v) { - j = j->next; - if (i) - i = i->next; - } - if (!i) - continue; - def->addToSet(i->var, NULL); - } - else { - common_def = new CommonVarSet(*cd); - } - } - } - -} - -bool CommonData::CanHaveNonScalarVars(CommonDataItem* item) -{ - for (CommonDataItem* it = list; it != NULL; it = it->next) { - if (it->name == item->name && it->first == item->first && !it->onlyScalars) - return true; - } - bool res = !item->onlyScalars; - //printf("CommonData::CanHaveNonScalarVars: %d\n", res); - return res; -} - -CommonDataItem* CommonData::IsThisCommonUsedInProcedure(CommonDataItem* item, AnalysedCallsList* p) -{ - for (CommonDataItem* it = list; it != NULL; it = it->next) { - if (it->proc == p) { - if (it->name == item->name) - return it; - } - } - return NULL; -} - -void CBasicBlock::setDefAndUse() -{ - ControlFlowItem* p = start; - while (p != NULL && (p == start || !p->isLeader())) - { - if (p->getJump() == NULL) - { - SgStatement* st = p->getStatement(); - SgFunctionCallExp* f = p->getFunctionCall(); - - if (f != NULL) - { - bool add_intr = IsAnIntrinsicSubroutine(f->funName()->identifier()) != NULL; // strcmp(f->funName()->identifier(), "date_and_time") == 0; - bool intr = (isIntrinsicFunctionNameACC(f->funName()->identifier()) || add_intr) && !IsUserFunctionACC(f->funName()); - bool pure = IsPureProcedureACC(f->funName()); - AnalysedCallsList* c = p->getCall(); - if (!intr && !pure && c && c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && !(c->IsIntrinsic())) { - - if (c->header == NULL) { - is_correct = "no header for procedure"; - failed_proc_name = c->funName; - } - else { - //graph_node* oldgn = currentGraphNode; - //graph_node* newgn = GRAPHNODE(f->funName())->file_id; - //currentGraphNode = newgn; - ProcessUserProcedure(true, f, c); - //currentGraphNode = oldgn; - - } - } - else if (c == (AnalysedCallsList*)(-1) || c == (AnalysedCallsList*)(-2)) - ProcessProcedureWithoutBody(true, f, c == (AnalysedCallsList*)(-1)); - else if (intr || (c && c->IsIntrinsic())) { - ProcessIntrinsicProcedure(true, f->numberOfArgs(), f, f->funName()->identifier()); - }else - ProcessProcedureHeader(true, isSgProcHedrStmt(GRAPHNODE(f->funName())->st_header), f, f->funName()->identifier()); - } - - - if (st != NULL) - { - switch (st->variant()) - { - case ASSIGN_STAT: - { - SgAssignStmt* s = isSgAssignStmt(st); - SgExpression* l = s->lhs(); - SgExpression* r = s->rhs(); - addExprToUse(r); - AddOneExpressionToDef(l, st, NULL); - break; - } - case PRINT_STAT: - case WRITE_STAT: - case READ_STAT: - { - SgInputOutputStmt* s = isSgInputOutputStmt(st); - if (s) { - SgExpression* ex = s->itemList(); - while (ex && ex->lhs()) { - if (st->variant() == READ_STAT) { - AddOneExpressionToDef(ex->lhs(), st, NULL); - } - else { - addExprToUse(ex->lhs()); - } - ex = ex->rhs(); - } - } - break; - } - case PROC_STAT: - { - SgCallStmt* f = isSgCallStmt(st); - bool add_intr = IsAnIntrinsicSubroutine(f->name()->identifier()) != NULL; - bool intr = (isIntrinsicFunctionNameACC(f->name()->identifier()) || add_intr) && !IsUserFunctionACC(f->name()); - bool pure = IsPureProcedureACC(f->name()); - if (!intr && !pure) { - AnalysedCallsList* c = p->getCall(); - //graph_node* oldgn = currentGraphNode; - //graph_node* newgn = GRAPHNODE(f->name()); - //currentGraphNode = newgn; - ProcessUserProcedure(false, f, c); - //currentGraphNode = oldgn; - break; - } - if (intr) { - ProcessIntrinsicProcedure(false, f->numberOfArgs(), f, f->name()->identifier()); - break; - } - ProcessProcedureHeader(false, isSgProcHedrStmt(GRAPHNODE(f->name())->st_header), f, f->name()->identifier()); - } - default: - break; - } - } - } - else - addExprToUse(p->getExpression()); - p = p->getNext(); - } -} - -VarSet* CBasicBlock::getDef() -{ - if (def == NULL) - { - def = new VarSet(); - use = new VarSet(); - setDefAndUse(); - } - return def; -} - -VarSet* CBasicBlock::getUse() -{ - if (use == NULL) - { - use = new VarSet(); - def = new VarSet(); - setDefAndUse(); - } - return use; -} - -#ifdef __SPF -template -const vector getAttributes(IN_TYPE st, const set dataType); -#endif - -DoLoopDataItem* DoLoopDataList::FindLoop(SgStatement* st) -{ - DoLoopDataItem* it = list; - while (it != NULL) { - if (it->statement == st) - return it; - it = it->next; - } - return NULL; -} - -bool GetExpressionAndCoefficientOfBound(SgExpression* exp, SgExpression** end, int* coef) -{ - if (exp->variant() == SUBT_OP) { - if (exp->rhs() && exp->rhs()->variant() == INT_VAL) { - *end = exp->lhs(); - *coef = -exp->rhs()->valueInteger(); - return true; - } - } - if (exp->variant() == ADD_OP) { - if (exp->lhs() && exp->lhs()->variant() == INT_VAL) { - *end = exp->rhs(); - *coef = exp->lhs()->valueInteger(); - return true; - } - if (exp->rhs() && exp->rhs()->variant() == INT_VAL) { - *end = exp->lhs(); - *coef = exp->lhs()->valueInteger(); - return true; - } - } - return false; -} - -CArrayVarEntryInfo::CArrayVarEntryInfo(SgSymbol* s, SgArrayRefExp* r) : CVarEntryInfo(s) -{ -#if __SPF - addToCollection(__LINE__, __FILE__, this, 16); -#endif - // TODO: need to check all alhorithm!! - disabled = true; - - if (!r) - subscripts = 0; - else - subscripts = r->numberOfSubscripts(); - if (subscripts) - data.resize(subscripts); - - for (int i = 0; i < subscripts; i++) - { - data[i].defined = false; - data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = 0; - data[i].step = 1; - data[i].left_bound = data[i].right_bound = NULL; - data[i].coefs[0] = data[i].coefs[1] = 0; - data[i].loop = NULL; -#if __SPF - const vector coefs = getAttributes(r->subscript(i), set{ INT_VAL }); - const vector fs = getAttributes(r->subscript(i), set{ FOR_NODE }); - if (fs.size() == 1) - { - if (data[i].loop != NULL) - { - if (coefs.size() == 1) - { - data[i].defined = true; - data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = coefs[0][1]; - data[i].coefs[0] = coefs[0][0]; - data[i].coefs[1] = coefs[0][1]; - data[i].step = coefs[0][0]; - int tmp; - - SgExpression *et; - if (GetExpressionAndCoefficientOfBound(data[i].loop->l, &et, &tmp)) - { - data[i].left_bound = et; - data[i].bound_modifiers[0] += tmp; - } - else - data[i].left_bound = data[i].loop->l; - - if (GetExpressionAndCoefficientOfBound(data[i].loop->r, &et, &tmp)) - { - data[i].right_bound = et; - data[i].bound_modifiers[1] += tmp; - } - else - data[i].right_bound = data[i].loop->r; - } - } - } -#endif - if (!data[i].defined) - { - SgExpression* ex = r->subscript(i); - if (ex->variant() == INT_VAL) - { - data[i].bound_modifiers[0] = ex->valueInteger(); - data[i].bound_modifiers[1] = ex->valueInteger(); - data[i].defined = true; - } - else - { - data[i].bound_modifiers[0] = 0; - data[i].bound_modifiers[1] = 0; - data[i].left_bound = data[i].right_bound = ex; - data[i].defined = true; - } - } - } -} - -CArrayVarEntryInfo::CArrayVarEntryInfo(SgSymbol *s, int sub, int ds, const vector &d) - : CVarEntryInfo(s), subscripts(sub), disabled(ds) -{ -#if __SPF - addToCollection(__LINE__, __FILE__, this, 16); -#endif - if (sub > 0) - data = d; -} - -VarItem* VarSet::GetArrayRef(CArrayVarEntryInfo* info) -{ - VarItem* it = list; - while (it != NULL) { - CVarEntryInfo* v = it->var; - if (v->GetVarType() == VAR_REF_ARRAY_EXP) { - if (OriginalSymbol(info->GetSymbol()) == OriginalSymbol(v->GetSymbol())) - return it; - } - it = it->next; - } - return NULL; -} - -void CArrayVarEntryInfo::RegisterUsage(VarSet *def, VarSet *use, SgStatement *st) -{ - VarItem *it = def->GetArrayRef(this); - CArrayVarEntryInfo *add = this; - if (it != NULL) - add = *this - *(CArrayVarEntryInfo*)(it->var); - - if (use != NULL && add != NULL && add->HasActiveElements()) - use->addToSet(add, st); - - if (add != this) - delete add; -} - -CArrayVarEntryInfo& CArrayVarEntryInfo::operator-=(const CArrayVarEntryInfo& b) -{ - if (subscripts == 0) - { - if (b.HasActiveElements()) - disabled = true; - return *this; - } - - if (b.subscripts == 0) - { - if (HasActiveElements()) - MakeInactive(); - return *this; - } - - if (subscripts != b.subscripts || !data.size() || !b.data.size() || !(data[0].defined) || !(b.data[0].defined)) - return *this; - - for (int i = 0; i < subscripts; i++) - { - if (b.data[i].left_bound == NULL) - { - if (data[i].left_bound && data[i].left_bound->variant() == INT_VAL) - { - if (data[i].left_bound->valueInteger() + data[i].bound_modifiers[0] == b.data[i].bound_modifiers[0]) - { - data[i].bound_modifiers[0]++; - continue; - } - } - } - - if (data[i].left_bound == NULL && b.data[i].left_bound == NULL && - data[i].right_bound == NULL && b.data[i].right_bound == NULL) - { - if (data[i].bound_modifiers[0] < b.data[i].bound_modifiers[0]) - { - data[i].bound_modifiers[1] = b.data[i].bound_modifiers[0] - 1; - continue; - } - - if (data[i].bound_modifiers[1] > b.data[i].bound_modifiers[1]) - { - data[i].bound_modifiers[0] = b.data[i].bound_modifiers[1] + 1; - continue; - } - data[i].defined = false; - } - - if (data[i].left_bound == b.data[i].left_bound && data[i].bound_modifiers[0] < b.data[i].bound_modifiers[0]) - { - data[i].bound_modifiers[0] = data[i].bound_modifiers[0]; - data[i].bound_modifiers[1] = b.data[i].bound_modifiers[0] - 1; - data[i].right_bound = data[i].left_bound; - } - - if (data[i].right_bound == b.data[i].right_bound && data[i].bound_modifiers[1] > b.data[i].bound_modifiers[1]) - { - data[i].bound_modifiers[0] = b.data[i].bound_modifiers[1] + 1; - data[i].bound_modifiers[1] = data[i].bound_modifiers[1]; - data[i].left_bound = data[i].right_bound; - } - - if (b.data[i].left_bound == NULL && b.data[i].right_bound == NULL && - (data[i].left_bound != NULL || data[i].right_bound != NULL)) - continue; - else - { - data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = 0; - data[i].left_bound = NULL; - data[i].right_bound = NULL; - data[i].defined = false; - //empty set - } - } - return *this; -} - -CArrayVarEntryInfo* operator-(const CArrayVarEntryInfo& a, const CArrayVarEntryInfo& b) -{ - //return NULL; - CArrayVarEntryInfo* nv = (CArrayVarEntryInfo*)a.Clone(); - *nv -= b; - return nv; -} - -CArrayVarEntryInfo* operator+(const CArrayVarEntryInfo& a, const CArrayVarEntryInfo& b) -{ - CArrayVarEntryInfo* nv = (CArrayVarEntryInfo*)a.Clone(); - *nv += b; - return nv; -} - -void CArrayVarEntryInfo::RegisterDefinition(VarSet* def, VarSet* use, SgStatement* st) -{ - def->addToSet(this, st); - use->PossiblyAffectArrayEntry(this); -} - -void VarSet::PossiblyAffectArrayEntry(CArrayVarEntryInfo* var) -{ - VarItem* it = GetArrayRef(var); - if (!it) - return; - ((CArrayVarEntryInfo*)(it->var))->ProcessChangesToUsedEntry(var); -} - -void CArrayVarEntryInfo::ProcessChangesToUsedEntry(CArrayVarEntryInfo* var) -{ - if (disabled || var->disabled || subscripts != var->subscripts) - return; - for (int i = 0; i < subscripts; i++) - { - if (!data[i].defined) - continue; - - if (data[i].loop == var->data[i].loop && data[i].loop != NULL) - { - if (data[i].coefs[0] == var->data[i].coefs[0]) - { - if (data[i].coefs[1] < var->data[i].coefs[1]) - { - if (data[i].left_bound && data[i].left_bound->variant() == INT_VAL) - { - data[i].bound_modifiers[0] = data[i].left_bound->valueInteger() + data[i].bound_modifiers[0]; - data[i].bound_modifiers[1] = data[i].left_bound->valueInteger() + var->data[i].coefs[1] - 1; - data[i].left_bound = data[i].right_bound = NULL; - } - else - { - //maybe add something, not sure - } - } - } - } - } -} - -CArrayVarEntryInfo& CArrayVarEntryInfo::operator*=(const CArrayVarEntryInfo& b) -{ - if (subscripts == 0) - { - if (b.HasActiveElements()) - disabled = true; - return *this; - } - - if (b.subscripts == 0) - { - if (HasActiveElements()) - MakeInactive(); - return *this; - } - - //return *this; - if (subscripts != b.subscripts || subscripts == 0 || b.subscripts == 0 || !data.size() || !b.data.size() || !(data[0].defined) || !(b.data[0].defined)) - return *this; - - for (int i = 0; i < subscripts; i++) - { - if (b.disabled) - data[i].left_bound = data[i].right_bound = NULL; - - if (data[i].left_bound == b.data[i].left_bound) - data[i].bound_modifiers[0] = std::max(data[i].bound_modifiers[0], b.data[i].bound_modifiers[0]); - - if (data[i].right_bound == b.data[i].right_bound) - data[i].bound_modifiers[1] = std::min(data[i].bound_modifiers[1], b.data[i].bound_modifiers[1]); - } - return *this; -} - -CArrayVarEntryInfo& CArrayVarEntryInfo::operator+=(const CArrayVarEntryInfo& b) -{ - if (subscripts == 0) - { - if (b.HasActiveElements()) - disabled = true; - return *this; - } - - if (b.subscripts == 0) - { - if (HasActiveElements()) - MakeInactive(); - return *this; - } - - //return *this; - if (disabled && !b.disabled && b.data.size()) - { - for (int i = 0; i < subscripts; i++) - data[i] = b.data[i]; - disabled = false; - return *this; - } - - if (subscripts != b.subscripts || subscripts == 0 || b.subscripts == 0 || !data.size() || !b.data.size() || disabled || b.disabled) - return *this; - - for (int i = 0; i < subscripts; i++) - { - - if (data[i].left_bound == b.data[i].left_bound) - data[i].bound_modifiers[0] = std::min(data[i].bound_modifiers[0], b.data[i].bound_modifiers[0]); - - if (data[i].right_bound == b.data[i].right_bound) - data[i].bound_modifiers[1] = std::max(data[i].bound_modifiers[1], b.data[i].bound_modifiers[1]); - - if (data[i].left_bound == NULL && data[i].right_bound == NULL && (b.data[i].left_bound != NULL || b.data[i].right_bound != NULL)) - { - const ArraySubscriptData &tmp = data[i]; - data[i] = b.data[i]; - if (data[i].left_bound && data[i].left_bound->variant() == INT_VAL) - { - if (tmp.bound_modifiers[1] == data[i].left_bound->valueInteger() + data[i].bound_modifiers[0] - 1) - data[i].bound_modifiers[0] -= (1 + tmp.bound_modifiers[1] - tmp.bound_modifiers[0]); - - } - - if (data[i].right_bound && data[i].right_bound->variant() == INT_VAL) - { - if (tmp.bound_modifiers[0] == data[i].left_bound->valueInteger() + data[i].bound_modifiers[1] + 1) - data[i].bound_modifiers[1] += (1 + tmp.bound_modifiers[1] - tmp.bound_modifiers[0]); - } - } - } - return *this; -} - -void VarSet::RemoveDoubtfulCommonVars(AnalysedCallsList* call) -{ - VarItem* it = list; - VarItem* prev = NULL; - while (it != NULL) { - CommonDataItem* d = pCommons->IsThisCommonVar(it, call); - if (d && pCommons->CanHaveNonScalarVars(d)) { - if (prev == NULL) { - it = it->next; - delete list; - list = it; - } - else { - prev->next = it->next; - delete it; - it = prev->next; - } - continue; - } - prev = it; - it = it->next; - } -} - -int VarSet::count() -{ - VarItem* it = list; - int t = 0; - while (it != NULL) { - it = it->next; - t++; - } - return t; -} - -void VarSet::LeaveOnlyRecords() -{ - VarItem* p = list; - VarItem* prev = NULL; - while (p != NULL) { - if (p->var->GetVarType() == VAR_REF_RECORD_EXP) { - CVarEntryInfo* rrec = p->var->GetLeftmostParent(); - CVarEntryInfo* old = p->var; - if (old->RemoveReference()) - delete old; - if (!belongs(rrec)) { - p->var = rrec; - prev = p; - } - else { - if (prev == NULL) - list = list->next; - else - { - prev->next = p->next; - delete(p); - p = prev; - } - } - } - else { - prev = p; - } - p = p->next; - } -} - -VarItem* VarSet::belongs(const CVarEntryInfo* var, bool os) -{ - VarItem* l = list; - while (l != NULL) - { - if ((*l->var == *var)) - return l; - if (os && OriginalSymbol(l->var->GetSymbol()) == OriginalSymbol(var->GetSymbol())) - return l; - l = l->next; - } - return NULL; -} - -VarItem* VarSet::belongs(SgSymbol* s, bool os) -{ - VarItem* l = list; - while (l != NULL) - { - if ((l->var->GetSymbol() == s)) - if (l->var->GetVarType() == VAR_REF_ARRAY_EXP) - return ((CArrayVarEntryInfo*)(l->var))->HasActiveElements() ? l : NULL; - return l; - if (os && OriginalSymbol(l->var->GetSymbol()) == OriginalSymbol(s)) - return l; - l = l->next; - } - return NULL; -} - -/* -VarItem* VarSet::belongs(SgVarRefExp* var, bool os) -{ - return belongs(var->symbol(), os); -} -*/ - -bool VarSet::equal(VarSet* p2) -{ - if (p2 == NULL) - return false; - VarItem* p = list; - VarItem* prev = NULL; - while (p != NULL) - { - if (!p2->belongs(p->var) && (p->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(p->var))->HasActiveElements())) - return false; - p = p->next; - } - p = p2->list; - while (p != NULL) { - if (!belongs(p->var) && (p->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(p->var))->HasActiveElements())) - return false; - p = p->next; - } - return true; -} - -void VarSet::print() -{ - VarItem* l = list; - while (l != NULL) - { - if (l->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(l->var))->HasActiveElements()) - printf("%s ", l->var->GetSymbol()->identifier()); -#if PRIVATE_GET_LAST_ASSIGN - printf("last assignments: %d\n", l->lastAssignments.size()); - for (list::iterator it = l->lastAssignments.begin(); it != l->lastAssignments.end(); it++){ - if (*it) - printf("%s", (*it)->unparse()); - } -#endif - l = l->next; - } - putchar('\n'); -} - -void VarSet::addToSet(CVarEntryInfo* var, SgStatement* source, CVarEntryInfo* ov) -{ - bool add = false; - if (var->GetVarType() != VAR_REF_ARRAY_EXP) { - VarItem* p = belongs(var, false); - add = p == NULL; -#if PRIVATE_GET_LAST_ASSIGN - p->lastAssignments.clear(); - p->lastAssignments.push_back(source); -#endif - //delete p->lastAssignments; - //p->lastAssignments = new CLAStatementItem(); - //p->lastAssignments->stmt = source; - //p->lastAssignments->next = NULL; - } - else { - CArrayVarEntryInfo* av = (CArrayVarEntryInfo*)var; - VarItem* p = GetArrayRef(av); - if (p == NULL) - add = true; - else { - CArrayVarEntryInfo* fv = (CArrayVarEntryInfo*)p->var; - *fv += *av; - } - } - if (add) { - VarItem* p = new VarItem(); - p->var = var->Clone(); - p->ov = ov; - p->next = list; - p->file_id = current_file_id; - list = p; - } -} - -void VarSet::intersect(VarSet* set, bool la, bool array_mode = false) -{ - VarItem* p = list; - VarItem* prev = NULL; - while (p != NULL) - { - VarItem* n = set->belongs(p->var); - if (!n) - { - if (!array_mode || p->var->GetVarType() == VAR_REF_VAR_EXP) { - if (prev == NULL) - list = list->next; - else - { - prev->next = p->next; - delete(p); - p = prev; - } - } - } - else { -#if PRIVATE_GET_LAST_ASSIGN - if (la) - p->lastAssignments.insert(p->lastAssignments.end(), n->lastAssignments.begin(), n->lastAssignments.end()); -#endif - if (p->var->GetVarType() == VAR_REF_ARRAY_EXP) { - if (!array_mode) - *(CArrayVarEntryInfo*)(p->var) *= *(CArrayVarEntryInfo*)(n->var); - else - *(CArrayVarEntryInfo*)(p->var) += *(CArrayVarEntryInfo*)(n->var); - } - prev = p; - } - p = p->next; - } - -} - -VarItem* VarSet::getFirst() -{ - return list; -} - -void VarSet::remove(const CVarEntryInfo* var) -{ - VarItem* p = list; - VarItem* prev = NULL; - while (p != NULL) - { - if (var == (p->var)) - { - if (prev == NULL) { - VarItem* t = list; - list = list->next; - delete(t); - p = list; - - } - else - { - prev->next = p->next; - delete(p); - p = prev->next; - } - } - else { - prev = p; - p = p->next; - } - } -} - -void VarSet::minus(VarSet* set, bool complete) -{ - VarItem* p = list; - VarItem* prev = NULL; - while (p != NULL) - { - VarItem* d = set->belongs(p->var); - if (d && (p->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(d->var))->HasActiveElements())) - { - if (p->var->GetVarType() == VAR_REF_ARRAY_EXP && !complete) { - *(CArrayVarEntryInfo*)(p->var) -= *(CArrayVarEntryInfo*)(d->var); - prev = p; - } - else if (prev == NULL) - list = list->next; - else - { - prev->next = p->next; - delete(p); - p = prev; - } - } - else - prev = p; - - p = p->next; - } -} - -bool VarSet::RecordBelong(CVarEntryInfo* rec) -{ - if (rec->GetVarType() != VAR_REF_RECORD_EXP) - return false; - CRecordVarEntryInfo* rrec = static_cast(rec); - CVarEntryInfo* lm = rrec->GetLeftmostParent(); - VarItem* p = list; - while (p != NULL) { - if (*lm == *(p->var->GetLeftmostParent())) - return true; - p = p->next; - } - return false; -} - -void VarSet::minusFinalize(VarSet* set, bool complete) -{ - minus(set, complete); - VarItem* p = list; - VarItem* prev = NULL; - while (p != NULL) - { - if (set->RecordBelong(p->var)) { - { - if (prev == NULL) - list = list->next; - else - { - prev->next = p->next; - delete(p); - p = prev; - } - } - } - else - prev = p; - - p = p->next; - } -} - -unsigned int counter = 0; - -CLAStatementItem::~CLAStatementItem() -{ -#if __SPF - removeFromCollection(this); -#endif - if (next) - delete next; -} - -CLAStatementItem* CLAStatementItem::GetLast() -{ - if (next == NULL) - return this; - return next->GetLast(); -} - -void VarSet::unite(VarSet* set, bool la) -{ - VarItem* arg2 = set->list; - while (arg2 != NULL) - { - VarItem* n = belongs(arg2->var); - if (!n) - { - n = new VarItem(); - if (arg2->var->GetVarType() == VAR_REF_ARRAY_EXP) - n->var = arg2->var->Clone(); - else { - n->var = arg2->var; - n->var->AddReference(); - } - n->ov = arg2->ov; - n->next = list; - n->file_id = arg2->file_id; -#if PRIVATE_GET_LAST_ASSIGN - if (la) - n->lastAssignments = arg2->lastAssignments; -#endif - list = n; - } - else { -#if PRIVATE_GET_LAST_ASSIGN - if (la) { - //n->lastAssignments.insert(n->lastAssignments.end(), arg2->lastAssignments.begin(), arg2->lastAssignments.end()); - //n->lastAssignments.splice(n->lastAssignments.end(), arg2->lastAssignments); - //n->lastAssignments->GetLast()->next = arg2->lastAssignments; - n->lastAssignments = arg2->lastAssignments; - } -#endif - //counter++; - //if (counter % 100 == 0) - //printf("%d!\n", counter); - if (n->var->GetVarType() == VAR_REF_ARRAY_EXP) { - *(CArrayVarEntryInfo*)(n->var) += *(CArrayVarEntryInfo*)(arg2->var); - } - } - arg2 = arg2->next; - } -} - - - -void CBasicBlock::addToPrev(CBasicBlock* bb, bool for_jump_flag, bool c, ControlFlowItem* check) -{ - BasicBlockItem* n = new BasicBlockItem(); - n->block = bb; - n->next = prev; - n->for_jump_flag = for_jump_flag; - n->cond_value = c; - n->jmp = check; - prev = n; -} - -void CBasicBlock::addToSucc(CBasicBlock* bb, bool for_jump_flag, bool c, ControlFlowItem* check) -{ - BasicBlockItem* n = new BasicBlockItem(); - n->block = bb; - n->for_jump_flag = for_jump_flag; - n->next = succ; - n->cond_value = c; - n->jmp = check; - succ = n; -} - -#if ACCAN_DEBUG - -void ControlFlowItem::printDebugInfo() -{ - if (jmp == NULL && stmt == NULL && func != NULL) - printf("FUNCTION CALL: %s\n", func->unparse()); - if (jmp == NULL) - if (stmt != NULL) - if (label != NULL) - printf("%d: %s %s %s lab %4d %s", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id(), stmt->unparse()); - else - printf("%d: %s %s %s %s", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", stmt->unparse()); - else - if (label != NULL) - printf("%d: %s %s %s lab %4d \n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id()); - else - printf("%d: %s %s %s \n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " "); - else - if (expr == NULL) - if (label != NULL) - printf("%d: %s %s %s lab %4d goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id(), jmp->getStmtNo()); - else - printf("%d: %s %s %s goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", jmp->getStmtNo()); - else - if (label != NULL) - printf("%d: %s %s %s lab %4d if %s goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id(), expr->unparse(), jmp->getStmtNo()); - else - printf("%d: %s %s %s if %s goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", expr->unparse(), jmp->getStmtNo()); -} - -static void printControlFlowList(ControlFlowItem* list, ControlFlowItem* last) -{ - - printf("DEBUG PRINT START\n"); - unsigned int stmtNo = 0; - ControlFlowItem* list_copy = list; - while (list != NULL ) - { - list->setStmtNo(++stmtNo); - if (list == last) - break; - list = list->getNext(); - } - - list = list_copy; - while (list != NULL) - { - list->printDebugInfo(); - if (list == last) - break; - list = list->getNext(); - } - printf("DEBUG PRINT END\n\n"); -} -#endif - -void CallData::printControlFlows() -{ -#if ACCAN_DEBUG - AnalysedCallsList* l = calls_list; - while (l != NULL) { - if (!l->isIntrinsic && l->graph != NULL && l->header != NULL) { - ControlFlowGraph* g = l->graph; - SgStatement* h = l->header; - printf("CFI for %s\n\n" ,h->symbol()->identifier()); - if (g != NULL) { - printControlFlowList(g->getCFI()); - } - else - printf("ERROR: DOES NOT HAVE CFI\n"); - } - l = l->next; - } -#endif -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_data.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_data.cpp deleted file mode 100644 index b4d0b4c..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_data.cpp +++ /dev/null @@ -1,47 +0,0 @@ -#include "leak_detector.h" - -#include "acc_data.h" - -// global data for ACC files - -bool READ = false; -bool WRITE = true; -bool dontGenConvertXY = false; -bool oneCase = false; -int ACROSS_MOD_IN_KERNEL = 0; -int DVM_DEBUG_LVL = 0; -const int rtTypes[] = { rt_INT, rt_LLONG }; - -std::set intrinsicF; -std::set intrinsicDoubleT; -std::set intrinsicFloatT; -std::set intrinsicInt4T; - -std::map SpecialSymbols; -std::vector RTC_FCall; -std::vector RTC_FArgs; -std::vector RTC_FKernelArgs; -std::vector newVars; -std::stack CopyOfBody; - -const char *funcDvmhConvXYname = "dvmh_convert_XY"; -Loop *currentLoop = NULL; -unsigned countKernels = 2; - -int number_of_loop_line = 0; // for TRACE in acc_f2c.cpp -SgSymbol *s_indexType_int = NULL, *s_indexType_long = NULL, *s_indexType_llong = NULL; -SgType *indexType_int = NULL, *indexType_long = NULL, *indexType_llong = NULL; - -const char *declaration_cmnt; -int loc_el_num; -SgStatement *cur_in_mod, *cur_in_kernel; -SgStatement *dvm_parallel_dir, *loop_body; -SgStatement *kernel_st; -SgExpression *private_list, *uses_list, *kernel_index_var_list, *formal_red_grid_list; -SgSymbol *kernel_symb, *s_overall_blocks; -SgType *t_dim3; -SgSymbol *s_threadidx, *s_blockidx, *s_blockdim, *s_griddim, *s_blocks_k; - -//------ C ---------- -SgStatement *block_C, *block_C_Cuda, *info_block; -SgSymbol *s_DvmhLoopRef, *s_cudaStream, *s_cmplx, *s_dcmplx; diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c.cpp deleted file mode 100644 index e64fd5f..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c.cpp +++ /dev/null @@ -1,3584 +0,0 @@ -#include "dvm.h" -#include "calls.h" - -using std::map; -using std::string; -using std::vector; -using std::pair; -using std::set; -using std::stack; -using std::deque; -using std::make_pair; - -#define TRACE 0 - -// for non linear array list -struct PrivateArrayInfo -{ - string name; - int dimSize; - vector correctExp; - int typeRed; - reduction_operation_list *rsl; -}; - -struct FunctionParam -{ - const char *name; - int numParam; - void(*handler) (SgExpression*, SgExpression *&, const char*, int); - - FunctionParam() - { - name = NULL; - numParam = 0; - handler = NULL; - } - - FunctionParam(const char *name_, const int numParam_, void(*handler_) (SgExpression*, SgExpression *&, const char*, int)) - { - name = name_; - numParam = numParam_; - handler = handler_; - } - - void CallHandler(SgExpression *expr, SgExpression *&retExpr) - { - handler(expr, retExpr, name, numParam); - } -}; - -//global -map > > interfaceProcedures; - -// extern -extern SgStatement *first_do_par; -extern SgExpression *private_list; -extern reduction_operation_list *red_struct_list; -extern SgExpression *dvm_array_list; -extern graph_node *node_list; - -// extern from acc_f2c_handlers.cpp -extern void __convert_args(SgExpression *, SgExpression *&, SgExpression *&); -extern void __cmplx_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __minmax_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __mod_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __iand_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __ior_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __ieor_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __arc_sincostan_d_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __atan2d_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __sindcosdtand_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __cotan_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __cotand_handler(SgExpression *, SgExpression *&, const char *name, int); -extern void __ishftc_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); -extern void __merge_bits_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); -extern void __not_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); -extern void __poppar_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); -extern void __modulo_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); - -// local -static map handlersOfFunction; -static set supportedVars; -static map fTableOfSymbols; -static vector arrayInfo; -static set labels_num; -static map > labelsExitCycle; -static set unSupportedVars; -static int cond_generator; -static SgStatement* curTranslateStmt; -static map autoTfmReplacing; - -static map > insertBefore; -static map > insertAfter; - -static map replaced; -static int arrayGenNum; -static int SAPFOR_CONV = 0; - -#if TRACE -static int lvl_convert_st = 0; -#endif - -// functions -void convertExpr(SgExpression*, SgExpression*&); -void createNewFCall(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs); -static bool isPrivate(const string& array); - -#if TRACE -void printfSpaces(int num) -{ - for (int i = 0; i < num; ++i) - printf(" "); -} -#endif - -static void saveInsertBeforeAfter(map > &after, map > &before) -{ - if (!options.isOn(AUTO_TFM)) - return; - - before = insertBefore; - insertBefore.clear(); - - after = insertAfter; - insertAfter.clear(); -} - -static void restoreInsertBeforeAfter(map >& after, map >& before) -{ - if (!options.isOn(AUTO_TFM)) - return; - - insertBefore = before; - insertAfter = after; -} - -static void copyToStack(stack &newBody, const map > &cont) -{ - if (!options.isOn(AUTO_TFM)) - return; - - if (cont.size()) - for (map >::const_iterator itI = cont.begin(); itI != cont.end(); itI++) - for (int z = 0; z < itI->second.size(); ++z) - newBody.push(itI->second[z]); -} - -static bool isInPrivate(const string& arr) -{ - for (int z = 0; z < arrayInfo.size(); ++z) - { - if (arrayInfo[z].name == arr) - return true; - } - return false; -} - -static char* getNestCond() -{ - char buf[32]; - buf[0] = '\0'; - sprintf(buf, "%d", cond_generator); - cond_generator++; - char *str = new char[strlen("cond_") + strlen(buf) + 2]; - str[0] = '\0'; - strcat(str, "cond_"); - strcat(str, buf); - return str; -} - -static char* getNewCycleVar(const char *oldVar) -{ - char *str = new char[strlen(oldVar) + 3]; - str[0] = '\0'; - strcat(str, "__"); - strcat(str, oldVar); - return str; -} - -static bool inNewVars(const char *name) -{ - bool ret = false; - for (size_t i = 0; i < newVars.size(); ++i) - { - if (strcmp(name, newVars[i]->identifier()) == 0) - { - ret = true; - break; - } - } - return ret; -} - -static bool isNullSubscripts(SgExpression *subs) -{ - if (subs && subs->attributeValue(0, NULL_SUBSCRIPTS)) - return true; - else - return false; -} - -static void addInListIfNeed(SgSymbol *tmp, int type, reduction_operation_list *tmpR) -{ - stack allArraySub; - stack > allArraySubConv; - if (tmp) - { - if (isSgArrayType(tmp->type())) - { - if (isSgArrayType(tmp->type())->dimension() > 0) - { - SgExpression *dimList = isSgArrayType(tmp->type())->getDimList(); - PrivateArrayInfo t; - t.dimSize = isSgArrayType(tmp->type())->dimension(); - - int rank = 0; - while (dimList) - { - allArraySub.push(dimList->lhs()); - allArraySubConv.push(make_pair(LowerShiftForArrays(tmp, rank, type), UpperShiftForArrays(tmp, rank))); - ++rank; - dimList = dimList->rhs(); - } - - dimList = isSgArrayType(tmp->type())->getDimList(); - rank = 0; - - while (dimList) - { - SgExpression *ex = allArraySub.top(); - bool ddot = false; - if (ex->variant() == DDOT && ex->lhs() || IS_ALLOCATABLE(tmp)) - ddot = true; - t.correctExp.push_back(LowerShiftForArrays(tmp, rank, type)); - - // swap array's dimentionss - if (inNewVars(tmp->identifier())) - { - if (ddot) - dimList->setLhs(*allArraySubConv.top().second - *allArraySubConv.top().first + *new SgValueExp(1)); - else - dimList->setLhs(allArraySubConv.top().first); - } - - allArraySub.pop(); - allArraySubConv.pop(); - ++rank; - dimList = dimList->rhs(); - } - t.name = tmp->identifier(); - // 0 for private, 1 for loc and redudction variables - t.typeRed = type; - t.rsl = tmpR; - arrayInfo.push_back(t); - } - } - } -} - -static void addRandStateIfNeeded(const string& name) -{ - SgExpression* list = private_list; - while (list) - { - if (list->lhs()->symbol()->identifier() == name) - return; - list = list->rhs(); - } - - SgSymbol* uint4_t = new SgSymbol(TYPE_NAME, "uint4", *(current_file->firstStatement())); - - SgFieldSymb* sx = new SgFieldSymb("x", *SgTypeInt(), *uint4_t); - SgFieldSymb* sy = new SgFieldSymb("y", *SgTypeInt(), *uint4_t); - SgFieldSymb* sz = new SgFieldSymb("z", *SgTypeInt(), *uint4_t); - SgFieldSymb* sw = new SgFieldSymb("w", *SgTypeInt(), *uint4_t); - - SYMB_NEXT_FIELD(sx->thesymb) = sy->thesymb; - SYMB_NEXT_FIELD(sy->thesymb) = sz->thesymb; - SYMB_NEXT_FIELD(sz->thesymb) = sw->thesymb; - SYMB_NEXT_FIELD(sw->thesymb) = NULL; - - SgType* tstr = new SgType(T_STRUCT); - TYPE_COLL_FIRST_FIELD(tstr->thetype) = sx->thesymb; - uint4_t->setType(tstr); - - SgType* td = new SgType(T_DERIVED_TYPE); - TYPE_SYMB_DERIVE(td->thetype) = uint4_t->thesymb; - TYPE_SYMB(td->thetype) = uint4_t->thesymb; - - newVars.push_back(new SgSymbol(VARIABLE_NAME, name.c_str(), td, mod_gpu)); - SgExprListExp* e = new SgExprListExp(*new SgVarRefExp(newVars.back())); - e->setRhs(private_list); - private_list = e; -} - -void swapDimentionsInprivateList(SgExpression *pList) -{ - private_list = pList; - red_struct_list = NULL; - swapDimentionsInprivateList(); - private_list = NULL; -} - -void swapDimentionsInprivateList() -{ - SgExpression *tmp = private_list; - arrayInfo.clear(); - - while (tmp) - { - addInListIfNeed(tmp->lhs()->symbol(), 0, NULL); - tmp = tmp->rhs(); - } - - reduction_operation_list *tmpR = red_struct_list; - while (tmpR) - { - SgSymbol *tmp = NULL; - tmp = tmpR->locvar; - addInListIfNeed(tmp, 1, tmpR); - - tmp = tmpR->redvar; - addInListIfNeed(tmp, 1, tmpR); - - tmpR = tmpR->next; - } -} - -//return 'true' if simple operator, 'false' - complex operator -static bool checkLastNode(int var) -{ - bool ret = true; - if (var == FOR_NODE) - ret = false; - else if (var == WHILE_NODE) - ret = false; - else if (var == SWITCH_NODE) - ret = false; - /*else if (var == LOGIF_NODE) - ret = false; - else if (var == ARITHIF_NODE) - ret = false;*/ - else if (var == IF_NODE) - ret = false; - - return ret; -} - -static void setControlLexNext(SgStatement* ¤tSt) -{ - SgStatement *tmp = currentSt; - if (tmp->variant() == IF_NODE) - { - SgStatement *last = tmp->lastNodeOfStmt(); - if (((SgIfStmt*)tmp)->falseBody()) - { - last = ((SgIfStmt*)tmp)->falseBody(); - for (;;) - { - if (last->variant() == ELSEIF_NODE) - { - if (((SgIfStmt*)last)->falseBody()) - last = ((SgIfStmt*)last)->falseBody(); - else - { - last = last->lastNodeOfStmt(); - break; - } - } - else - { - last = last->controlParent()->lastNodeOfStmt(); - break; - } - } - } - else - last = tmp->lastNodeOfStmt(); - - currentSt = last->lexNext(); - } - else if (tmp->variant() == FOR_NODE || tmp->variant() == WHILE_NODE || tmp->variant() == SWITCH_NODE) - { - if (checkLastNode(currentSt->lastNodeOfStmt()->variant()) == false) - { - currentSt = currentSt->lastNodeOfStmt(); - setControlLexNext(currentSt); - } - else - currentSt = currentSt->lastNodeOfStmt()->lexNext(); - } - else if (tmp->variant() == LOGIF_NODE || tmp->variant() == ARITHIF_NODE) - currentSt = ((SgIfStmt*)tmp)->lastNodeOfStmt()->lexNext(); - else - { - //if (tmp->variant() != ASSIGN_STAT && tmp->variant() != CONT_STAT && tmp->variant() != GOTO_NODE) - // printf(" [WARNING: acc_f2c.cpp, line %d] lexNext of %s variant.\n", __LINE__, tag[tmp->variant()]); - currentSt = currentSt->lexNext(); - } -} - -// create lables for EXIT and CYCLE statemets -static void createNewLabel(vector &labSt, vector &lab, const char *name) -{ - char *str_cont = new char[64]; - str_cont[0] = '\0'; - strcat(str_cont, "label_cycle_"); - strcat(str_cont, name); - - if (labelsExitCycle.find(str_cont) != labelsExitCycle.end()) - lab = labelsExitCycle[str_cont]; - else - { - SgLabel *lab_cont = GetLabel(); - SgSymbol *symb_cont = new SgSymbol(LABEL_NAME, str_cont); - LABEL_SYMB(lab_cont->thelabel) = symb_cont->thesymb; - - char *str_exit = new char[64]; - str_exit[0] = '\0'; - strcat(str_exit, "label_exit_"); - strcat(str_exit, name); - - SgLabel *lab_exit = GetLabel(); - SgSymbol *symb_exit = new SgSymbol(LABEL_NAME, str_exit); - LABEL_SYMB(lab_exit->thelabel) = symb_exit->thesymb; - - lab.push_back(lab_cont); - lab.push_back(lab_exit); - - labelsExitCycle[string(str_cont)] = lab; - } - SgStatement *cycleSt = new SgStatement(LABEL_STAT); - BIF_LABEL_USE(cycleSt->thebif) = lab[0]->thelabel; - - SgStatement *exitSt = new SgStatement(LABEL_STAT); - BIF_LABEL_USE(exitSt->thebif) = lab[1]->thelabel; - - labSt.push_back(cycleSt); - labSt.push_back(exitSt); -} - -static void createNewLabel(SgStatement* &labSt, SgLabel *lab) -{ - SgSymbol *symb; - int labDigit = (int)(lab->thelabel->stateno); - - char *str = new char[32]; - char *digit = new char[32]; - str[0] = digit[0] = '\0'; - strcat(str, "label_"); - sprintf(digit, "%d", labDigit); - strcat(str, digit); - - symb = new SgSymbol(LABEL_NAME, str); - LABEL_SYMB(lab->thelabel) = symb->thesymb; - labSt = new SgStatement(LABEL_STAT); - BIF_LABEL_USE(labSt->thebif) = lab->thelabel; -} - -static void convertLabel(SgStatement *st, SgStatement * &ins, bool ret) -{ - SgLabel *lab = st->label(); - SgStatement *labSt = NULL; - createNewLabel(labSt, lab); - - if (ret) - ins = labSt; - else - st->insertStmtBefore(*labSt, *st->controlParent()); -} - -SgStatement* getInterfaceForCall(SgSymbol* s) -{ - SgStatement* searchStmt = cur_func->lexNext(); - SgStatement* tmp; - string funcName = string(s->identifier()); - enum {SEARCH_INTERFACE,CHECK_INTERFACE, FIND_NAME, SEARCH_INTERNAL,SEARCH_CONTAINS,UNSUCCESS}; - int mode = SEARCH_CONTAINS; - - //search internal function - while(searchStmt&& mode!=UNSUCCESS) - { - switch(mode) - { - case SEARCH_CONTAINS: - if(searchStmt->variant() == CONTAINS_STMT) - mode = SEARCH_INTERNAL; - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - break; - case SEARCH_INTERNAL: - if(searchStmt->variant() == CONTROL_END) - mode = UNSUCCESS; - else if(string(searchStmt->symbol()->identifier()) == funcName) - return searchStmt; - else - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - break; - } - } - searchStmt = cur_func->lexNext(); - mode = SEARCH_INTERFACE; - //search interface in declare section - while(searchStmt && !isSgExecutableStatement(searchStmt) ) - { - switch(mode) - { - case SEARCH_INTERFACE: - if(searchStmt->variant() != INTERFACE_STMT) - searchStmt = searchStmt->lexNext(); - else - mode = CHECK_INTERFACE; - break; - case CHECK_INTERFACE: - if(searchStmt->symbol()&& string(searchStmt->symbol()->identifier()) != funcName) - { - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - mode = SEARCH_INTERFACE; - } - else - { - mode = FIND_NAME; - searchStmt = searchStmt->lexNext(); - } - break; - case FIND_NAME: - if(searchStmt->variant() == FUNC_HEDR || searchStmt->variant() == PROC_HEDR) - { - if(string(searchStmt->symbol()->identifier()) == funcName) - return searchStmt; - else - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - } - else if(searchStmt->variant() == MODULE_PROC_STMT) - { - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - } - else if(searchStmt->variant() == CONTROL_END) - { - mode = SEARCH_INTERFACE; - searchStmt = searchStmt->lexNext(); - } - break; - } - } - return NULL; -} - -//TODO: to be removed ??!! - -//SgExpression* makePresentExpr(string argName, SgStatement* header) -//{ -// int i = 0; -// while(header&&(header->variant() != FUNC_HEDR && header->variant()!=PROC_HEDR)) -// header = header->controlParent(); -// if(!header) -// { -// printf(" [EXPR ERROR: %s, line %d, user line %d] use PRESENT outside prcodedure or function \"%s\"\n", __FILE__, __LINE__, first_do_par->lineNumber(), "****"); -// return NULL; -// } -// SgExpression* args = header->expr(0)->lhs(); -// while(args) -// if(string(args->lhs()->symbol()->identifier()) == argName) -// { -// SgExpression* presentExpr = &(*(new SgVarRefExp(header->expr(0)->lhs()->lhs()->symbol()) ) & *new SgExprListExp( *new SgValueExp(1) << *(new SgValueExp(i-1)))); -// return presentExpr; -// } -// else -// { -// args = args->rhs(); -// i++; -// } -// return NULL; -// -//} - -SgExpression* switchArgumentsByKeyword(const string& name, SgExpression* funcCall, SgStatement* funcInterface) -{ - //get list of arguments names - vector listArgsNames; - SgFunctionSymb* s = (SgFunctionSymb*)funcInterface->symbol(); - vector resultExprCall(s->numberOfParameters(), (SgExpression*)NULL); - int useKeywords = false; - int useOptional = false; - int useArray = false; - - for (int i = 0; i < s->numberOfParameters(); ++i) - { - listArgsNames.push_back(s->parameter(i)->identifier()); - if (s->parameter(i)->attributes() & OPTIONAL_BIT) - useOptional = true; - } - - SgExpression* parseExpr; - if (funcCall->variant() == FUNC_CALL) - parseExpr = funcCall->lhs(); - else - parseExpr = funcCall; - - int curArgumentPos = 0; - while (parseExpr) - { - if (parseExpr->lhs()->variant() == KEYWORD_ARG) - { - useKeywords = true; - int newPos = 0; - string keyword = string(((SgKeywordValExp*)parseExpr->lhs()->lhs())->value()); - while (listArgsNames[newPos] != keyword) - newPos++; - - resultExprCall[newPos] = parseExpr->lhs()->rhs(); - } - else if (useKeywords) - Error("Position argument after keyword", "", 650, first_do_par); - else - resultExprCall[curArgumentPos] = parseExpr->lhs(); - curArgumentPos++; - parseExpr = parseExpr->rhs(); - } - - //check assumed form array - for (int i = 0; i < resultExprCall.size(); ++i) - { - SgSymbol* sarg = s->parameter(i); - if (isSgArrayType(sarg->type())) - { - int needChanged = true; - SgArrayType* arrT = (SgArrayType*)sarg->type(); - int dims = arrT->dimension(); - SgExpression* dimList = arrT->getDimList(); - while (dimList) - { - if (dimList->lhs()->variant() != DDOT) - { - needChanged = false; - break; - } - else if (dimList->lhs()->rhs()) - { - needChanged = false; - break; - } - dimList = dimList->rhs(); - } - - if (needChanged) - { - useArray = true; - - SgArrayType* argType = (SgArrayType*)resultExprCall[i]->symbol()->type(); - SgExprListExp* argInfo = (SgExprListExp*)argType->getDimList(); - SgExpression* tmp; - int argDims = argType->dimension(); - - //TODO: - if (argDims != dims) - { - char buf[256]; - sprintf(buf, "Rank of the %d dummy and actual arguments of '%s' call is not equal", i, name.c_str()); - Error(buf, "", 651, first_do_par); - } - - SgExpression* argList = NULL; - for (int j = MAX_DIMS; j >= 0; --j) - { - if (argInfo->elem(j) == NULL) - continue; - //TODO: not checked!! - if (jsymbol(), j) - *LowerBound(resultExprCall[i]->symbol(), j) + *LowerBound(s->parameter(i), j))); - if (val != NULL) - tmp = new SgExprListExp(*val); - else - tmp = new SgExprListExp(*new SgValueExp(int(0))); - - tmp->setRhs(argList); - argList = tmp; - val = LowerBound(s->parameter(i), j); - if (val != NULL) - tmp = new SgExprListExp(*val); - else - tmp = new SgExprListExp(*new SgValueExp(int(0))); - tmp->setRhs(argList); - argList = tmp; - } - } - if (isPrivate(resultExprCall[i]->symbol()->identifier())) //isPrivateArrayDummy==1 - { - resultExprCall[i] = new SgArrayRefExp(*resultExprCall[i]->symbol()); - } - else - { - SgArrayRefExp* arrRef = new SgArrayRefExp(*resultExprCall[i]->symbol()); - for (int j = 0; j < dims; ++j) - arrRef->addSubscript(*new SgValueExp(0)); - - tmp = new SgExprListExp(SgAddrOp(*arrRef)); - tmp->setRhs(argList); - argList = tmp; - SgSymbol* aa = s->parameter(i); - SgTypeRefExp* typeExpr = new SgTypeRefExp(*C_Type(s->parameter(i)->type())); - resultExprCall[i] = new SgFunctionCallExp(*((new SgDerivedTemplateType(typeExpr, new SgSymbol(TYPE_NAME, "s_array")))->typeName()), *argList); - resultExprCall[i]->setRhs(typeExpr); - } - } - } - } - - //change position in call expression if argument passed by keyword - if (useKeywords || useOptional || useArray) - { - int mask = 0; - SgExpression* maskExpr = new SgValueExp(int(0)); - int bit = 1; - //change arg -> point to arg when arg is optional - for (int i = 0; i < resultExprCall.size() - 1; ++i) - { - SgSymbol* tmps = s->parameter(i); - - //TODO: WTF ???! - if ((s->parameter(i)->attributes() & OPTIONAL_BIT) && resultExprCall[i] != NULL) - { - /*if(resultExprCall[i]->variant() == VAR_REF && resultExprCall[i]->symbol()->attributes()&OPTIONAL_BIT ) - { - SgFunctionSymb* fName = ((SgFunctionSymb *)resultExprCall[i]->symbol()->scope()->symbol()); - int pos = 0; - for(int j = 0; j < fName->numberOfParameters(); ++j) - if(string(fName->parameter(j)->identifier()) == string(resultExprCall[j]->symbol()->identifier())) - { - pos = j; - break; - } - maskExpr = &(*maskExpr | (((*new SgVarRefExp(fName->parameter(0)) >> (*new SgValueExp(pos))) & *new SgValueExp(1)) << *new SgValueExp(i))); - } - else*/ - // maskExpr = Calculate(&(*maskExpr | *new SgValueExp(int(1<parameter(i)->attributes() & OPTIONAL_BIT) && resultExprCall[i] == NULL) - { - SgTypeRefExp* typeExpr = new SgTypeRefExp(*C_Type(s->parameter(i)->type())); - resultExprCall[i] = new SgFunctionCallExp(*((new SgDerivedTemplateType(typeExpr, new SgSymbol(TYPE_NAME, "optArg")))->typeName())); - resultExprCall[i]->setRhs(new SgExprListExp(*typeExpr)); - } - } - - SgExprListExp* expr = new SgExprListExp(); - SgExprListExp* tmp = expr; - SgExprListExp* tmp2; - //insert info-argument at first position - - //insert rguments - for (int i = 0; i < resultExprCall.size() - 1; ++i) - { - tmp->setLhs(resultExprCall[i]); - tmp->setRhs(new SgExprListExp()); - tmp = (SgExprListExp*)tmp->rhs(); - } - - tmp->setLhs(resultExprCall[resultExprCall.size() - 1]); - if (funcCall->variant() == FUNC_CALL) - funcCall->setLhs(expr); - else - funcCall = expr; - } - return funcCall; -} - -SgSymbol* createNewFunctionSymbol(const char *name) -{ - SgSymbol *symb = NULL; - if (name == NULL) - name = "__dvmh_tmp_symb"; - - if (fTableOfSymbols.find(name) == fTableOfSymbols.end()) - { - symb = new SgSymbol(FUNCTION_NAME, name); - fTableOfSymbols[name] = symb; - } - else - symb = fTableOfSymbols[name]; - - return symb; -} - -SgFunctionCallExp* createNewFCall(const char *name) -{ - SgSymbol *symb = createNewFunctionSymbol(name); - return new SgFunctionCallExp(*symb); -} - -void createNewFCall(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - SgExpression **Arg = new SgExpression*[nArgs]; - for (int i = 0; i < nArgs; ++i) - { - Arg[i] = currArgs->lhs(); - convertExpr(Arg[i], Arg[i]); - currArgs = currArgs->rhs(); - } - - retExp = createNewFCall(name); - if (nArgs != 0) - { - for (int i = 0; i < nArgs; ++i) - ((SgFunctionCallExp*)retExp)->addArg(*Arg[i]); - } - else - ((SgFunctionCallExp*)retExp)->addArg(*expr); -} - -static SgExpression* convertDvmAssign(SgExpression *copy, const vector >& symbs) -{ - SgExpression* list = copy->lhs()->lhs(); - stack pointersToMul; - while (list) - { - if (list->variant() == MULT_OP) - pointersToMul.push(list); - else if (list->rhs() && list->rhs()->variant() == MULT_OP) - pointersToMul.push(list->rhs()); - list = list->lhs(); - } - for (int z = 0; z < symbs.size(); ++z) - { - SgSymbol* curr = symbs[z].first; - SgExpression* exp = pointersToMul.top(); - pointersToMul.pop(); - exp->setRhs(&(*exp->rhs() + *new SgVarRefExp(curr))); - } - return copy; -} - -static SgForStmt* createFor(const vector& dimSizes, const vector >& symbs, SgStatement *inner) -{ - SgForStmt* forSt = NULL; - for (int z = 0; z < dimSizes.size(); ++z) - { - SgSymbol* s = symbs[z].first; - SgSymbol* s_decl = symbs[z].second; - - SgExpression* start = &SgAssignOp(*new SgVarRefExp(*s_decl), *new SgValueExp(0)); - SgExpression* end = &(*new SgVarRefExp(*s) < *new SgValueExp(dimSizes[z])); - SgExpression* step = new SgUnaryExp(PLUSPLUS_OP, *new SgVarRefExp(*s)); - - forSt = new SgForStmt(start, end, step, forSt == NULL ? inner : forSt); - } - return forSt; -} - -static pair, vector > > createForCopy(const vector &dimSizes, SgExpression *dvmArray, bool in, bool out) -{ - SgType* base = dvmArray->symbol()->type()->baseType(); - SgForStmt* forSt = NULL, *forStInv = NULL; - SgStatement* inner = NULL; - - vector ret; - vector retInv; - - vector > symbs(dimSizes.size()); - - int total = 1; - for (int z = 0; z < dimSizes.size(); ++z) - total *= dimSizes[z]; - - SgArrayType* arrT = new SgArrayType(*base); - arrT->addDimension(new SgValueExp(total)); - - char buf[256]; - sprintf(buf, "%d", arrayGenNum++); - SgSymbol* array = new SgSymbol(VARIABLE_NAME, (string("_tfm_arr_") + buf).c_str(), arrT, NULL); - - for (int z = 0; z < dimSizes.size(); ++z) - { - sprintf(buf, "%d", z); - SgSymbol* s = new SgSymbol(VARIABLE_NAME, (string("_tfm__") + buf).c_str()); - SgSymbol* s_decl = new SgSymbol(VARIABLE_NAME, (string("int _tfm__") + buf).c_str()); - symbs[z] = make_pair(s, s_decl); - } - - SgArrayRefExp* arrayRef = new SgArrayRefExp(*array); - SgExpression* subs = new SgVarRefExp(symbs[0].first); - int dumS = 1; - for (int z = 1; z < symbs.size(); ++z) - { - subs = &(*subs + (*new SgValueExp(dumS * dimSizes[symbs.size() - z]) * *new SgVarRefExp(symbs[1].first))); - dumS *= dimSizes[symbs.size() - z]; - } - - SgExpression* copyDvmArrayElems = convertDvmAssign(&dvmArray->copy(), symbs); - const string key(copyDvmArrayElems->unparse()); - - if (autoTfmReplacing.find(key) != autoTfmReplacing.end()) - return make_pair(autoTfmReplacing[key], make_pair(ret, retInv)); - - arrayRef->addSubscript(*subs); - ret.push_back(makeSymbolDeclaration(array)); - - if (in) - { - inner = new SgAssignStmt(*arrayRef, copyDvmArrayElems->copy()); - forSt = createFor(dimSizes, symbs, inner); - ret.push_back(forSt); - } - - if (out) - { - inner = new SgAssignStmt(copyDvmArrayElems->copy(), arrayRef->copy()); - forStInv = createFor(dimSizes, symbs, inner); - retInv.push_back(forStInv); - } - - autoTfmReplacing[key] = array; - return make_pair(array, make_pair(ret, retInv)); -} - -static vector fillBitsOfArgs(SgProgHedrStmt *hedr) -{ - vector bitsOfArgs; - for (int z = 0; z < hedr->numberOfParameters(); ++z) - { - SgSymbol *par = hedr->parameter(z); - int attr = par->attributes(); - if (attr & IN_BIT) - bitsOfArgs.push_back(IN_BIT); - else if (attr & OUT_BIT) - bitsOfArgs.push_back(OUT_BIT); - else - bitsOfArgs.push_back(INOUT_BIT); - } - - return bitsOfArgs; -} - -static bool isPrivate(const string& array) -{ - SgExpression* exp = private_list; - while (exp) - { - if (exp->lhs()->symbol()->identifier() == array) - return true; - exp = exp->rhs(); - } - return false; -} - -//#define DEB -static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isFunction) -{ - bool ret = true; - bool casePrivateArray = false; - const string name(funcSymb->identifier()); - - vector *prototype = NULL; - int num = 0; - SgExpression* tmp = listArgs; - while (tmp) - { - num++; - tmp = tmp->rhs(); - } - - map > >::iterator it = interfaceProcedures.find(name); - bool canFoundInterface = !(it == interfaceProcedures.end()); - - //try to find function on current file - //TODO: add support of many files - //TODO: module functions with the same name - vector argsBits; - if (canFoundInterface == false) - { -#ifdef DEB - map> tmp; - for (graph_node* ndl = node_list; ndl; ndl = ndl->next) - tmp[ndl->name].push_back(ndl); -#endif - for (graph_node *ndl = node_list; ndl; ndl = ndl->next) - { - if (ndl->name == name && current_file == ndl->file) - { - if (ndl->st_header == NULL) - { - Error("Can not find procedure header %s", name.c_str(), 652, first_do_par); - ret = false; - } - else - { - CreateIntefacePrototype(ndl->st_header); - argsBits = fillBitsOfArgs(isSgProgHedrStmt(ndl->st_header)); - } - } - else if(ndl->name == name && ndl->st_interface) - { - CreateIntefacePrototype(ndl->st_interface); - argsBits = fillBitsOfArgs(isSgProgHedrStmt(ndl->st_interface)); - } - } - - it = interfaceProcedures.find(name); - canFoundInterface = !(it == interfaceProcedures.end()); - - if (canFoundInterface == false) - { - Error("Can not find interface for procedure %s", name.c_str(), 653, first_do_par); - ret = false; - } - } - else - { - for (graph_node* ndl = node_list; ndl; ndl = ndl->next) - if (ndl->name == name && current_file == ndl->file) - argsBits = fillBitsOfArgs(isSgProgHedrStmt(ndl->st_header)); - } - - if (canFoundInterface) - { - bool found = false; - - //TODO: add support of many interfaces with the same count of parameters - for (int k = 0; k < it->second.size(); ++k) - { - if (it->second[k].size() == num) - { - found = true; - prototype = &it->second[k]; - break; - } - } - - if (found == false) - { - Error("Can not find interface for procedure %s", name.c_str(), 653, first_do_par); - ret = false; - } - else //Match here - { - SgExpression *argInCall = listArgs; - for (int i = 0; i < num; ++i, argInCall = argInCall->rhs()) - { - if (argInCall->lhs() == NULL) - { - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - ret = false; - continue; - } - - SgType *typeInCall; - SgSymbol* parS = NULL; - if (argInCall->lhs()->symbol()) // simple argument - { - typeInCall = argInCall->lhs()->symbol()->type(); - parS = argInCall->lhs()->symbol(); -#ifdef DEB - printf("simple type of typeInCall %d, %s\n", typeInCall->variant(), argInCall->lhs()->symbol()->identifier()); -#endif - } - else // expression - { - typeInCall = argInCall->lhs()->type(); -#ifdef DEB - printf("expression type of typeInCall %d\n", typeInCall->variant()); -#endif - } - - SgType *typeInProt = (*prototype)[i]; - SgType* typeInProtSave = (*prototype)[i]; - - int countOfSubscrInCall = 0; - int dimSizeInProt = 0; - if (argInCall->lhs()->variant() == ARRAY_REF) - { - SgExpression *subs = argInCall->lhs()->lhs(); - while (subs) - { - countOfSubscrInCall++; - subs = subs->rhs(); - } - - SgArrayType* inCall = isSgArrayType(typeInCall); - SgArrayType* inProt = isSgArrayType(typeInProt); - - if (countOfSubscrInCall == 0) - { - if (inCall == NULL || inProt == NULL) // inconsistency - { - if (isSgPointerType(typeInCall) && inProt) - typeInCall = typeInProt; - else - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 1\n"); -#endif - } - } - else if (inCall->dimension() != inProt->dimension()) - { - if (isPrivate(argInCall->lhs()->symbol()->identifier()) && isPrivateArrayDummy(argInCall->lhs()->symbol()) != 1) - typeInCall = typeInProt; - else - typeInCall = NULL; - -#ifdef DEB - printf("typeInCall NULL 2\n"); -#endif - } - else - { - typeInCall = typeInProt; - if (for_kernel && isPrivate(argInCall->lhs()->symbol()->identifier()) || isPrivateArrayDummy(argInCall->lhs()->symbol())==1) - { - typeInCall = NULL; - casePrivateArray = true; -#ifdef DEB - printf("typeInCall NULL 2_p\n"); -#endif - } - } - } - else // countOfSubscrInCall != 0 - { - //TODO: not supported yet - if (inCall && inProt) - { - if (inCall->dimension() != inProt->dimension()) // TODO - { //TODO: check for non distributed - typeInCall = typeInProt; - dimSizeInProt = inProt->dimension(); - } - else - { - if (options.isOn(O_PL2) && dvm_parallel_dir && dvm_parallel_dir->expr(0) == NULL) - dimSizeInProt = inCall->dimension(); - - const int arrayDim = isPrivate(argInCall->lhs()->symbol()->identifier()) ? inCall->dimension() : 1; - - if (isSgArrayType(typeInProt) && (!options.isOn(O_PL2) || !for_kernel || dvm_parallel_dir && dvm_parallel_dir->expr(0) != NULL)) // inconsistency - { - if (inCall->dimension() == inProt->dimension()) - { - typeInCall = typeInProt; - dimSizeInProt = inProt->dimension(); - } - else - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 3\n"); -#endif - } - } - else if (arrayDim - countOfSubscrInCall == 0) - typeInCall = typeInProt; - else // TODO - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 4\n"); -#endif - } - } - } - else if (inProt) // inconsistency - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 5\n"); -#endif - } - else if (inCall) - { - const int arrayDim = isPrivate(argInCall->lhs()->symbol()->identifier()) ? inCall->dimension() : 1; - - if (arrayDim - countOfSubscrInCall == 0) - typeInCall = typeInProt; - else - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 6\n"); -#endif - } - } - } - } - else - { - if (typeInCall->variant() == T_DESCRIPT) - typeInCall = ((SgDescriptType*)typeInCall)->baseType(); - - if (typeInProt->variant() == typeInCall->variant()) - { - if (typeInProt->hasBaseType() && !typeInCall->hasBaseType()) // inconsistency - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 7\n"); -#endif - } - - if (typeInProt->hasBaseType() && typeInCall) - { - if (typeInProt->baseType()->variant() != typeInCall->baseType()->variant()) // inconsistency - { - typeInCall = NULL; -#ifdef DEB - printf("typeInCall NULL 8\n"); -#endif - } - else - { - typeInProt = typeInProt->baseType(); - typeInCall = typeInCall->baseType(); - } - } - - if (typeInCall) - { - if (typeInProt->equivalentToType(typeInCall)) - typeInCall = typeInProt; - else - { - if (typeInProt->length() && typeInCall->length()) - { - if (string(typeInProt->length()->unparse()) == string(typeInCall->length()->unparse())) - typeInCall = typeInProt; - else - { - typeInCall = NULL; // TODO -#ifdef DEB - printf("typeInCall NULL 9\n"); -#endif - } - } - else if (typeInProt->selector() && typeInCall->selector()) - { - if (string(typeInProt->selector()->unparse()) == string(typeInCall->selector()->unparse())) - typeInCall = typeInProt; - else - { - typeInCall = NULL; // TODO -#ifdef DEB - printf("typeInCall NULL 10\n"); -#endif - } - } - else - printf("typeInCall NULL 11\n"); //TODO - } - } - - if (typeInProt != typeInCall) - { - if (CompareKind(typeInProt, typeInCall) != 1) // check selector - { - char buf[256]; - sprintf(buf, "The type of %d argument of '%s' procedure can not be equal to actual parameter in call", i + 1, name.c_str()); - Warning(buf, "", 655, first_do_par); - } - typeInCall = typeInProt; - } - } - else // check selector - { - if (CompareKind(typeInProt, typeInCall)) - typeInCall = typeInProt; - } - } // end of type analysis - //---------------------------------------------------------------------------------------------------- - if (typeInProt != typeInCall) - { - char buf[256]; - sprintf(buf, "Can not match the %d argument of '%s' procedure", i + 1, name.c_str()); - if (!casePrivateArray) - Error(buf, "", 656, first_do_par); - //ret = false; - } - else if (argInCall->lhs()->variant() == ARRAY_REF) - { - if (countOfSubscrInCall == 0) - { - SgExpression *arr = argInCall->lhs(); - SgType *type = arr->symbol()->type(); - - if (type->hasBaseType()) - argInCall->setLhs(*new SgCastExp(*C_PointerType(C_Type(type->baseType())), *arr)); - else - argInCall->setLhs(*new SgCastExp(*C_PointerType(C_Type(type)), *arr)); - } - else - { - if (dimSizeInProt == 0) - { - //if (isFunction) //04.02.25 podd - { - SgExpression* arrayRef = argInCall->lhs(); - convertExpr(arrayRef, arrayRef); - } - } - else - { - if (options.isOn(AUTO_TFM) && !isInPrivate(argInCall->lhs()->symbol()->identifier())) - { - //TODO: ranges, ex. (-1:2) - - SgArrayType* arrT = isSgArrayType(typeInProtSave); - int dim = arrT->dimension(); - vector dimSizes(dim); - for (int z = 0; z < dim; ++z) - dimSizes[z] = -1; - - int dimTotal = 1; - for (int z = 0; z < dim; ++z) - { - if (arrT->sizeInDim(z)->isInteger()) - dimTotal *= dimSizes[z] = arrT->sizeInDim(z)->valueInteger(); - else - dimTotal = -1; - } - - if (dimTotal != -1) - { - std::reverse(dimSizes.begin(), dimSizes.end()); - bool ifIn = true; - bool ifOut = true; - - pair, vector > > conv = createForCopy(dimSizes, argInCall->lhs(), ifIn, ifOut); - - if ( (argsBits[i] & IN_BIT) || (argsBits[i] & INOUT_BIT)) - for (int z = 0; z < conv.second.first.size(); ++z) - insertBefore[curTranslateStmt].push_back(conv.second.first[z]); - - if ((argsBits[i] & OUT_BIT) || (argsBits[i] & INOUT_BIT)) - for (int z = 0; z < conv.second.second.size(); ++z) - insertAfter[curTranslateStmt].push_back(conv.second.second[z]); - - argInCall->setLhs(*new SgArrayRefExp(*conv.first)); - } - else - { - char buf[256]; - sprintf(buf, "Unsupported variant of '%s' procedure call", name.c_str()); - Error(buf, "", 657, first_do_par); - } - } - else - { - SgExpression* arr = argInCall->lhs(); - if (!isNullSubscripts(arr->lhs())) - convertExpr(arr, arr); - - if (options.isOn(O_PL2)) - { - SgType* cast = NULL; - if (typeInProtSave->hasBaseType()) - cast = C_PointerType(C_Type(typeInProtSave->baseType())); - else - cast = C_PointerType(C_Type(typeInProtSave)); - if (for_kernel && isPrivate(arr->symbol()->identifier()) || isPrivateArrayDummy(arr->symbol())==2) - { - cast = C_PointerType(C_VoidType()); - } - argInCall->setLhs(*new SgCastExp(*cast, SgAddrOp(*arr))); - } - else - { - if (for_kernel && isPrivate(arr->symbol()->identifier()) || isPrivateArrayDummy(arr->symbol())==2) - argInCall->setLhs(*new SgCastExp(*C_PointerType(C_VoidType()), SgAddrOp(*arr))); - else - argInCall->setLhs(SgAddrOp(*arr)); - } - } - } - } - } //end of ARRAY_REF - else - { - SgExpression* arg = argInCall->lhs(); - SgType* orig = arg->type(); - SgType* typeCopy = orig->copyPtr(); - - SgExpression* selector = typeCopy->selector(); - if (selector) - { - typeCopy->deleteSelector(); - arg->setType(typeCopy); - } - - //if (isFunction) // 04.02.25 podd - convertExpr(arg, arg); - - if (selector) - { - int size = -1; - SgExpression* e2 = TypeKindExpr(orig); - if (e2 && e2->isInteger()) - size = e2->valueInteger(); - - if (size > 0) - { - const int var = typeCopy->variant(); - if (var == T_FLOAT || var == T_DOUBLE) - { - if (size == 4) - arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "float"), *new SgExprListExp(*arg)); - else if (size == 8) - arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "double"), *new SgExprListExp(*arg)); - } - else if (var == T_INT || var == T_BOOL) - { - if (size == 1) - arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "char"), *new SgExprListExp(*arg)); - else if (size == 2) - arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "short"), *new SgExprListExp(*arg)); - else if (size == 4) - arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "int"), *new SgExprListExp(*arg)); - else if (size == 8) - arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "long long"), *new SgExprListExp(*arg)); - } - } - } - - argInCall->setLhs(arg); - } - } - } - } - - return ret; -} - -void convertExpr(SgExpression *expr, SgExpression* &retExp) -{ - if (expr) - { - int var = expr->variant(); - SgExpression *lhs = NULL, *rhs = NULL; - - if (var != FUNC_CALL) - { - if (expr->lhs()) - { - lhs = expr->lhs(); - convertExpr(lhs, lhs); - } - - if (expr->rhs()) - { - rhs = expr->rhs(); - convertExpr(rhs, rhs); - } - } - - if (var == EXP_OP) - { - bool default_ = false; - - if (rhs->variant() == INT_VAL) - { - int i = rhs->valueInteger(); - if (i == 0) - retExp = new SgValueExp(1); - else if (i == 1) - retExp = lhs; - else if (i == 2) - { - if (lhs->variant() != FUNC_CALL && lhs->variant() != PROC_CALL) - retExp = &(*lhs * *lhs); - else - default_ = true; - } - else - default_ = true; - } - else - default_ = true; - - if (default_) - { - SgFunctionCallExp *tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("pow")); - tmpF->addArg(*lhs); - tmpF->addArg(*rhs); - retExp = tmpF; - } - } - else if(var == RECORD_REF) - retExp = expr; - else if (var == FUNC_CALL) - { - SgFunctionCallExp *tmpF = (SgFunctionCallExp *)expr; - const char *name = tmpF->funName()->identifier(); - map::iterator it = handlersOfFunction.find(name); - if (!strcmp(name, "present")) - { - /* string argName = expr->lhs()->lhs()->symbol()->identifier(); - SgStatement* funcHdr = curTranslateStmt; - SgExpression* newPresent = makePresentExpr(argName,funcHdr); - retExp = newPresent;*/ - SgExpression* pres = new SgExpression(RECORD_REF); - pres->setLhs(new SgVarRefExp(expr->lhs()->lhs()->symbol())); - pres->setRhs(new SgVarRefExp(*new SgSymbol(FIELD_NAME, "isExist"))); - retExp = pres; - } - else if(!strcmp(name, "ub")) - retExp = expr; - else - { - if (it != handlersOfFunction.end()) - it->second.CallHandler(expr, retExp); - else - { - SgSymbol *symb = tmpF->funName(); - SgStatement *inter = getInterfaceForCall(symb); - if(inter) - { - //switch arguments by keyword - expr = switchArgumentsByKeyword(name, tmpF, inter); - //check ommited arguments - //transform fact to formal - } - - SgExpression *tmp = expr->lhs(); - matchPrototype(tmpF->funName(), tmp, true); - - retExp->setLhs(expr->lhs()); - retExp->setRhs(expr->rhs()); - - if (isUserFunction(tmpF->funName()) == 0 && !inter) - { - printf(" [EXPR ERROR: %s, line %d, user line %d] unsupported variant of func call with name \"%s\"\n", __FILE__, __LINE__, first_do_par->lineNumber(), name); - if (unSupportedVars.size() != 0) - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - } - } - } - } - else if (var == DOUBLE_VAL) - { - char *digit_o = ((SgValueExp*)expr)->doubleValue(); - SgExpression *val = ((SgValueExp*)expr)->type()->selector(); - - char *digit = new char[strlen(digit_o) + 1]; - strcpy(digit, digit_o); - for (size_t i = 0; i < strlen(digit); ++i) - { - if (digit[i] == 'd') - { - digit[i] = 'e'; - break; - } - } - SgValueExp *valDouble = new SgValueExp(double(0.0), digit); - delete[]digit; - - if (val != NULL) - { - if (val->valueInteger() == 8) // double - createNewFCall(valDouble, retExp, "double", 0); - else if (val->valueInteger() == 4) // float - createNewFCall(valDouble, retExp, "float", 0); - else - retExp = valDouble; - } - else - retExp = valDouble; - } - else if (var == FLOAT_VAL) - { - char *digit_o = ((SgValueExp*)expr)->floatValue(); - SgExpression *val = ((SgValueExp*)expr)->type()->selector(); - - char *digit = new char[strlen(digit_o) + 2]; - strcpy(digit, digit_o); - digit[strlen(digit_o)] = 'f'; - digit[strlen(digit_o) + 1] = '\0'; - - SgValueExp *valFloat = new SgValueExp(float(0.0), digit); - delete[]digit; - - if (val != NULL) - { - if (val->valueInteger() == 8) // double - createNewFCall(valFloat, retExp, "double", 0); - else if (val->valueInteger() == 4) // float - createNewFCall(valFloat, retExp, "float", 0); - else - retExp = valFloat; - } - else - retExp = valFloat; - } - else if (var == INT_VAL) - { - SgExpression *val = ((SgValueExp*)expr)->type()->selector(); - int digit = ((SgValueExp*)expr)->valueInteger(); - if (val != NULL) - { - if (val->valueInteger() == 8) // long - createNewFCall(new SgValueExp(digit), retExp, "long", 0); - else if (val->valueInteger() == 4) // int - createNewFCall(new SgValueExp(digit), retExp, "int", 0); - else if (val->valueInteger() == 2) // short - createNewFCall(new SgValueExp(digit), retExp, "short", 0); - else if (val->valueInteger() == 1) // char - createNewFCall(new SgValueExp(digit), retExp, "char", 0); - else - retExp = expr; - } - else - retExp = expr; - } - else if (var == COMPLEX_VAL) - { - SgValueExp *tmp = ((SgValueExp*)expr); - SgExpression *re = ((SgValueExp*)expr)->realValue(); - SgExpression *im = ((SgValueExp*)expr)->imaginaryValue(); - - int kind = 8; - if (re->variant() != DOUBLE_VAL && im->variant() != DOUBLE_VAL) - kind = 4; - - if (kind == 8) - retExp = new SgFunctionCallExp(*createNewFunctionSymbol("dcmplx2")); - else - retExp = new SgFunctionCallExp(*createNewFunctionSymbol("cmplx2")); - - convertExpr(re, re); - convertExpr(im, im); - - ((SgFunctionCallExp*)retExp)->addArg(*re); - ((SgFunctionCallExp*)retExp)->addArg(*im); - } - else if (var == ARRAY_REF) - { - bool ifInPrivateList = false; - size_t idx = 0; - - char *strName = expr->symbol()->identifier(); - for (; idx < arrayInfo.size(); ++idx) - { - if (arrayInfo[idx].name == strName) - { - ifInPrivateList = true; - break; - } - } - - if (ifInPrivateList) - { - int dim = isSgArrayType(expr->symbol()->type())->dimension(); - - if (dim > 0 && expr->lhs()) // DIM > 0 && ARRAY_REF is not under CALL - { - stack allArraySub; - //swap subscripts and correct exps - - SgExpression *tmp = expr->lhs(); - for (int i = 0; i < dim; ++i) - { - SgExpression *conv = tmp->lhs(); - convertExpr(conv, conv); - tmp = tmp->rhs(); - allArraySub.push(conv); - } - - tmp = expr->lhs(); - int k = 0; - for (int i = 0; i < dim; ++i) - { - if (arrayInfo[idx].correctExp[dim - 1 - k]) - tmp->setLhs(*allArraySub.top() - *arrayInfo[idx].correctExp[dim - 1 - k]); - else - tmp->setLhs(*allArraySub.top()); - allArraySub.pop(); - k++; - tmp = tmp->rhs(); - } - - - if (arrayInfo[idx].typeRed == 1) - { - // revert order of subscr - stack allArraySub; - SgExpression *tmp = expr->lhs(); - for (int i = 0; i < dim; ++i) - { - allArraySub.push(&tmp->lhs()->copy()); - tmp = tmp->rhs(); - } - - tmp = expr->lhs(); - for (int i = 0; i < dim; ++i) - { - tmp->setLhs(*allArraySub.top()); - allArraySub.pop(); - tmp = tmp->rhs(); - } - - // linearized red arrays - expr->setLhs(LinearFormForRedArray(expr->symbol(), expr->lhs(), arrayInfo[idx].rsl)); - } - } - } - // else global or dvm array - retExp = expr; - } - else if (var == VAR_REF) - retExp = &expr->copy(); - else if (var == NEQV_OP) - { -#ifdef INTEL_LOGICAL_TYPE - retExp = new SgExpression(XOR_OP, lhs, rhs); -#else - retExp = &(*lhs != *rhs); -#endif - } - else if (var == EQV_OP) - { -#ifdef INTEL_LOGICAL_TYPE - retExp = new SgExpression(BIT_COMPLEMENT_OP, new SgExpression(XOR_OP, lhs, rhs), NULL); -#else - retExp = &(*lhs == *rhs); -#endif - } - else if (var == AND_OP) - retExp = new SgExpression(BITAND_OP, lhs, rhs); - else if (var == OR_OP) - retExp = new SgExpression(BITOR_OP, lhs, rhs); - else if (var == NOT_OP) - { -#ifdef INTEL_LOGICAL_TYPE - retExp = new SgExpression(BIT_COMPLEMENT_OP, lhs, NULL); -#else - retExp = new SgExpression(NE_OP, lhs, new SgKeywordValExp("true")); -#endif - } - else if (var == BOOL_VAL) - { - bool val = ((SgValueExp*)expr)->boolValue(); -#ifdef INTEL_LOGICAL_TYPE - retExp = val ? new SgExpression(BIT_COMPLEMENT_OP, new SgValueExp(0), NULL) : new SgValueExp(0); -#else - retExp = new SgKeywordValExp(val ? "true" : "false"); -#endif - } - else - { - // known vars: ADD_OP, SUBT_OP, MULT_OP, DIV_OP, MINUS_OP, UNARY_ADD_OP, CONST_REF, EXPR_LIST, - retExp->setLhs(lhs); - retExp->setRhs(rhs); - if (supportedVars.find(var) == supportedVars.end()) - unSupportedVars.insert(var); - } - } -} - -static SgExpression* convertReductionAddressForAtomic(SgExpression* exp) -{ - SgExpression* ref = exp->copyPtr(); - ref->setLhs(NULL); - - SgExpression* idx = exp->lhs()->copyPtr(); - - return new SgExpression(ADD_OP, ref, idx); -} - -//TODO: need to check bitwise operations -static SgExpression* splitReductionForAtomic(SgExpression* lhs, SgExpression* rhs, const int num_red) -{ - SgExpression* args = NULL; - if (!lhs || !rhs) - { - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - return NULL; - } - - string left(lhs->unparse()); - set op; - if (num_red == 1) // sum - { - op.insert(ADD_OP); - op.insert(SUBT_OP); - } - else if (num_red == 2) // product - op.insert(MULT_OP); - else if (num_red == 3) // max - op.insert(FUNC_CALL); - else if (num_red == 4) // min - op.insert(FUNC_CALL); - else if (num_red == 5) // and - op.insert(BITAND_OP); - else if (num_red == 6) // or - op.insert(BITOR_OP); - else if (num_red == 7) // neqv - op.insert(XOR_OP); - else if (num_red == 8) // eqv - { - if (rhs->variant() == BIT_COMPLEMENT_OP) - rhs = rhs->lhs(); - op.insert(XOR_OP); - } - - if (op.size()) - { - if (op.find(rhs->variant()) != op.end()) - { - SgExpression* l_part = rhs->lhs(); - SgExpression* r_part = rhs->rhs(); - if (rhs->variant() == FUNC_CALL) - { - if (rhs->lhs()) - { - if (rhs->lhs()->lhs()) - l_part = rhs->lhs()->lhs(); - if (rhs->lhs()->rhs() && rhs->lhs()->rhs()->lhs()) - r_part = rhs->lhs()->rhs()->lhs(); - } - } - - if (l_part && r_part) - { - string Lpart(l_part->unparse()); - string Rpart(r_part->unparse()); - - bool ok = false; - if (Lpart == left) - ok = true; - else if (Rpart == left) - { - std::swap(l_part, r_part); - ok = true; - } - - if (ok) - { - if (rhs->variant() == SUBT_OP) - r_part = new SgExpression(MINUS_OP, r_part, NULL); - - SgExpression* arg1 = convertReductionAddressForAtomic(l_part); - SgExpression* arg2 = r_part; - - args = new SgExpression(EXPR_LIST, arg1, new SgExpression(EXPR_LIST, arg2, NULL)); - } - } - } - } - - if (args == NULL) - { - string right(rhs->unparse()); - Error("Can not match reduction template for this pattern: %s", (left + " = " + right).c_str(), 658, first_do_par); - } - - return args; -} - -static bool convertStmt(SgStatement* &st, pair &retSts, vector < stack < SgStatement*> > ©Block, - int countOfCopy, int lvl, const map& redArraysWithUnknownSize) -{ - bool needReplace = false; - SgStatement *labSt = NULL; - SgStatement *retSt = NULL; - curTranslateStmt = st; - if (st->hasLabel()) - { - if (lvl == 0) - convertLabel(st, labSt, false); - else - convertLabel(st, labSt, true); - - for (int i = 0; i < countOfCopy; ++i) - copyBlock[i].push(&st->lexPrev()->copy()); - } - - if (st->variant() == ASSIGN_STAT) - { - SgExpression *lhs = st->expr(0); - SgExpression *rhs = st->expr(1); - -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert assign node\n"); - lvl_convert_st += 2; -#endif - convertExpr(lhs, lhs); - convertExpr(rhs, rhs); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert assign node\n"); -#endif - if (lhs->variant() == ARRAY_REF && redArraysWithUnknownSize.find(lhs->symbol()->identifier()) != redArraysWithUnknownSize.end()) - { - const string arrayName = lhs->symbol()->identifier(); - const int num_red = redArraysWithUnknownSize.find(arrayName)->second; - string atomicName = "NULL"; - - if (num_red == 1) // sum - atomicName = "__dvmh_atomic_add"; - else if (num_red == 2) // product - atomicName = "__dvmh_atomic_prod"; - else if (num_red == 3) // max - atomicName = "__dvmh_atomic_max"; - else if (num_red == 4) // min - atomicName = "__dvmh_atomic_min"; - else if (num_red == 5) // and - atomicName = "__dvmh_atomic_and"; - else if (num_red == 6) // or - atomicName = "__dvmh_atomic_or"; - else if (num_red == 7) // neqv - atomicName = "__dvmh_atomic_neqv"; - else if (num_red == 8) // eqv - atomicName = "__dvmh_atomic_eqv"; - - if (atomicName == "NULL") - { - Error("Unsupported reduction type by unknown(large) array size", "", 659, first_do_par); - retSt = new SgCExpStmt(SgAssignOp(*lhs, *rhs)); - } - else - { - SgFunctionSymb* fCall = new SgFunctionSymb(FUNCTION_NAME, atomicName.c_str(), *SgTypeInt(), *kernel_st); - - SgExpression* args = splitReductionForAtomic(lhs, rhs, num_red); - if (args) - retSt = new SgCExpStmt(*new SgFunctionCallExp(*fCall, *args)); - } - } - else - retSt = new SgCExpStmt(SgAssignOp(*lhs, *rhs)); - needReplace = true; - } - else if (st->variant() == CONT_STAT) - { -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert continue node\n"); - lvl_convert_st += 2; -#endif - retSt = NULL; -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert continue node\n"); - -#endif - needReplace = true; - } - else if (st->variant() == ARITHIF_NODE) - { - SgExpression *cond = st->expr(0); - SgExpression *lb = st->expr(1); - SgLabel *arith_lab[3]; - int i = 0; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert arithif node\n"); - lvl_convert_st += 2; -#endif - convertExpr(cond, cond); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert arithif node\n"); -#endif - while (lb) - { - SgLabel *lab = ((SgLabelRefExp *)(lb->lhs()))->label(); - SgStatement *labRet = NULL; - - long lab_num = lab->thelabel->stateno; - labels_num.insert(lab_num); - - createNewLabel(labRet, lab); - arith_lab[i] = ((SgLabelRefExp *)(lb->lhs()))->label(); - i++; - lb = lb->rhs(); - } - - - retSt = new SgIfStmt(*cond < *new SgValueExp(0), *new SgGotoStmt(*arith_lab[0]), - *new SgIfStmt(SgEqOp(*cond, *new SgValueExp(0)), *new SgGotoStmt(*arith_lab[1]), *new SgGotoStmt(*arith_lab[2]))); - needReplace = true; - } - else if (st->variant() == LOGIF_NODE) - { - SgExpression *cond = st->expr(0); - convertExpr(cond, cond); - SgStatement *body = ((SgLogIfStmt*)st)->body(); - pair t; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert logicif node\n"); - lvl_convert_st += 2; -#endif - convertStmt(body, t, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert logicif node\n"); -#endif - retSt = new SgIfStmt(*cond, *t.first); - if (t.second) - labSt = t.second; - needReplace = true; - } - else if (st->variant() == IF_NODE) - { - SgStatement *tb = ((SgIfStmt*)st)->trueBody(); - SgStatement *fb = ((SgIfStmt*)st)->falseBody(); - SgIfStmt *newIfSt = NULL; - - if (!fb) - { - SgStatement *tmp = st->lexNext(); - stack bodySts; - while (st->lastNodeOfStmt() != tmp) - { - pair convSt; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert if node\n"); - lvl_convert_st += 2; -#endif - convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert if node\n"); -#endif - if (convSt.second) - bodySts.push(convSt.second); - if (convSt.first) - bodySts.push(convSt.first); - - setControlLexNext(tmp); - } - - if (tmp->variant() == CONTROL_END) - { - pair convSt; - convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); - if (convSt.second) - bodySts.push(convSt.second); - } - - SgExpression *cond = ((SgIfStmt*)st)->conditional(); - convertExpr(cond, cond); - if (bodySts.size()) - { - retSt = new SgIfStmt(*cond, *bodySts.top()); - bodySts.pop(); - } - else - retSt = new SgIfStmt(*cond, *new SgStatement(1), 2); - - int size = bodySts.size(); - for (int i = 0; i < size; ++i) - { - retSt->insertStmtAfter(*bodySts.top()); - bodySts.pop(); - } - needReplace = true; - } - else - { - stack > bodySts; - stack bodyFalse; - stack conds; - SgStatement *fb_ControlEnd = NULL; - - stack t; - SgExpression *cond = ((SgIfStmt*)st)->conditional(); - convertExpr(cond, cond); - conds.push(cond); - for (;;) - { - if (fb->variant() == ELSEIF_NODE) - { - if (((SgIfStmt*)fb)->falseBody()) - { - if (((SgIfStmt*)fb)->falseBody()->variant() == ELSEIF_NODE) - fb = ((SgIfStmt*)fb)->falseBody(); - else - { - fb = ((SgIfStmt*)fb)->falseBody(); - fb_ControlEnd = fb->controlParent()->lastNodeOfStmt(); - break; - } - } - else - { - fb = fb->lastNodeOfStmt(); - fb_ControlEnd = fb; - break; - } - } - else - { - fb_ControlEnd = fb; - while (fb_ControlEnd->variant() != CONTROL_END) - setControlLexNext(fb_ControlEnd); - break; - } - } - - if (tb == NULL) - tb = ((SgIfStmt*)st)->falseBody(); - - while (tb != fb) - { - if (tb->variant() == ELSEIF_NODE) - { - bodySts.push(t); - SgExpression *cond = ((SgIfStmt*)tb)->conditional(); - convertExpr(cond, cond); - conds.push(cond); - t = stack(); - tb = tb->lexNext(); - } - else if (tb->variant() != CONTROL_END) - { - pair tmp; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert if node\n"); - lvl_convert_st += 2; -#endif - convertStmt(tb, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert if node\n"); -#endif - if (tmp.second) - t.push(tmp.second); - if (tmp.first) - t.push(tmp.first); - - setControlLexNext(tb); - } - else - tb = tb->lexNext(); - } - bodySts.push(t); - - while (fb != fb_ControlEnd) - { - pair tmp; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert if node\n"); - lvl_convert_st += 2; -#endif - convertStmt(fb, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert if node\n"); -#endif - if (tmp.second) - bodyFalse.push(tmp.second); - if (tmp.first) - bodyFalse.push(tmp.first); - - setControlLexNext(fb); - } - - if (fb->variant() == CONTROL_END) - { - pair tmp; - convertStmt(fb, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); - if (tmp.second) - bodyFalse.push(tmp.second); - } - - if (bodyFalse.size()) - { - if (bodySts.top().size() != 0) - newIfSt = new SgIfStmt(*conds.top(), *bodySts.top().top(), *bodyFalse.top()); - else - newIfSt = new SgIfStmt(*conds.top(), *bodyFalse.top(), 0); - - bodyFalse.pop(); - int cond1 = bodyFalse.size(); - for (int i = 0; i < cond1; ++i) - { - newIfSt->falseBody()->insertStmtBefore(*bodyFalse.top(), *newIfSt); - bodyFalse.pop(); - } - } - else - { - if (bodySts.top().size()) - newIfSt = new SgIfStmt(*conds.top(), *bodySts.top().top()); // !!!! - else - newIfSt = new SgIfStmt(*conds.top(), *new SgStatement(1), 2); // !!!! - } - - conds.pop(); - int cond1 = bodySts.size(); - for (int i = 0; i < cond1; ++i) - { - stack tmpS = bodySts.top(); - int cond2; - bodySts.pop(); - if (i == 0) - { - if (tmpS.size() != 0) - { - tmpS.pop(); - cond2 = tmpS.size(); - for (int k = 0; k < cond2; ++k) - { - newIfSt->insertStmtAfter(*tmpS.top(), *newIfSt); - tmpS.pop(); - } - } - } - else - { - if (tmpS.size() != 0) - { - newIfSt = new SgIfStmt(*conds.top(), *tmpS.top(), *newIfSt); - conds.pop(); - tmpS.pop(); - cond2 = tmpS.size(); - for (int k = 0; k < cond2; ++k) - { - newIfSt->insertStmtAfter(*tmpS.top(), *newIfSt); - tmpS.pop(); - } - } - else - { - newIfSt = new SgIfStmt(*conds.top(), *newIfSt, 0); - conds.pop(); - } - } - } - - retSt = newIfSt; - needReplace = true; - } - } - else if (st->variant() == FOR_NODE) - { - SgSymbol *cycleName = NULL; - if (isSgVarRefExp(st->expr(2))) - cycleName = isSgVarRefExp(st->expr(2))->symbol(); - - SgSymbol *it = ((SgForStmt *)st)->symbol(); - SgExpression *ex1 = ((SgForStmt *)st)->start(); - SgExpression *ex2 = ((SgForStmt *)st)->end(); - SgExpression *ex3 = NULL; - int ex3_lav = 0; - SgStatement *inDo = ((SgForStmt *)st)->body(); - SgSymbol *cond = new SgSymbol(VARIABLE_NAME, getNestCond()); - SgSymbol *newVar = new SgSymbol(VARIABLE_NAME, getNewCycleVar(it->identifier())); - SgFunctionCallExp *abs_f = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - SgFunctionCallExp *abs_f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); - stack bodySt; - - - if (((SgForStmt *)st)->step()) - ex3 = ((SgForStmt *)st)->step(); - else - { - ex3 = new SgValueExp(1); - ex3_lav = 1; - } - - SgStatement *lastNode = ((SgForStmt *)st)->lastNodeOfStmt(); - - while (inDo != lastNode) - { - pair tmp; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert for node\n"); - lvl_convert_st += 2; -#endif - map > save_insertBefore, save_insertAfter; - saveInsertBeforeAfter(save_insertAfter, save_insertBefore); - - convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert for node\n"); -#endif - copyToStack(bodySt, insertBefore); - if (tmp.second) - bodySt.push(tmp.second); - if (tmp.first) - bodySt.push(tmp.first); - copyToStack(bodySt, insertAfter); - - restoreInsertBeforeAfter(save_insertAfter, save_insertBefore); - setControlLexNext(inDo); - } - - if (lastNode->variant() != CONTROL_END) - { - pair tmp; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert for node\n"); - lvl_convert_st += 2; -#endif - map > save_insertBefore, save_insertAfter; - saveInsertBeforeAfter(save_insertAfter, save_insertBefore); - convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert for node\n"); -#endif - copyToStack(bodySt, insertBefore); - if (tmp.second) - bodySt.push(tmp.second); - if (tmp.first) - bodySt.push(tmp.first); - copyToStack(bodySt, insertAfter); - restoreInsertBeforeAfter(save_insertAfter, save_insertBefore); - } - else - { - pair tmp; - - map > save_insertBefore, save_insertAfter; - saveInsertBeforeAfter(save_insertAfter, save_insertBefore); - convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); - copyToStack(bodySt, insertBefore); - if (tmp.second) - bodySt.push(tmp.second); - copyToStack(bodySt, insertAfter); - restoreInsertBeforeAfter(save_insertAfter, save_insertBefore); - } - - SgExprListExp *tt = new SgExprListExp(); - SgExprListExp *tt1 = new SgExprListExp(); - SgExprListExp *tt2 = new SgExprListExp(); - SgExprListExp *tt3 = new SgExprListExp(); - - tt->setLhs(SgAssignOp(*new SgVarRefExp(it), *ex1)); - - abs_f->addArg(*ex3); - abs_f1->addArg(*ex1 - *ex2); - - // IF EXPR: t_ex1 ? t_ex2 : t_ex3 - SgExpression *t_ex1 = &(*ex1 > *ex2 && *ex3 > *new SgValueExp(0) || *ex1 < *ex2 && *ex3 < *new SgValueExp(0)); - SgExpression *t_ex2 = &SgAssignOp(*new SgVarRefExp(cond), *new SgValueExp(-1)); - SgExpression *t_ex3; - if (ex3_lav != 1) - t_ex3 = &SgAssignOp(*new SgVarRefExp(cond), (*abs_f1 + *abs_f) / *abs_f); - else - t_ex3 = &SgAssignOp(*new SgVarRefExp(cond), (*abs_f1 + *abs_f)); - - tt1->setLhs(*new SgExprIfExp(*t_ex1, *t_ex2, *t_ex3)); - tt->setRhs(tt1); - tt2->setLhs(SgAssignOp(*new SgVarRefExp(*newVar), *new SgValueExp(0))); - tt1->setRhs(tt2); - tt3->setLhs(&SgAssignOp(*new SgVarRefExp(it), *new SgVarRefExp(it) + *ex3)); - tt3->setRhs(new SgExprListExp()); - tt3->rhs()->setLhs(&SgAssignOp(*new SgVarRefExp(newVar), *new SgVarRefExp(newVar) + *new SgValueExp(1))); - - if (SAPFOR_CONV) // TODO: negative step - { - SgExprListExp* start = new SgExprListExp(); - start->setLhs(SgAssignOp(*new SgVarRefExp(it), *ex1)); - - SgExprListExp* step = new SgExprListExp(); - step->setLhs(&SgAssignOp(*new SgVarRefExp(it), *new SgVarRefExp(it) + *ex3)); - retSt = new SgForStmt(start, &(*new SgVarRefExp(it) <= ex2->copy()), step, NULL); - } - else - retSt = new SgForStmt(tt, &(*new SgVarRefExp(*newVar) < *new SgVarRefExp(cond)), tt3, NULL); - - if (cycleName) - { - vector labs; - vector labsSt; - createNewLabel(labsSt, labs, cycleName->identifier()); - - bodySt.push(labsSt[0]); - labels_num.insert(labs[0]->thelabel->stateno); - bodySt.push(new SgContinueStmt()); - - bodySt.push(labsSt[1]); - labels_num.insert(labs[1]->thelabel->stateno); - bodySt.push(new SgBreakStmt()); - } - - int sizeStack = bodySt.size(); - for (int i = 0; i < sizeStack; ++i) - { - retSt->insertStmtAfter(*bodySt.top(), *retSt); - bodySt.pop(); - } - newVars.push_back(cond); - - SgExprListExp *e = new SgExprListExp(*new SgVarRefExp(cond)); - e->setRhs(private_list); - private_list = e; - - bool needToadd = true; - for (size_t i = 0; i < newVars.size(); ++i) - { - if (strcmp(newVars[i]->identifier(), newVar->identifier()) == 0) - { - needToadd = false; - break; - } - } - if (needToadd) - { - newVars.push_back(newVar); - e = new SgExprListExp(*new SgVarRefExp(newVar)); - e->setRhs(private_list); - private_list = e; - } - - needReplace = true; - } - else if (st->variant() == WHILE_NODE) - { - SgSymbol *cycleName = NULL; - if (isSgVarRefExp(st->expr(2))) - cycleName = isSgVarRefExp(st->expr(2))->symbol(); - - SgExpression *conditional = ((SgWhileStmt *)st)->conditional(); - stack bodySt; - SgStatement *inDo = ((SgWhileStmt *)st)->body(); - SgStatement *lastNode = ((SgWhileStmt *)st)->lastNodeOfStmt(); - - - while (inDo != lastNode) - { - pair tmp; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert while node\n"); - lvl_convert_st += 2; -#endif - (void)convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert while node\n"); -#endif - if (tmp.second) - bodySt.push(tmp.second); - if (tmp.first) - bodySt.push(tmp.first); - - setControlLexNext(inDo); - } - - if (lastNode->variant() != CONTROL_END) - { - pair tmp; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert while node\n"); - lvl_convert_st += 2; -#endif - (void)convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert while node\n"); -#endif - if (tmp.second) - bodySt.push(tmp.second); - if (tmp.first) - bodySt.push(tmp.first); - } - else - { - pair tmp; - (void)convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); - if (tmp.second) - bodySt.push(tmp.second); - } - - convertExpr(conditional, conditional); - - if (conditional == NULL) - conditional = new SgValueExp(1); - retSt = new SgWhileStmt(conditional, NULL); - if (cycleName) - { - vector labs; - vector labsSt; - createNewLabel(labsSt, labs, cycleName->identifier()); - - bodySt.push(labsSt[0]); - labels_num.insert(labs[0]->thelabel->stateno); - bodySt.push(new SgContinueStmt()); - - bodySt.push(labsSt[1]); - labels_num.insert(labs[1]->thelabel->stateno); - bodySt.push(new SgBreakStmt()); - } - - - int sizeStack = bodySt.size(); - for (int i = 0; i < sizeStack; ++i) - { - retSt->insertStmtAfter(*bodySt.top(), *retSt); - bodySt.pop(); - } - - needReplace = true; - } - else if (st->variant() == SWITCH_NODE) - { - SgStatement *tmp = NULL; - SgStatement *lastNode = st->lastNodeOfStmt(); - stack bodySt; - - SgExpression *select = ((SgSwitchStmt*)st)->selector(); - convertExpr(select, select); - ((SgSwitchStmt*)st)->setSelector(*select); - - //extract default body - deque bodyQueue; - SgStatement *newIfStmt = NULL; - tmp = ((SgSwitchStmt*)st)->defOption(); - if (tmp != NULL) - { - newIfStmt = new SgIfStmt(*new SgValueExp(0), *new SgStatement(1), 2); - - SgStatement *st = tmp; - setControlLexNext(tmp); - st->deleteStmt(); - while (tmp->variant() != CASE_NODE && tmp->variant() != CONTROL_END) - { - pair convSt; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert switch node\n"); - lvl_convert_st+=2; -#endif - (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert switch node\n"); -#endif - if (convSt.second) - bodyQueue.push_back(convSt.second); - if (convSt.first) - bodyQueue.push_back(convSt.first); - st = tmp; - setControlLexNext(tmp); - st->deleteStmt(); - - } - if (tmp->variant() == CONTROL_END) - { - pair convSt; - (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); - if (convSt.second) - bodyQueue.push_back(convSt.second); - } - - if (!bodyQueue.empty()) - { - ((SgIfStmt*)newIfStmt)->replaceFalseBody(*bodyQueue.front()); - bodyQueue.pop_front(); - int sizeVector = bodyQueue.size(); - for (int i = 0; i < sizeVector; ++i) - { - ((SgIfStmt*)newIfStmt)->falseBody()->insertStmtAfter(*bodyQueue.back()); - bodyQueue.pop_back(); - } - } - - } - //convert other stmts - tmp = ((SgSwitchStmt*)st)->caseOption(0); - if (tmp != NULL) - { - if (newIfStmt == NULL) - newIfStmt = new SgIfStmt(*new SgValueExp(0), *new SgStatement(1), 2); - - pair convSt; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert switch node\n"); - lvl_convert_st+=2; -#endif - (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert switch node\n"); -#endif - if (convSt.second) - bodySt.push(convSt.second); - if (convSt.first) - bodySt.push(convSt.first); - setControlLexNext(tmp); - - SgExpression * cond = bodySt.top()->expr(0); - newIfStmt->setExpression(0, *cond); - bodySt.pop(); - - while (tmp != lastNode) - { - pair convSt; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert switch node\n"); - lvl_convert_st+=2; -#endif - (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert switch node\n"); -#endif - if (convSt.second) - bodySt.push(convSt.second); - if (convSt.first) - bodySt.push(convSt.first); - setControlLexNext(tmp); - } - int sizeStack = bodySt.size(); - for (int i = 0; i < sizeStack; ++i) - { - newIfStmt->insertStmtAfter(*bodySt.top(), *newIfStmt); - bodySt.pop(); - } - } - - retSt = newIfStmt; - needReplace = true; - } - else if (st->variant() == CASE_NODE) - { -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert case node\n"); - lvl_convert_st += 2; -#endif - SgExpression *cond = ((SgCaseOptionStmt*)st)->caseRange(0); - SgExpression *tmpCond = NULL; - SgExpression *lhs = NULL; - SgExpression *rhs = NULL; - SgExpression *select = ((SgSwitchStmt*)(st->controlParent()))->expr(0); - if (cond->variant() == DDOT) - { - lhs = cond->lhs(); - convertExpr(lhs, lhs); - rhs = cond->rhs(); - convertExpr(rhs, rhs); - if (rhs == NULL) - cond = &(*lhs <= *select); - else if (lhs == NULL) - cond = &(*select <= *rhs); - else - cond = &(*lhs <= *select && *select <= *rhs); - } - else - { - convertExpr(cond, cond); - cond = &SgEqOp(*select, *cond); - } - for (int i = 1; (tmpCond = ((SgCaseOptionStmt*)st)->caseRange(i)) != 0; ++i) - { - if (tmpCond->variant() == DDOT) - { - lhs = tmpCond->lhs(); - convertExpr(lhs, lhs); - rhs = tmpCond->rhs(); - convertExpr(rhs, rhs); - if (rhs == NULL) - tmpCond = &(*lhs <= *select); - else if (lhs == NULL) - tmpCond = &(*select <= *rhs); - else - tmpCond = &(*lhs <= *select && *select <= *rhs); - } - else - { - convertExpr(tmpCond, tmpCond); - tmpCond = &SgEqOp(*select, *tmpCond); - } - cond = &(*cond || *tmpCond); - } - - retSt = new SgIfStmt(*cond, *new SgStatement(1), 2); - retSt->setVariant(ELSEIF_NODE); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert case node\n"); -#endif - needReplace = true; - } - else if (st->variant() == GOTO_NODE) - { - long lab_num = ((SgGotoStmt*)st)->branchLabel()->thelabel->stateno; - labels_num.insert(lab_num); -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert goto node\n"); - lvl_convert_st+=2; -#endif - retSt = &st->copy(); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert goto node\n"); -#endif - needReplace = false; - } - else if (st->variant() == COMGOTO_NODE) - { - SgExpression *labList = ((SgComputedGotoStmt*)st)->labelList(); - SgExpression *expr = ((SgComputedGotoStmt*)st)->expr(1); - -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert compute goto node\n"); - lvl_convert_st += 2; -#endif - convertExpr(expr, expr); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert compute goto node\n"); -#endif - - int i = 0; - vector labs; - while (labList) - { - SgLabel *lab = ((SgLabelRefExp *)(labList->lhs()))->label(); - SgStatement *labRet = NULL; - - labels_num.insert(lab->thelabel->stateno); - createNewLabel(labRet, lab); - labs.push_back(lab); - - labList = labList->rhs(); - i++; - } - i--; - - SgIfStmt *if_stat = NULL; - bool first = true; - while (i >= 0) - { - if (first) - { - if_stat = new SgIfStmt(SgEqOp(*expr, *new SgValueExp(i + 1)), *new SgGotoStmt(*labs[i])); - first = false; - } - else - if_stat = new SgIfStmt(SgEqOp(*expr, *new SgValueExp(i + 1)), *new SgGotoStmt(*labs[i]), *if_stat); - i--; - } - - retSt = if_stat; - needReplace = true; - - } - else if (st->variant() == PRINT_STAT) // only for SAPFOR - { - if (SAPFOR_CONV == 0) - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - - SgInputOutputStmt* outStat = (SgInputOutputStmt*)st; - SgExpression* lhs = outStat->itemList(); - convertExpr(lhs, lhs); - - SgExpression* list = lhs; - while (list) - { - SgExpression* item = list->lhs(); - if (item && item->variant() == STRING_VAL) - { - SgValueExp* exp = (SgValueExp*)item; - string str = exp->stringValue(); - str += "\\n"; - exp->setValue(strdup(str.c_str())); - } - list = list->rhs(); - } - retSt = new SgCExpStmt(*new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "printf"), *lhs)); - } - else if (st->variant() == PROC_STAT) - { -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert call node\n"); - lvl_convert_st += 2; -#endif - SgExpression *lhs = st->expr(0); - //convertExpr(lhs, lhs); // !!!! 04.02.25 podd - - if (lhs == NULL || SAPFOR_CONV) - { - if (lhs) - retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol(), *lhs)); - else - retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol())); - } - else - { - if (st->symbol()->identifier() == string("random_number")) - { - if (lhs->variant() != EXPR_LIST || lhs->lhs() == NULL || lhs->lhs()->variant() != VAR_REF) - Error("Unsupported random_number call", "", 660, first_do_par); - - //rand state - lhs->setRhs(new SgExpression(EXPR_LIST, new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "__dvmh_rand_state")), NULL)); - addRandStateIfNeeded("__dvmh_rand_state"); - - retSt = new SgCExpStmt(*new SgFunctionCallExp(*new SgSymbol(VARIABLE_NAME, "__dvmh_rand"), *lhs)); - } - else - { - SgStatement* inter = getInterfaceForCall(st->symbol()); - if (inter) - { - //switch arguments by keyword - lhs = switchArgumentsByKeyword(st->symbol()->identifier(), lhs, inter); - //check ommited arguments - //transform fact to formal - } - - matchPrototype(st->symbol(), lhs, false); - retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol(), *lhs)); - } - } -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert call node\n"); -#endif - needReplace = true; - } - else if (st->variant() == EXIT_STMT) - { -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert exit node\n"); - lvl_convert_st += 2; -#endif - SgSymbol *constrName = ((SgExitStmt*)st)->constructName(); - if (constrName) - { - vector labs; - vector labsSt; - createNewLabel(labsSt, labs, constrName->identifier()); - - retSt = new SgGotoStmt(*labs[1]); - } - else - retSt = new SgBreakStmt(); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert exit node\n"); -#endif - needReplace = true; - } - else if (st->variant() == CYCLE_STMT) - { -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert cycle node\n"); - lvl_convert_st+=2; -#endif - SgSymbol *constrName = ((SgCycleStmt*)st)->constructName(); - if (constrName) - { - vector labs; - vector labsSt; - createNewLabel(labsSt, labs, constrName->identifier()); - - retSt = new SgGotoStmt(*labs[0]); - } - else - retSt = new SgContinueStmt(); -#if TRACE - lvl_convert_st -= 2; - printfSpaces(lvl_convert_st); - printf("end of convert cycle node\n"); -#endif - needReplace = true; - } - else if (st->variant() == RETURN_STAT) - { -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert return node\n"); - lvl_convert_st += 2; -#endif - retSt = new SgReturnStmt(); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert return node\n"); -#endif - needReplace = true; - } - else - { - retSt = st; - if (st->variant() != CONTROL_END && st->variant() != EXPR_STMT_NODE && first_do_par) - { - printf(" [STMT ERROR: %s, line %d, user line %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[st->variant()]); - if (unSupportedVars.size() != 0) - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - } - } - - if (lvl > 0) - { - if (labSt && retSt) - retSts = make_pair(&retSt->copy(), &labSt->copy()); - else if (labSt) - retSts = make_pair(NULL, &labSt->copy()); - else if (retSt) - retSts = make_pair(&retSt->copy(), NULL); - else - retSts = make_pair(NULL, NULL); - } - else - { - if (retSt) - retSts = make_pair(&retSt->copy(), NULL); - } - return needReplace; -} - -void initSupportedVars() -{ - supportedVars.insert(ADD_OP); - supportedVars.insert(AND_OP); - supportedVars.insert(NOT_OP); - supportedVars.insert(DIV_OP); - supportedVars.insert(EQ_OP); - supportedVars.insert(EQV_OP); - supportedVars.insert(EXP_OP); - supportedVars.insert(GT_OP); - supportedVars.insert(GTEQL_OP); - supportedVars.insert(LT_OP); - supportedVars.insert(LTEQL_OP); - supportedVars.insert(MINUS_OP); - supportedVars.insert(MULT_OP); - supportedVars.insert(NEQV_OP); - supportedVars.insert(NOTEQL_OP); - supportedVars.insert(OR_OP); - supportedVars.insert(SUBT_OP); - supportedVars.insert(UNARY_ADD_OP); - - supportedVars.insert(BOOL_VAL); - supportedVars.insert(DOUBLE_VAL); - supportedVars.insert(FLOAT_VAL); - supportedVars.insert(INT_VAL); - supportedVars.insert(COMPLEX_VAL); - - supportedVars.insert(CONST_REF); - supportedVars.insert(VAR_REF); - - supportedVars.insert(EXPR_LIST); - - supportedVars.insert(FUNC_CALL); -} - -void initF2C_FunctionCalls() -{ - handlersOfFunction[string("abs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("and")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("amod")] = FunctionParam("fmod", 2, &createNewFCall); - handlersOfFunction[string("aimax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("ajmax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("akmax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("aimin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("ajmin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("akmin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("amax1")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("amax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("amin1")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("amin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("aimag")] = FunctionParam("imag", 1, &createNewFCall); - handlersOfFunction[string("alog")] = FunctionParam("log", 1, &createNewFCall); - handlersOfFunction[string("alog10")] = FunctionParam("log10", 1, &createNewFCall); - handlersOfFunction[string("asin")] = FunctionParam("asin", 1, &createNewFCall); - handlersOfFunction[string("asind")] = FunctionParam("asin", 0, &__arc_sincostan_d_handler); - handlersOfFunction[string("asinh")] = FunctionParam("asinh", 1, &createNewFCall); - handlersOfFunction[string("acos")] = FunctionParam("acos", 1, &createNewFCall); - handlersOfFunction[string("acosd")] = FunctionParam("acos", 0, &__arc_sincostan_d_handler); - handlersOfFunction[string("acosh")] = FunctionParam("acosh", 1, &createNewFCall); - handlersOfFunction[string("atan")] = FunctionParam("atan", 1, &createNewFCall); - handlersOfFunction[string("atand")] = FunctionParam("atan", 0, &__arc_sincostan_d_handler); - handlersOfFunction[string("atanh")] = FunctionParam("atanh", 1, &createNewFCall); - handlersOfFunction[string("atan2")] = FunctionParam("atan2", 2, &createNewFCall); - handlersOfFunction[string("atan2d")] = FunctionParam("atan2", 0, &__atan2d_handler); - //intrinsicF.insert(string("aint")); - //intrinsicF.insert(string("anint")); - //intrinsicF.insert(string("achar")); - handlersOfFunction[string("babs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("bbclr")] = FunctionParam("ibclr", 2, &createNewFCall); - handlersOfFunction[string("bdim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("biand")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("bieor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("bior")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("bixor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("btest")] = FunctionParam("btest", 2, &createNewFCall); - handlersOfFunction[string("bbset")] = FunctionParam("ibset", 2, &createNewFCall); - handlersOfFunction[string("bbtest")] = FunctionParam("btest", 2, &createNewFCall); - handlersOfFunction[string("bbits")] = FunctionParam("ibits", 3, &createNewFCall); - handlersOfFunction[string("bitest")] = FunctionParam("btest", 2, &createNewFCall); - handlersOfFunction[string("bjtest")] = FunctionParam("btest", 2, &createNewFCall); - handlersOfFunction[string("bktest")] = FunctionParam("btest", 2, &createNewFCall); - handlersOfFunction[string("bessel_j0")] = FunctionParam("j0", 1, &createNewFCall); - handlersOfFunction[string("bessel_j1")] = FunctionParam("j1", 1, &createNewFCall); - handlersOfFunction[string("bessel_jn")] = FunctionParam("jn", 2, &createNewFCall); - handlersOfFunction[string("bessel_y0")] = FunctionParam("y0", 1, &createNewFCall); - handlersOfFunction[string("bessel_y1")] = FunctionParam("y1", 1, &createNewFCall); - handlersOfFunction[string("bessel_yn")] = FunctionParam("yn", 2, &createNewFCall); - handlersOfFunction[string("bmod")] = FunctionParam("mod", 0, &__mod_handler); - handlersOfFunction[string("bnot")] = FunctionParam("not", 0, &__not_handler); - handlersOfFunction[string("bshft")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("bshftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); - handlersOfFunction[string("bsign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("cos")] = FunctionParam("cos", 1, &createNewFCall); - handlersOfFunction[string("ccos")] = FunctionParam("cos", 1, &createNewFCall); - handlersOfFunction[string("cdcos")] = FunctionParam("cos", 1, &createNewFCall); - handlersOfFunction[string("cosd")] = FunctionParam("cos", 0, &__sindcosdtand_handler); - handlersOfFunction[string("cosh")] = FunctionParam("cosh", 1, &createNewFCall); - handlersOfFunction[string("cotan")] = FunctionParam("tan", 0, &__cotan_handler); - handlersOfFunction[string("cotand")] = FunctionParam("tan", 0, &__cotand_handler); - handlersOfFunction[string("cexp")] = FunctionParam("exp", 1, &createNewFCall); - handlersOfFunction[string("cdexp")] = FunctionParam("exp", 1, &createNewFCall); - handlersOfFunction[string("conjg")] = FunctionParam("conj", 1, &createNewFCall); - handlersOfFunction[string("csqrt")] = FunctionParam("sqrt", 1, &createNewFCall); - handlersOfFunction[string("clog")] = FunctionParam("log", 1, &createNewFCall); - handlersOfFunction[string("clog10")] = FunctionParam("log10", 1, &createNewFCall); - handlersOfFunction[string("cdlog")] = FunctionParam("log", 1, &createNewFCall); - handlersOfFunction[string("cdlog10")] = FunctionParam("log10", 1, &createNewFCall); - handlersOfFunction[string("cdsqrt")] = FunctionParam("sqrt", 1, &createNewFCall); - handlersOfFunction[string("csin")] = FunctionParam("sin", 1, &createNewFCall); - handlersOfFunction[string("ctan")] = FunctionParam("tan", 1, &createNewFCall); - handlersOfFunction[string("cabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("cdabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("cdsin")] = FunctionParam("sin", 1, &createNewFCall); - handlersOfFunction[string("cdtan")] = FunctionParam("tan", 1, &createNewFCall); - handlersOfFunction[string("cmplx")] = FunctionParam("cmplx2", 0, &__cmplx_handler); - //intrinsicF.insert(string("char")); - handlersOfFunction[string("dim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("ddim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("dble")] = FunctionParam("double", 1, &createNewFCall); - handlersOfFunction[string("dfloat")] = FunctionParam("double", 1, &createNewFCall); - handlersOfFunction[string("dfloti")] = FunctionParam("double", 1, &createNewFCall); - handlersOfFunction[string("dflotj")] = FunctionParam("double", 1, &createNewFCall); - handlersOfFunction[string("dflotk")] = FunctionParam("double", 1, &createNewFCall); - //intrinsicF.insert(string("dint")); - handlersOfFunction[string("dmax1")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("dmin1")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("dmod")] = FunctionParam("fmod", 2, &createNewFCall); - handlersOfFunction[string("dprod")] = FunctionParam("dprod", 2, &createNewFCall); - handlersOfFunction[string("dreal")] = FunctionParam("real", 1, &createNewFCall); - handlersOfFunction[string("dsign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("dabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("dsqrt")] = FunctionParam("sqrt", 1, &createNewFCall); - handlersOfFunction[string("dexp")] = FunctionParam("exp", 1, &createNewFCall); - handlersOfFunction[string("derf")] = FunctionParam("erf", 1, &createNewFCall); - handlersOfFunction[string("derfc")] = FunctionParam("erfc", 1, &createNewFCall); - handlersOfFunction[string("dlog")] = FunctionParam("log", 1, &createNewFCall); - handlersOfFunction[string("dlog10")] = FunctionParam("log10", 1, &createNewFCall); - handlersOfFunction[string("dsin")] = FunctionParam("sin", 1, &createNewFCall); - handlersOfFunction[string("dcos")] = FunctionParam("cos", 1, &createNewFCall); - handlersOfFunction[string("dcosd")] = FunctionParam("cos", 0, &__sindcosdtand_handler); - handlersOfFunction[string("dtan")] = FunctionParam("tan", 1, &createNewFCall); - handlersOfFunction[string("dasin")] = FunctionParam("asin", 1, &createNewFCall); - handlersOfFunction[string("dasind")] = FunctionParam("asin", 0, &__arc_sincostan_d_handler); - handlersOfFunction[string("dasinh")] = FunctionParam("asinh", 1, &createNewFCall); - handlersOfFunction[string("dacos")] = FunctionParam("acos", 1, &createNewFCall); - handlersOfFunction[string("dacosd")] = FunctionParam("acos", 0, &__arc_sincostan_d_handler); - handlersOfFunction[string("dacosh")] = FunctionParam("acosh", 1, &createNewFCall); - handlersOfFunction[string("datan")] = FunctionParam("atan", 1, &createNewFCall); - handlersOfFunction[string("datand")] = FunctionParam("atan", 0, &__arc_sincostan_d_handler); - handlersOfFunction[string("datanh")] = FunctionParam("atanh", 1, &createNewFCall); - handlersOfFunction[string("datan2")] = FunctionParam("atan2", 2, &createNewFCall); - handlersOfFunction[string("datan2d")] = FunctionParam("atan2", 0, &__atan2d_handler); - handlersOfFunction[string("dsind")] = FunctionParam("sin", 0, &__sindcosdtand_handler); - handlersOfFunction[string("dsinh")] = FunctionParam("sinh", 1, &createNewFCall); - handlersOfFunction[string("dcosh")] = FunctionParam("cosh", 1, &createNewFCall); - handlersOfFunction[string("dcotan")] = FunctionParam("tan", 0, &__cotan_handler); - handlersOfFunction[string("dcotand")] = FunctionParam("tan", 0, &__cotand_handler); - handlersOfFunction[string("dshiftl")] = FunctionParam("dshiftl", 3, &createNewFCall); - handlersOfFunction[string("dshiftr")] = FunctionParam("dshiftr", 3, &createNewFCall); - handlersOfFunction[string("dtand")] = FunctionParam("tan", 0, &__sindcosdtand_handler); - handlersOfFunction[string("dtanh")] = FunctionParam("tanh", 1, &createNewFCall); - //intrinsicF.insert(string("dnint")); - handlersOfFunction[string("dcmplx")] = FunctionParam("dcmplx2", 0, &__cmplx_handler); - handlersOfFunction[string("dconjg")] = FunctionParam("conj", 1, &createNewFCall); - handlersOfFunction[string("dimag")] = FunctionParam("imag", 1, &createNewFCall); - handlersOfFunction[string("exp")] = FunctionParam("exp", 1, &createNewFCall); - handlersOfFunction[string("erf")] = FunctionParam("erf", 1, &createNewFCall); - handlersOfFunction[string("erfc")] = FunctionParam("erfc", 1, &createNewFCall); - handlersOfFunction[string("erfc_scaled")] = FunctionParam("erfcx", 1, &createNewFCall); - handlersOfFunction[string("float")] = FunctionParam("float", 1, &createNewFCall); - handlersOfFunction[string("floati")] = FunctionParam("float", 1, &createNewFCall); - handlersOfFunction[string("floatj")] = FunctionParam("float", 1, &createNewFCall); - handlersOfFunction[string("floatk")] = FunctionParam("float", 1, &createNewFCall); - handlersOfFunction[string("gamma")] = FunctionParam("tgamma", 1, &createNewFCall); - handlersOfFunction[string("habs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("hbclr")] = FunctionParam("ibclr", 2, &createNewFCall); - handlersOfFunction[string("hbits")] = FunctionParam("ibits", 3, &createNewFCall); - handlersOfFunction[string("hbset")] = FunctionParam("ibset", 2, &createNewFCall); - handlersOfFunction[string("hdim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("hiand")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("hieor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("hior")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("hixor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("hmod")] = FunctionParam("mod", 0, &__mod_handler); - handlersOfFunction[string("hnot")] = FunctionParam("not", 0, &__not_handler); - handlersOfFunction[string("hshft")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("hshftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); - handlersOfFunction[string("hsign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("htest")] = FunctionParam("btest", 2, &createNewFCall); - handlersOfFunction[string("hypot")] = FunctionParam("hypot", 2, &createNewFCall); - handlersOfFunction[string("int")] = FunctionParam("int", 1, &createNewFCall); - handlersOfFunction[string("idint")] = FunctionParam("int", 1, &createNewFCall); - handlersOfFunction[string("ifix")] = FunctionParam("int", 1, &createNewFCall); - handlersOfFunction[string("imag")] = FunctionParam("imag", 1, &createNewFCall); - handlersOfFunction[string("imod")] = FunctionParam("mod", 0, &__mod_handler); - handlersOfFunction[string("inot")] = FunctionParam("not", 0, &__not_handler); - handlersOfFunction[string("idim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("isign")] = FunctionParam("copysign", 2, &createNewFCall); - //intrinsicF.insert(string("index")); - handlersOfFunction[string("iabs")] = FunctionParam("abs", 1, &createNewFCall); - //intrinsicF.insert(string("idnint")); - //intrinsicF.insert(string("ichar")); - handlersOfFunction[string("iand")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("iiabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("iiand")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("iibclr")] = FunctionParam("ibclr", 2, &createNewFCall); - handlersOfFunction[string("iibits")] = FunctionParam("ibits", 3, &createNewFCall); - handlersOfFunction[string("iibset")] = FunctionParam("ibset", 2, &createNewFCall); - handlersOfFunction[string("iidim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("iieor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("iior")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("iishft")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("iishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); - handlersOfFunction[string("iisign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("iixor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("ior")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("ibset")] = FunctionParam("ibset", 2, &createNewFCall); - handlersOfFunction[string("ibclr")] = FunctionParam("ibclr", 2, &createNewFCall); - handlersOfFunction[string("ibchng")] = FunctionParam("ibchng", 2, &createNewFCall); - handlersOfFunction[string("ibits")] = FunctionParam("ibits", 3, &createNewFCall); - handlersOfFunction[string("ieor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("ilen")] = FunctionParam("ilen", 1, &createNewFCall); - handlersOfFunction[string("imax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("imax1")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("imin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("imin1")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("isha")] = FunctionParam("isha", 2, &createNewFCall); - handlersOfFunction[string("ishc")] = FunctionParam("ishc", 2, &createNewFCall); - handlersOfFunction[string("ishft")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("ishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); - handlersOfFunction[string("ishl")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("ixor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("jiabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("jiand")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("jibclr")] = FunctionParam("ibclr", 2, &createNewFCall); - handlersOfFunction[string("jibits")] = FunctionParam("ibits", 3, &createNewFCall); - handlersOfFunction[string("jibset")] = FunctionParam("ibset", 2, &createNewFCall); - handlersOfFunction[string("jidim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("jieor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("jior")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("jishft")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("jishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); - handlersOfFunction[string("jisign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("jixor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("jmax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("jmax1")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("jmin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("jmin1")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("jmod")] = FunctionParam("mod", 0, &__mod_handler); - handlersOfFunction[string("jnot")] = FunctionParam("not", 0, &__not_handler); - handlersOfFunction[string("kiabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("kiand")] = FunctionParam("iand", 0, &__iand_handler); - handlersOfFunction[string("kibclr")] = FunctionParam("ibclr", 2, &createNewFCall); - handlersOfFunction[string("kibits")] = FunctionParam("ibits", 3, &createNewFCall); - handlersOfFunction[string("kibset")] = FunctionParam("ibset", 2, &createNewFCall); - handlersOfFunction[string("kidim")] = FunctionParam("fdim", 2, &createNewFCall); - handlersOfFunction[string("kieor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("kior")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("kishft")] = FunctionParam("ishft", 2, &createNewFCall); - handlersOfFunction[string("kishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); - handlersOfFunction[string("kisign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("kmax0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("kmax1")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("kmin0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("kmin1")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("kmod")] = FunctionParam("mod", 0, &__mod_handler); - handlersOfFunction[string("knot")] = FunctionParam("not", 0, &__not_handler); - //intrinsicF.insert(string("len")); - //intrinsicF.insert(string("lge")); - //intrinsicF.insert(string("lgt")); - //intrinsicF.insert(string("lle")); - //intrinsicF.insert(string("llt")); - handlersOfFunction[string("log_gamma")] = FunctionParam("lgamma", 1, &createNewFCall); - handlersOfFunction[string("log")] = FunctionParam("log", 1, &createNewFCall); - handlersOfFunction[string("log10")] = FunctionParam("log10", 1, &createNewFCall); - handlersOfFunction[string("lshft")] = FunctionParam("lshft", 2, &createNewFCall); - handlersOfFunction[string("lshift")] = FunctionParam("lshft", 2, &createNewFCall); - handlersOfFunction[string("max")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("max0")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("max1")] = FunctionParam("max", 0, &__minmax_handler); - handlersOfFunction[string("merge_bits")] = FunctionParam("merge_bits", 0, &__merge_bits_handler); - handlersOfFunction[string("min")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("min0")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("min1")] = FunctionParam("min", 0, &__minmax_handler); - handlersOfFunction[string("mod")] = FunctionParam("mod", 0, &__mod_handler); - handlersOfFunction[string("modulo")] = FunctionParam("modulo", 0, &__modulo_handler); - handlersOfFunction[string("not")] = FunctionParam("not", 0, &__not_handler); - //intrinsicF.insert(string("nint")); - handlersOfFunction[string("popcnt")] = FunctionParam("popcnt", 1, &createNewFCall); - handlersOfFunction[string("poppar")] = FunctionParam("popcnt", 1, &__poppar_handler); - handlersOfFunction[string("real")] = FunctionParam("real", 1, &createNewFCall); - handlersOfFunction[string("rshft")] = FunctionParam("rshft", 2, &createNewFCall); - handlersOfFunction[string("rshift")] = FunctionParam("rshft", 2, &createNewFCall); - handlersOfFunction[string("or")] = FunctionParam("ior", 0, &__ior_handler); - handlersOfFunction[string("sign")] = FunctionParam("copysign", 2, &createNewFCall); - handlersOfFunction[string("sngl")] = FunctionParam("real", 1, &createNewFCall); - handlersOfFunction[string("sqrt")] = FunctionParam("sqrt", 1, &createNewFCall); - handlersOfFunction[string("sin")] = FunctionParam("sin", 1, &createNewFCall); - handlersOfFunction[string("sind")] = FunctionParam("sin", 0, &__sindcosdtand_handler); - handlersOfFunction[string("sinh")] = FunctionParam("sinh", 1, &createNewFCall); - handlersOfFunction[string("shifta")] = FunctionParam("shifta", 2, &createNewFCall); - handlersOfFunction[string("shiftl")] = FunctionParam("lshft", 2, &createNewFCall); - handlersOfFunction[string("shiftr")] = FunctionParam("shiftr", 2, &createNewFCall); - handlersOfFunction[string("tan")] = FunctionParam("tan", 1, &createNewFCall); - handlersOfFunction[string("tand")] = FunctionParam("tan", 0, &__sindcosdtand_handler); - handlersOfFunction[string("tanh")] = FunctionParam("tanh", 1, &createNewFCall); - handlersOfFunction[string("trailz")] = FunctionParam("trailz", 1, &createNewFCall); - handlersOfFunction[string("xor")] = FunctionParam("ieor", 0, &__ieor_handler); - handlersOfFunction[string("zabs")] = FunctionParam("abs", 1, &createNewFCall); - handlersOfFunction[string("zcos")] = FunctionParam("cos", 1, &createNewFCall); - handlersOfFunction[string("zexp")] = FunctionParam("exp", 1, &createNewFCall); - handlersOfFunction[string("zlog")] = FunctionParam("log", 1, &createNewFCall); - handlersOfFunction[string("zsin")] = FunctionParam("sin", 1, &createNewFCall); - handlersOfFunction[string("zsqrt")] = FunctionParam("sqrt", 1, &createNewFCall); - handlersOfFunction[string("ztan")] = FunctionParam("tan", 1, &createNewFCall); -} - -static void correctLabelsUse(SgStatement *firstStmt, SgStatement *lastStmt) -{ - if (firstStmt == lastStmt) - return; - - SgStatement *copyFSt = firstStmt->lexNext(); - SgStatement *toRem = NULL; - while (copyFSt != lastStmt) - { - if (copyFSt->variant() == LABEL_STAT) - { - if (labels_num.find(BIF_LABEL_USE(copyFSt->thebif)->stateno) == labels_num.end()) - toRem = copyFSt; - } - copyFSt = copyFSt->lexNext(); - if (toRem != NULL) - { - toRem->deleteStmt(); - toRem = NULL; - } - } -} - -SgStatement* Translate_Fortran_To_C(SgStatement *Stmt, bool isSapforConv) -{ -#if TRACE - printf("START: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); -#endif - if (isSapforConv) - { - SAPFOR_CONV = 1; - if (handlersOfFunction.size() == 0) - initF2C_FunctionCalls(); - } - - map redArraysWithUnknownSize; - SgExpression* er = red_list; - for (reduction_operation_list* rsl = red_struct_list; rsl && er; rsl = rsl->next, er = er->rhs()) - if (rsl->redvar_size < 0) - redArraysWithUnknownSize[rsl->redvar->identifier()] = RedFuncNumber(er->lhs()->lhs()); - - SgStatement *copyFSt = Stmt; - SgStatement* last = (Stmt == Stmt->lastNodeOfStmt()) ? Stmt->lastNodeOfStmt() : Stmt->lastExecutable(); - - vector > copyBlock; - labelsExitCycle.clear(); - autoTfmReplacing.clear(); - labels_num.clear(); - cond_generator = 0; - unSupportedVars.clear(); - bool needReplace = false; - pair converted; - -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert Stmt\n"); - lvl_convert_st += 2; -#endif - needReplace = convertStmt(copyFSt, converted, copyBlock, 0, 0, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert Stmt\n"); -#endif - - if (needReplace && !isSapforConv) - { - char *comm = copyFSt->comments(); - if (comm) - converted.first->addComment(comm); - - if (converted.first) - copyFSt->insertStmtBefore(*converted.first, *copyFSt->controlParent()); - - copyFSt->deleteStmt(); - } - - if (first_do_par) - { - for (set::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++) - printf(" [EXPR ERROR: %s, line %d, %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[*i]); - if (unSupportedVars.size() != 0) - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - } - - correctLabelsUse(Stmt, last); - -#if TRACE - printf("END: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); -#endif - - return converted.first; -} - -void Translate_Fortran_To_C(SgStatement *firstStmt, SgStatement *lastStmt, int countOfCopy, SgStatement *st_header) -{ // entry for translating copy of the procedure called from Cuda-kernel - first_do_par = st_header; - SgStatement *save_st = cur_func; - cur_func = st_header; - std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); - - Translate_Fortran_To_C(firstStmt, lastStmt, zero, countOfCopy); - - first_do_par = NULL; - cur_func = save_st; - return; -} - -void Translate_Fortran_To_C(SgStatement *firstStmt, SgStatement *lastStmt, vector > ©Block, int countOfCopy) -{ -#if TRACE - printf("START: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); - lvl_convert_st += 2; -#endif - - map redArraysWithUnknownSize; - SgExpression* er = red_list; - for (reduction_operation_list* rsl = red_struct_list; rsl && er; rsl = rsl->next, er = er->rhs()) - if (rsl->redvar_size < 0) - redArraysWithUnknownSize[rsl->redvar->identifier()] = RedFuncNumber(er->lhs()->lhs()); - - SgStatement *copyFSt = firstStmt->lexNext(); - vector forRemove; - labelsExitCycle.clear(); - autoTfmReplacing.clear(); - labels_num.clear(); - unSupportedVars.clear(); - insertAfter.clear(); - insertBefore.clear(); - replaced.clear(); - cond_generator = 0; - arrayGenNum = 0; - - if (countOfCopy) - copyBlock = vector >(countOfCopy); - - while (copyFSt != lastStmt) - { - bool needReplace = false; - pair converted; -#if TRACE - printfSpaces(lvl_convert_st); - printf("convert Stmt\n"); - lvl_convert_st += 2; -#endif - needReplace = convertStmt(copyFSt, converted, copyBlock, countOfCopy, 0, redArraysWithUnknownSize); -#if TRACE - lvl_convert_st-=2; - printfSpaces(lvl_convert_st); - printf("end of convert Stmt\n"); -#endif - if (needReplace) - { - if (converted.first) - { - char *comm = copyFSt->comments(); - if (comm) - converted.first->addComment(comm); - - copyFSt->insertStmtBefore(*converted.first, *copyFSt->controlParent()); - replaced[converted.first] = copyFSt; - for (int i = 0; i < countOfCopy; ++i) - copyBlock[i].push(&converted.first->copy()); - } - - SgStatement *tmp1 = copyFSt; - forRemove.push_back(tmp1); - setControlLexNext(copyFSt); - } - else - copyFSt = copyFSt->lexNext(); - } - - for (size_t i = 0; i < forRemove.size(); ++i) - forRemove[i]->deleteStmt(); - - for (set::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++) - printf(" [EXPR ERROR: %s, line %d, %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[*i]); - if (unSupportedVars.size() != 0) - Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); - - correctLabelsUse(firstStmt->lexNext(), lastStmt); - - if (options.isOn(AUTO_TFM)) - { - SgStatement* copyFSt = firstStmt->lexNext(); - if (insertAfter.size() || insertBefore.size()) - { - while (copyFSt != lastStmt) - { - SgStatement* key = (replaced.find(copyFSt) != replaced.end()) ? replaced[copyFSt] : copyFSt; - if (insertAfter.find(key) != insertAfter.end()) - { - for (int z = 0; z < insertAfter[key].size(); ++z) - copyFSt->insertStmtAfter(*insertAfter[key][z]); - } - if (insertBefore.find(key) != insertBefore.end()) - { - for (int z = 0; z < insertBefore[key].size(); ++z) - copyFSt->insertStmtBefore(*insertBefore[key][z]); - } - copyFSt = copyFSt->lexNext(); - } - } - } -#if TRACE - lvl_convert_st -= 2; - printf("END: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); -#endif -} - -void ChangeSymbolName(SgSymbol *symb) -{ - char *name = new char[strlen(symb->identifier())+2]; - sprintf(name, "_%s", symb->identifier()); - SYMB_IDENT(symb->thesymb) = name; -} - -void RenamingNewProcedureVariables(SgSymbol *proc_name) -{ - // replacing new procedure names to avoid conflicts with C language keywords and intrinsic function names - SgSymbol *sl; - for(sl = proc_name; sl; sl = sl->next()) - switch(sl->variant()) - { - case VARIABLE_NAME: - case CONST_NAME: - case FIELD_NAME: - case TYPE_NAME: - case LABEL_VAR: - case COMMON_NAME: - case NAMELIST_NAME: - ChangeSymbolName(sl); - break; - default: - break; - } -} - -SgSymbol *hasSameNameAsSource(SgSymbol *symb) -{ - symb_list *sl; - if (!symb) - return NULL; - if (sl=isInSymbListByChar(symb, acc_array_list)) - return sl->symb; - SgExpression *el; - if (newVars.size() != 0) - { - correctPrivateList(RESTORE); - newVars.clear(); - } - for (el = private_list; el; el = el->rhs()) - if (!strcmp(el->lhs()->symbol()->identifier(), symb->identifier())) - return el->lhs()->symbol(); - if (el=isInUsesListByChar(symb->identifier())) - return el->lhs()->symbol(); - for (el = dvm_parallel_dir ? dvm_parallel_dir->expr(2) : NULL; el; el = el->rhs()) - if (!strcmp(el->lhs()->symbol()->identifier(), symb->identifier())) - return el->lhs()->symbol(); - reduction_operation_list *rl; - for (rl = red_struct_list; rl; rl = rl->next) - { - if(rl->redvar && !strcmp(rl->redvar->identifier(), symb->identifier())) - return rl->redvar; - if(rl->locvar && !strcmp(rl->locvar->identifier(), symb->identifier())) - return rl->locvar; - } - return NULL; -} - -int sameVariableName(SgSymbol *symb1, SgSymbol *symb2) -{ - if (!symb1 || !symb2 || (symb1->variant() != VARIABLE_NAME && symb1->variant() != CONST_NAME && symb1->variant() != FUNCTION_NAME) || symb2->variant() != VARIABLE_NAME && symb2->variant() != CONST_NAME && symb2->variant() != FUNCTION_NAME) - return 0; - if (!strcmp (symb1->identifier(), symb2->identifier())) - return 1; - else - return 0; -} - -void replaceSymbolSameNameInExpr(SgExpression *expr, SgSymbol *symb, SgSymbol *s_new) -{ - //SgRecordRefExp *re; - if (!expr || !symb || !s_new) - return; - if (expr->symbol()) - if (sameVariableName(expr->symbol(), symb)) - expr->setSymbol(s_new); - replaceSymbolSameNameInExpr(expr->lhs(), symb, s_new); - replaceSymbolSameNameInExpr(expr->rhs(), symb, s_new); -} - -void replaceVariableSymbSameNameInStatements(SgStatement *first, SgStatement *last, SgSymbol *symb, SgSymbol *s_new, int replace_flag) -{ - SgStatement *stmt; - for (stmt=first; stmt; stmt = stmt->lexNext()) - { - if (sameVariableName (stmt->symbol(), symb)) - stmt->setSymbol(*s_new); - replaceSymbolSameNameInExpr(stmt->expr(0), symb, s_new); - replaceSymbolSameNameInExpr(stmt->expr(1), symb, s_new); - replaceSymbolSameNameInExpr(stmt->expr(2), symb, s_new); - if (last && stmt == last) - break; - } -} - -void RenamingCudaFunctionVariables(SgStatement *first, SgSymbol *k_symb, int replace_flag) -{ // replacing kernel names to avoid conflicts with C language keywords and intrinsic function names - SgSymbol *sl; - for (sl=k_symb->next(); sl; sl=sl->next()) - { - if (sl->scope() != first || sl->variant() != VARIABLE_NAME) - continue; - - SgSymbol *s_symb = hasSameNameAsSource(sl); - if (s_symb) - { - if (replace_flag) - replaceVariableSymbSameNameInStatements(first,first->lastNodeOfStmt(), s_symb, sl, replace_flag); - ChangeSymbolName(sl); - } - } -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c_handlers.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c_handlers.cpp deleted file mode 100644 index b4d9f34..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_f2c_handlers.cpp +++ /dev/null @@ -1,305 +0,0 @@ -#include "dvm.h" - -void __convert_args(SgExpression *expr, SgExpression *&Arg, SgExpression *&Arg1, SgExpression *&Arg2) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - Arg = currArgs->lhs(); - Arg1 = currArgs->rhs()->lhs(); - Arg2 = currArgs->rhs()->rhs()->lhs(); - convertExpr(Arg, Arg); - convertExpr(Arg1, Arg1); - convertExpr(Arg2, Arg2); -} - -void __convert_args(SgExpression *expr, SgExpression *&Arg, SgExpression *&Arg1) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - Arg = currArgs->lhs(); - Arg1 = currArgs->rhs()->lhs(); - convertExpr(Arg, Arg); - convertExpr(Arg1, Arg1); -} - -void __convert_args(SgExpression *expr, SgExpression *&Arg) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - Arg = currArgs->lhs(); - convertExpr(Arg, Arg); -} - -void __cmplx_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - int countArgs = 0; - bool kind = false; - int kind_val = -1; - int kind_pos = -1; - - while (currArgs) - { - if (currArgs->lhs()->variant() == KEYWORD_ARG) - { - kind = true; - kind_val = currArgs->lhs()->rhs()->valueInteger(); - kind_pos = countArgs; - } - countArgs++; - currArgs = currArgs->rhs(); - } - if (kind == false) - { - if (countArgs == 1) - createNewFCall(expr, retExp, name, 1); - else if (countArgs == 2) - createNewFCall(expr, retExp, name, 2); - else if (countArgs == 3) // with KIND - { - kind_val = ((SgFunctionCallExp *)expr)->args()->rhs()->rhs()->lhs()->valueInteger(); - if (kind_val == 4) - createNewFCall(expr, retExp, "cmplx2", 2); - else if (kind_val == 8) - createNewFCall(expr, retExp, "dcmplx2", 2); - else - createNewFCall(expr, retExp, name, 2); - } - } - else // with key word KIND - { - const char *name_kind; - if (kind_val == 4) - name_kind = "cmplx2"; - else if (kind_val == 8) - name_kind = "dcmplx2"; - else - name_kind = name; - - if (countArgs == 2) - createNewFCall(expr, retExp, name_kind, 1); - else if (countArgs == 3) - { - if (kind_pos == 2) - createNewFCall(expr, retExp, name_kind, 2); - else if (kind_pos == 0) - { - SgFunctionCallExp *tmp = new SgFunctionCallExp(*createNewFunctionSymbol(NULL)); - tmp->addArg(*((SgFunctionCallExp *)expr)->args()->rhs()->lhs()); - tmp->addArg(*((SgFunctionCallExp *)expr)->args()->rhs()->rhs()->lhs()); - - createNewFCall(tmp, retExp, name_kind, 2); - } - else - createNewFCall(expr, retExp, "ERROR", 1); - } - } -} - -void __minmax_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - SgFunctionCallExp *retFunc = createNewFCall(name); - //set first 2 agrs - SgExpression *Arg = currArgs->lhs(); - convertExpr(Arg, Arg); - retFunc->addArg(*Arg); - - currArgs = currArgs->rhs(); - Arg = currArgs->lhs(); - convertExpr(Arg, Arg); - retFunc->addArg(*Arg); - - currArgs = currArgs->rhs(); - //create nested MAX/MIN functions - while (currArgs) - { - SgFunctionCallExp *tmp = createNewFCall(name); - tmp->addArg(*retFunc); - Arg = currArgs->lhs(); - convertExpr(Arg, Arg); - tmp->addArg(*Arg); - currArgs = currArgs->rhs(); - retFunc = tmp; - } - retExp = retFunc; -} - -static bool isArgIntType(SgExpression *Arg) -{ - bool res = true; - if (Arg->variant() == VAR_REF) - { - SgType *tmp = Arg->symbol()->type(); - if (tmp->equivalentToType(C_Type(SgTypeDouble())) || - tmp->equivalentToType(C_Type(SgTypeFloat()))) - res = false; - } - else - { - if (Arg->lhs()) - res = res && isArgIntType(Arg->lhs()); - if (Arg->rhs()) - res = res && isArgIntType(Arg->rhs()); - } - return res; -} -//TODO: add more complex analysis above -void __mod_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg, *Arg1; - __convert_args(expr, Arg, Arg1); - if (isArgIntType(Arg) && isArgIntType(Arg1)) - retExp = &(*Arg % *Arg1); - else - { - retExp = createNewFCall("fmod"); - ((SgFunctionCallExp*) retExp)->addArg(*Arg); - ((SgFunctionCallExp*) retExp)->addArg(*Arg1); - } -} - -void __iand_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg, *Arg1; - __convert_args(expr, Arg, Arg1); - retExp = &(*Arg & *Arg1); -} - -void __ior_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg, *Arg1; - __convert_args(expr, Arg, Arg1); - retExp = &(*Arg | *Arg1); -} - -void __ieor_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg, *Arg1; - __convert_args(expr, Arg, Arg1); - - SgExpression *xor_op = new SgExpression(XOR_OP); - xor_op->setLhs(*Arg); - xor_op->setRhs(*Arg1); - retExp = xor_op; -} - -void __arc_sincostan_d_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg; - __convert_args(expr, Arg); - - SgFunctionCallExp *retFunc = createNewFCall(name); - retFunc->addArg(*Arg); - - retExp = &(*retFunc * *new SgValueExp(180.0) / *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI"))); -} - -void __atan2d_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg, *Arg1; - __convert_args(expr, Arg, Arg1); - - SgFunctionCallExp *retFunc = createNewFCall(name); - retFunc->addArg(*Arg); - retFunc->addArg(*Arg1); - - retExp = &(*retFunc * *new SgValueExp(180.0) / *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI"))); -} - -void __sindcosdtand_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg; - __convert_args(expr, Arg); - - SgFunctionCallExp *retFunc = createNewFCall(name); - retFunc->addArg(*Arg * *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI")) / *new SgValueExp(180.0)); - - retExp = retFunc; -} - -void __cotan_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg; - __convert_args(expr, Arg); - - SgFunctionCallExp *retFunc = createNewFCall(name); - retFunc->addArg(*Arg); - - retExp = &(*new SgValueExp(1.0) / *retFunc); -} - -void __cotand_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *Arg; - __convert_args(expr, Arg); - - SgFunctionCallExp *retFunc = createNewFCall(name); - retFunc->addArg(*Arg * *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI")) / *new SgValueExp(180.0)); - - retExp = &(*new SgValueExp(1.0) / *retFunc); -} - -void __ishftc_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); - int countArgs = 0; - - while (currArgs) - { - countArgs++; - currArgs = currArgs->rhs(); - } - switch (countArgs) - { - case 2: - createNewFCall(expr, retExp, "ishc", 2); - break; - case 3: - createNewFCall(expr, retExp, name, 3); - break; - default: - //printf("this function takes 2 or 3 arguments"); - break; - } -} - -void __merge_bits_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression* Arg, * Arg1, * Arg2; - __convert_args(expr, Arg, Arg1, Arg2); - SgExpression *xor_op = new SgExpression(XOR_OP); - xor_op->setLhs(*Arg2); - xor_op->setRhs(*new SgValueExp(-1)); - retExp = &((*Arg & *Arg2) | (*Arg1 & *xor_op)); -} - -void __not_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression* Arg; - __convert_args(expr, Arg); - SgExpression* xor_op = new SgExpression(XOR_OP); - xor_op->setLhs(*Arg); - xor_op->setRhs(*new SgValueExp(-1)); - retExp = xor_op; -} - -void __poppar_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) -{ - SgExpression* Arg; - __convert_args(expr, Arg); - SgFunctionCallExp* func = createNewFCall(name); - func->addArg(*Arg); - retExp = &(*func & *new SgValueExp(1)); -} - -void __modulo_handler(SgExpression* expr, SgExpression*& retExp, const char* name, int nArgs) -{ - SgExpression* Arg, * Arg1; - __convert_args(expr, Arg, Arg1); - SgFunctionCallExp* floor = createNewFCall("floor"); - SgFunctionCallExp* doubleA = createNewFCall("double"); - doubleA->addArg(*Arg); - SgFunctionCallExp* doubleB = createNewFCall("double"); - doubleB->addArg(*Arg1); - floor->addArg(*doubleA / *doubleB); - retExp = &(*Arg - *Arg1 * *floor); -} - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_index_analyzer.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_index_analyzer.cpp deleted file mode 100644 index 14850e3..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_index_analyzer.cpp +++ /dev/null @@ -1,58 +0,0 @@ -#include "acc_data.h" - - -extern SgStatement *kernelScope; -static int indexGenerator = 0; - -SgExpression* analyzeArrayIndxs(SgSymbol *array, SgExpression *listIdx) -{ - SgSymbol *varName = NULL; - char *strNum = new char[32]; - char *strArray, *newStr; - - if (listIdx == NULL || !autoTransform || dontGenConvertXY || oneCase) - return NULL; - else - { - strArray = array->identifier(); - newStr = new char[strlen(strArray) + 32]; - - Array *tArray = currentLoop->getArray(strArray); - if (tArray) - { - char *charEx = NULL; - SgSymbol *tSymb = tArray->findAccess(listIdx, charEx); - if (tSymb == NULL) - { - newStr[0] = '\0'; - strcat(newStr, strArray); - strcat(newStr, "_"); - sprintf(strNum, "%d", (int) indexGenerator); - indexGenerator++; - strcat(newStr, strNum); - - if (C_Cuda) - varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newStr), *C_DvmType(), *kernelScope); - else - { - if (undefined_Tcuda) - { - SgExpression *le; - le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newStr), *new SgType(T_INT, le, SgTypeInt()), *kernelScope); - } - else - varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newStr), *SgTypeInt(), *kernelScope); - } - - tArray->addNewCoef(listIdx, charEx, varName); - } - else - varName = tSymb; - } - } - - delete[]strNum; - return new SgVarRefExp(varName); -} \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_rtc.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_rtc.cpp deleted file mode 100644 index aea3e12..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_rtc.cpp +++ /dev/null @@ -1,390 +0,0 @@ -#include "dvm.h" -#include "acc_data.h" -#include "calls.h" - -//TMP: -extern symb_list *acc_call_list, *by_value_list; - -// create comments of call procedures from each kernel in file _info.c -// if -FTN_Cuda option selected -void ACC_RTC_AddCalledProcedureComment(SgSymbol *symbK) -{ - symb_list *sl; - int len = 0; - for (sl = acc_call_list; sl; sl = sl->next) - len = len + strlen(sl->symb->identifier()) + 1; - - char *list_txt = new char[len + 1]; - list_txt[0] = '\0'; - for (sl = acc_call_list; sl; sl = sl->next) - { - strcat(list_txt, " "); - strcat(list_txt, sl->symb->identifier()); - } - info_block->addComment(CalledProcedureComment(list_txt, symbK)); - -} - -// complete rtc launch parameters from cuda-handlers -void ACC_RTC_CompleteAllParams() -{ - for (unsigned fc = 0; fc < RTC_FCall.size(); ++fc) - { - SgFunctionCallExp *fCall = RTC_FKernelArgs[fc]; - if (fCall->variant() == EXPR_LIST) // if Fortran CUDA - { - fCall = new SgFunctionCallExp(*createNewFunctionSymbol("")); - SgExpression *tmp = RTC_FKernelArgs[fc]; - while (tmp) - { - fCall->addArg(*tmp->lhs()); - tmp = tmp->rhs(); - } - } - - SgExpression *argList = RTC_FArgs[fc]; - for (int k = 0; k < fCall->numberOfArgs(); ++k) - { - SgExpression *currArg = fCall->arg(k); - bool dontCast = false; - - if (currArg->variant() == DEREF_OP) - currArg = currArg->lhs(); - - if (currArg->symbol() == NULL) - { - RTC_FCall[fc]->addArg(*new SgValueExp("")); - argList = argList->rhs(); - continue; - } - std::string tmpN = currArg->symbol()->identifier(); - bool isarray = isSgArrayType(currArg->symbol()->type()); - bool ispointer = isSgPointerType(currArg->symbol()->type()); - bool notbyval = true; - symb_list *sl; - for (sl = by_value_list; sl; sl = sl->next) - { - if (strcmp(sl->symb->identifier(), currArg->symbol()->identifier()) == 0) - { - notbyval = false; - break; - } - } - - bool isinuser = isInUsesListByChar(currArg->symbol()->identifier()); - if (isarray || ispointer || notbyval && isinuser) - { - RTC_FCall[fc]->addArg(*new SgValueExp("")); - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_POINTER"))); - RTC_FCall[fc]->addArg(*argList->lhs()); - } - else - { - SgType *tmp = currArg->symbol()->type(); - - if (tmp->hasBaseType()) - tmp->baseType(); - - unsigned UnFlag = ((SgDescriptType*)tmp)->modifierFlag() & BIT_UNSIGNED; - - SgAttribute *attr = argList->lhs()->getAttribute(0); - bool toAdd = false; - if (attr != NULL) - { - if (attr->getAttributeType() == RTC_NOT_REPLACE) - RTC_FCall[fc]->addArg(*new SgValueExp("")); - else - toAdd = true; - } - else - toAdd = true; - - if (toAdd) - { - if (options.isOn(C_CUDA)) - RTC_FCall[fc]->addArg(*new SgValueExp(currArg->symbol()->identifier())); - else - { - // PGI adds to scalars n__V_ !! - std::string tmp = "n__V_"; - tmp += aks_strlowr(currArg->symbol()->identifier()); - RTC_FCall[fc]->addArg(*new SgValueExp(tmp.c_str())); - } - } - - if (tmp->equivalentToType(C_Type(SgTypeChar())) || tmp->equivalentToType(SgTypeChar())) - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UCHAR"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_CHAR"))); - } - else if (tmp->equivalentToType(C_Type(SgTypeInt())) || (tmp->equivalentToType(SgTypeInt()))) - { - if (isSgDescriptType(tmp)) - { - SgDescriptType *t = (SgDescriptType*)tmp; - int flag = t->modifierFlag(); - if ((flag & BIT_LONG) != 0) - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_ULONG"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LONG"))); - } - else if ((flag & BIT_SHORT) != 0) - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_USHORT"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_SHORT"))); - } - else - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UINT"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_INT"))); - } - } - else - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UINT"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_INT"))); - } - } - else if (tmp->equivalentToType(C_LongType())) - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_ULONG"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LONG"))); - } - else if (tmp->equivalentToType(C_LongLongType())) - { - if (UnFlag) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_ULLONG"))); - else - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LLONG"))); - } - else if (tmp->equivalentToType(C_Type(SgTypeFloat())) || tmp->equivalentToType(SgTypeFloat())) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_FLOAT"))); - else if (tmp->equivalentToType(C_Type(SgTypeDouble())) || tmp->equivalentToType(SgTypeDouble())) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_DOUBLE"))); - else if (tmp->equivalentToType(indexTypeInKernel(rt_INT))) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_INT"))); - else if (tmp->equivalentToType(indexTypeInKernel(rt_LONG))) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LONG"))); - else if (tmp->equivalentToType(indexTypeInKernel(rt_LLONG))) - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LLONG"))); - else if (tmp->equivalentToType(C_Derived_Type(s_cmplx))) - { - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_FLOAT_COMPLEX"))); - - SgSymbol *symb = createNewFunctionSymbol("real"); - RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); - - symb = createNewFunctionSymbol("imag"); - RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); - dontCast = true; - } - else if (tmp->equivalentToType(C_Derived_Type(s_dcmplx))) - { - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_DOUBLE_COMPLEX"))); - - SgSymbol *symb = createNewFunctionSymbol("real"); - RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); - - symb = createNewFunctionSymbol("imag"); - RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); - dontCast = true; - } - else - { - RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UNKNOWN"))); - fprintf(stderr, "Warning[-rtc]: unknown type with variant %d for kernel lauch\n", tmp->variant()); - } - - if (dontCast == false) - RTC_FCall[fc]->addArg(*new SgCastExp(*tmp, *argList->lhs())); - } - - argList = argList->rhs(); - } - } - - RTC_FKernelArgs.clear(); - RTC_FArgs.clear(); - RTC_FCall.clear(); -} - -// convert unparse buffer for RTC call -char* _RTC_convertUnparse(const char* inBuf) -{ - int count = 0; - for (unsigned i = 0; i < strlen(inBuf); ++i) - { - if (SpecialSymbols.find(inBuf[i]) != SpecialSymbols.end()) - count += strlen(SpecialSymbols[inBuf[i]]); - } - - std::string strBuf = ""; - - for (unsigned i = 0; i < strlen(inBuf); ++i) - { - if (SpecialSymbols.find(inBuf[i]) != SpecialSymbols.end()) - { - const char *tmp = SpecialSymbols[inBuf[i]]; - for (unsigned k1 = 0; k1 < strlen(tmp); ++k1) - strBuf.push_back(tmp[k1]); - } - else - strBuf.push_back(inBuf[i]); - } - - strBuf += "#undef dcmplx2\\n\"\n\"#undef cmplx2\\n"; - char *newBuf = new char[strlen(strBuf.c_str()) + 1]; - strcpy(newBuf, strBuf.c_str()); - - return newBuf; -} - -// convert cuda kernel to static const char* -void ACC_RTC_ConvertCudaKernel(SgStatement *cuda_kernel, const char *kernelName) -{ - if (cuda_kernel != NULL) - { - cuda_kernel->addComment("#define dcmplx2 Complex\n#define cmplx2 Complex\nextern \"C\"\n"); - char *buf = copyOfUnparse(UnparseBif_Char(cuda_kernel->thebif, C_LANG)); - char *newBuf = _RTC_convertUnparse(buf); - - SgPointerType *arrType = new SgPointerType(*C_Type(SgTypeChar())); - - SgSymbol *cuda_kernel_code = new SgSymbol(VARIABLE_NAME, kernelName, arrType, mod_gpu); - SgStatement *decl = makeSymbolDeclarationWithInit(cuda_kernel_code, new SgValueExp(newBuf)); - - decl->addDeclSpec(BIT_CONST); - decl->addDeclSpec(BIT_STATIC); - cuda_kernel->insertStmtBefore(*decl); - if(acc_call_list) - { - symb_list **call_list = new (symb_list *); - *call_list = acc_call_list; - decl->addAttribute(RTC_CALLS, (void*)call_list, sizeof(symb_list *)); - } - cuda_kernel->deleteStmt(); - delete[] buf; - } -} - -static symb_list *_RTC_addCalledToList(symb_list *call_list, graph_node *gnode) -{ - edge *gedge; - - for (gedge = gnode->to_called; gedge; gedge = gedge->next) - if(gedge->to->st_header) - { call_list = AddNewToSymbList(call_list, gedge->to->symb); - call_list = _RTC_addCalledToList(call_list, gedge->to); - } - - return call_list; -} - -symb_list *ACC_RTC_ExpandCallList(symb_list *call_list) -{ - symb_list *sl; - for (sl = call_list; sl; sl = sl->next) - { - if (!ATTR_NODE(sl->symb)) - continue; - call_list = _RTC_addCalledToList(call_list, GRAPHNODE(sl->symb)); - } - return call_list; -} - -char* _RTC_PrototypesForKernel(symb_list *call_list) -{ - SgStatement *st = NULL; - symb_list *sl = call_list; - st = FunctionPrototype(GRAPHNODE(sl->symb)->st_copy->symbol()); - st->addDeclSpec(BIT_CUDA_DEVICE); - st->addDeclSpec(BIT_STATIC); - st->addComment("#define dcmplx2 Complex\n#define cmplx2 Complex\n"); - char *buffer = copyOfUnparse(UnparseBif_Char(st->thebif, C_LANG)); - for (sl = call_list->next; sl; sl = sl->next) - { - st = FunctionPrototype(GRAPHNODE(sl->symb)->st_copy->symbol()); - st->addDeclSpec(BIT_CUDA_DEVICE); - st->addDeclSpec(BIT_STATIC); - - char *unp_buf = UnparseBif_Char(st->thebif, C_LANG); - char *buf = new char[strlen(buffer) + strlen(unp_buf) + 1]; - strcpy(buf, buffer); - strcat(buf, unp_buf); - delete[] buffer; - buffer = buf; - } - return (buffer); -} - -void _RTC_UnparsedFunctionsToKernelConst(SgStatement *stmt) -{ - if (CALLED_FUNCTIONS(stmt) == NULL) - return; - - symb_list *call_list = *CALLED_FUNCTIONS(stmt); - - graph_node * gnode = NULL; - char *buffer = _RTC_PrototypesForKernel(call_list); - - for (; call_list; call_list = call_list->next) - { SgStatement *stmt, *end_st; - gnode = GRAPHNODE(call_list->symb); - end_st = gnode->st_copy_first->lastNodeOfStmt()->lexNext(); - stmt = gnode->st_copy; - while (stmt != end_st) //st_copy,...,st_copy_first - { - char *unp_buf = UnparseBif_Char(stmt->thebif, C_LANG); - char *buf = new char[strlen(unp_buf) + strlen(buffer) + 1]; - //buf[0] = '\0'; - strcpy(buf, buffer); - strcat(buf, unp_buf); - delete[] buffer; - buffer = buf; - stmt = stmt->lastNodeOfStmt()->lexNext(); - } - } - buffer = _RTC_convertUnparse(buffer); - - char *kernel_buf = ((SgValueExp *)((SgVarDeclStmt *)stmt)->initialValue(0))->stringValue(); - char *allBuf = new char[strlen(kernel_buf) + strlen(buffer) + 1]; - strcpy(allBuf, buffer); - strcat(allBuf, kernel_buf); - ((SgVarDeclStmt *)stmt)->setInitialValue(0, *new SgValueExp(allBuf)); - delete[] kernel_buf; - delete[] buffer; -} - - -void ACC_RTC_AddFunctionsToKernelConsts(SgStatement *first_kernel_const) -{ - SgStatement *stmt = mod_gpu, *next = NULL; - - for (stmt = first_kernel_const; stmt; stmt = stmt->lexNext()) - _RTC_UnparsedFunctionsToKernelConst(stmt); - stmt = mod_gpu; - next = mod_gpu->lexNext(); - - // extracting function copies - //while(next->variant() != VAR_DECL) - - while (next != first_kernel_const) - { - stmt = next; - next = next->lastNodeOfStmt()->lexNext(); - stmt->extractStmt(); - } - -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_unused_code.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_unused_code.cpp deleted file mode 100644 index d7d6fa4..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_unused_code.cpp +++ /dev/null @@ -1,87 +0,0 @@ -// all unused code -#include "dvm.h" - -/* FROM acc_index_analyzer (aks_structs.cpp) */ -int dimentionOfArray(SgExpression *listIdxIn) -{ - int dim = 0; - SgExpression *listIdx = listIdxIn; - while (listIdx) - { - dim++; - listIdx = listIdx->rhs(); - } - return dim; -} - -bool ifExist(std::vector &listL, char *str) -{ - bool retval = false; - for (size_t i = 0; i < listL.size(); ++i) - { - if (strcmp(str, listL[i]) == 0) - { - retval = true; - break; - } - } - return retval; -} - -int GetIdxPlaceInParDir(SageSymbols *inList, SgSymbol *id) -{ - int ret = -1; - int count = 0; - SageSymbols *tmp = inList; - while (tmp) - { - if (strcmp(tmp->symb->identifier(), id->identifier()) == 0) - { - ret = count; - break; - } - count++; - tmp = tmp->next; - } - return ret; -} -/* END BLOCK */ - -/* FORM acc.app*/ -template SgType *Type_N(SgType *type, char *name); -template -SgType *Type_N(SgType *type, char *name) -{ - SgSymbol *s_t = new SgSymbol(TYPE_NAME, name, *kernel_st); - SgFieldSymb *sx, *sy, *sz, *sw, *s; - - if (numFields >= 1) - s = sx = new SgFieldSymb("x", *type, *s_t); - if (numFields >= 2) - { - s = sy = new SgFieldSymb("y", *type, *s_t); - SYMB_NEXT_FIELD(sx->thesymb) = sy->thesymb; - } - if (numFields >= 3) - { - s = sz = new SgFieldSymb("z", *type, *s_t); - SYMB_NEXT_FIELD(sy->thesymb) = sz->thesymb; - } - if (numFields >= 4) - { - s = sw = new SgFieldSymb("w", *type, *s_t); - SYMB_NEXT_FIELD(sz->thesymb) = sw->thesymb; - } - SYMB_NEXT_FIELD(s->thesymb) = NULL; - - SgType *tstr = new SgType(T_STRUCT); - TYPE_COLL_FIRST_FIELD(tstr->thetype) = sx->thesymb; - s_t->setType(tstr); - - SgType *td = new SgType(T_DERIVED_TYPE); - TYPE_SYMB_DERIVE(td->thetype) = s_t->thesymb; - TYPE_SYMB(td->thetype) = s_t->thesymb; - - return(td); -} -/* END BLOCK */ diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/acc_utilities.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/acc_utilities.cpp deleted file mode 100644 index c096f43..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/acc_utilities.cpp +++ /dev/null @@ -1,1038 +0,0 @@ -/*****************************/ -/* all general functions */ -/*****************************/ -#include "leak_detector.h" - -#include "acc_data.h" -#include "dvm.h" - -using std::string; -using std::set; - -// copy input string to another buffer -char *copyOfUnparse(const char *strUp) -{ - char *str; - str = new char[strlen(strUp) + 1]; - strcpy(str, strUp); - return str; -} - -// convert "str " to "STR " -char* aks_strupr(const char *str) -{ - char *tmpstr = new char[strlen(str) + 1]; - tmpstr[0] = '\0'; - strcat(tmpstr, str); - for (size_t i = 0; i < strlen(tmpstr); ++i) - { - if (tmpstr[i] <= 'z' && tmpstr[i] >= 'a') - tmpstr[i] += 'A' - 'a'; - } - return tmpstr; -} - -// convert "STR" to "str" -char* aks_strlowr(const char *str) -{ - char *tmpstr = new char[strlen(str) + 1]; - tmpstr[0] = '\0'; - strcat(tmpstr, str); - for (size_t i = 0; i < strlen(tmpstr); ++i) - { - if (tmpstr[i] <= 'Z' && tmpstr[i] >= 'A') - tmpstr[i] -= 'A' - 'a'; - } - return tmpstr; -} - -void initIntrinsicFunctionNames() -{ - if (intrinsicF.size() != 0) - return; - - intrinsicF.insert(string("abs")); - intrinsicF.insert(string("adjustl")); - intrinsicF.insert(string("and")); - intrinsicF.insert(string("any")); -#ifdef __SPF - intrinsicF.insert(string("associated")); - intrinsicF.insert(string("allocated")); -#endif - intrinsicF.insert(string("amod")); - intrinsicF.insert(string("aimax0")); - intrinsicF.insert(string("ajmax0")); - intrinsicF.insert(string("akmax0")); - intrinsicF.insert(string("aimin0")); - intrinsicF.insert(string("ajmin0")); - intrinsicF.insert(string("akmin0")); - intrinsicF.insert(string("amax1")); - intrinsicF.insert(string("amax0")); - intrinsicF.insert(string("amin1")); - intrinsicF.insert(string("amin0")); - intrinsicF.insert(string("aimag")); - intrinsicF.insert(string("alog")); - intrinsicF.insert(string("alog10")); - intrinsicF.insert(string("asin")); - intrinsicF.insert(string("asind")); - intrinsicF.insert(string("asinh")); - intrinsicF.insert(string("acos")); - intrinsicF.insert(string("acosd")); - intrinsicF.insert(string("acosh")); - intrinsicF.insert(string("atan")); - intrinsicF.insert(string("atand")); - intrinsicF.insert(string("atanh")); - intrinsicF.insert(string("atan2")); - intrinsicF.insert(string("atan2d")); - intrinsicF.insert(string("aint")); - intrinsicF.insert(string("anint")); - intrinsicF.insert(string("achar")); - intrinsicF.insert(string("babs")); - intrinsicF.insert(string("bbits")); - intrinsicF.insert(string("bbset")); - intrinsicF.insert(string("bdim")); - intrinsicF.insert(string("biand")); - intrinsicF.insert(string("bieor")); - intrinsicF.insert(string("bior")); - intrinsicF.insert(string("bixor")); - intrinsicF.insert(string("btest")); - intrinsicF.insert(string("bbtest")); - intrinsicF.insert(string("bbclr")); - intrinsicF.insert(string("bitest")); - intrinsicF.insert(string("bjtest")); - intrinsicF.insert(string("bktest")); - intrinsicF.insert(string("bessel_j0")); - intrinsicF.insert(string("bessel_j1")); - intrinsicF.insert(string("bessel_jn")); - intrinsicF.insert(string("bessel_y0")); - intrinsicF.insert(string("bessel_y1")); - intrinsicF.insert(string("bessel_yn")); - intrinsicF.insert(string("bmod")); - intrinsicF.insert(string("bnot")); - intrinsicF.insert(string("bshft")); - intrinsicF.insert(string("bshftc")); - intrinsicF.insert(string("bsign")); - intrinsicF.insert(string("cos")); - intrinsicF.insert(string("ccos")); - intrinsicF.insert(string("cdcos")); - intrinsicF.insert(string("cosd")); - intrinsicF.insert(string("cosh")); - intrinsicF.insert(string("cotan")); - intrinsicF.insert(string("cotand")); - intrinsicF.insert(string("ceiling")); - intrinsicF.insert(string("cexp")); - intrinsicF.insert(string("conjg")); - intrinsicF.insert(string("csqrt")); - intrinsicF.insert(string("clog")); - intrinsicF.insert(string("clog10")); - intrinsicF.insert(string("cdlog")); - intrinsicF.insert(string("cdlog10")); - intrinsicF.insert(string("csin")); - intrinsicF.insert(string("cabs")); - intrinsicF.insert(string("cdabs")); - intrinsicF.insert(string("cdexp")); - intrinsicF.insert(string("cdsin")); - intrinsicF.insert(string("cdsqrt")); - intrinsicF.insert(string("cdtan")); - intrinsicF.insert(string("cmplx")); - intrinsicF.insert(string("char")); - intrinsicF.insert(string("ctan")); - intrinsicF.insert(string("cpu_time")); - intrinsicF.insert(string("dim")); - intrinsicF.insert(string("ddim")); - intrinsicF.insert(string("dble")); - intrinsicF.insert(string("dfloat")); - intrinsicF.insert(string("dfloti")); - intrinsicF.insert(string("dflotj")); - intrinsicF.insert(string("dflotk")); - intrinsicF.insert(string("dint")); -#ifdef __SPF - intrinsicF.insert(string("dvtime")); -#endif - intrinsicF.insert(string("dmax1")); - intrinsicF.insert(string("dmin1")); - intrinsicF.insert(string("dmod")); - intrinsicF.insert(string("dprod")); - intrinsicF.insert(string("dreal")); - intrinsicF.insert(string("dsign")); - intrinsicF.insert(string("dshiftl")); - intrinsicF.insert(string("dshiftr")); - intrinsicF.insert(string("dabs")); - intrinsicF.insert(string("dsqrt")); - intrinsicF.insert(string("dexp")); - intrinsicF.insert(string("dlog")); - intrinsicF.insert(string("dlog10")); - intrinsicF.insert(string("dsin")); - intrinsicF.insert(string("dcos")); - intrinsicF.insert(string("dcosd")); - intrinsicF.insert(string("dtan")); - intrinsicF.insert(string("dtand")); - intrinsicF.insert(string("dasin")); - intrinsicF.insert(string("dasind")); - intrinsicF.insert(string("dasinh")); - intrinsicF.insert(string("dacos")); - intrinsicF.insert(string("dacosd")); - intrinsicF.insert(string("dacosh")); - intrinsicF.insert(string("datan")); - intrinsicF.insert(string("datand")); - intrinsicF.insert(string("datanh")); - intrinsicF.insert(string("datan2")); - intrinsicF.insert(string("datan2d")); - intrinsicF.insert(string("derf")); - intrinsicF.insert(string("derfc")); - intrinsicF.insert(string("dsind")); - intrinsicF.insert(string("dsinh")); - intrinsicF.insert(string("dcosh")); - intrinsicF.insert(string("dcotan")); - intrinsicF.insert(string("dcotand")); - intrinsicF.insert(string("dtanh")); - intrinsicF.insert(string("dnint")); - intrinsicF.insert(string("dcmplx")); - intrinsicF.insert(string("dconjg")); - intrinsicF.insert(string("dimag")); - intrinsicF.insert(string("exp")); - intrinsicF.insert(string("erf")); - intrinsicF.insert(string("erfc")); - intrinsicF.insert(string("erfc_scaled")); -#ifdef __SPF - intrinsicF.insert(string("etime")); -#endif - intrinsicF.insert(string("float")); - intrinsicF.insert(string("floati")); - intrinsicF.insert(string("floatj")); - intrinsicF.insert(string("floatk")); - intrinsicF.insert(string("floor")); -#ifdef __SPF - intrinsicF.insert(string("flush")); -#endif - intrinsicF.insert(string("gamma")); - intrinsicF.insert(string("habs")); - intrinsicF.insert(string("hbclr")); - intrinsicF.insert(string("hbits")); - intrinsicF.insert(string("hbset")); - intrinsicF.insert(string("hdim")); - intrinsicF.insert(string("hiand")); - intrinsicF.insert(string("hieor")); - intrinsicF.insert(string("hior")); - intrinsicF.insert(string("hixor")); - intrinsicF.insert(string("hmod")); - intrinsicF.insert(string("hnot")); - intrinsicF.insert(string("hshft")); - intrinsicF.insert(string("hshftc")); - intrinsicF.insert(string("hsign")); - intrinsicF.insert(string("htest")); - intrinsicF.insert(string("huge")); - intrinsicF.insert(string("hypot")); - intrinsicF.insert(string("iiabs")); -#ifdef __SPF - intrinsicF.insert(string("iargc")); -#endif - intrinsicF.insert(string("iiand")); - intrinsicF.insert(string("iibclr")); - intrinsicF.insert(string("iibits")); - intrinsicF.insert(string("iibset")); - intrinsicF.insert(string("iidim")); - intrinsicF.insert(string("iieor")); - intrinsicF.insert(string("iior")); - intrinsicF.insert(string("iishft")); - intrinsicF.insert(string("iishftc")); - intrinsicF.insert(string("iisign")); - intrinsicF.insert(string("iixor")); - intrinsicF.insert(string("int")); - intrinsicF.insert(string("idint")); - intrinsicF.insert(string("ifix")); - intrinsicF.insert(string("idim")); - intrinsicF.insert(string("isign")); - intrinsicF.insert(string("index")); - intrinsicF.insert(string("iabs")); - intrinsicF.insert(string("ibits")); - intrinsicF.insert(string("idnint")); - intrinsicF.insert(string("ichar")); - intrinsicF.insert(string("iachar")); - intrinsicF.insert(string("isnan")); - intrinsicF.insert(string("iand")); - intrinsicF.insert(string("ior")); - intrinsicF.insert(string("ibset")); - intrinsicF.insert(string("ibclr")); - intrinsicF.insert(string("ibchng")); - intrinsicF.insert(string("ieor")); - intrinsicF.insert(string("ilen")); - intrinsicF.insert(string("imag")); - intrinsicF.insert(string("imax0")); - intrinsicF.insert(string("imax1")); - intrinsicF.insert(string("imin0")); - intrinsicF.insert(string("imin1")); - intrinsicF.insert(string("imod")); - intrinsicF.insert(string("inot")); - intrinsicF.insert(string("isha")); - intrinsicF.insert(string("ishc")); - intrinsicF.insert(string("ishft")); - intrinsicF.insert(string("ishftc")); - intrinsicF.insert(string("ishl")); - intrinsicF.insert(string("ixor")); - intrinsicF.insert(string("jiabs")); - intrinsicF.insert(string("jiand")); - intrinsicF.insert(string("jibclr")); - intrinsicF.insert(string("jibits")); - intrinsicF.insert(string("jibset")); - intrinsicF.insert(string("jidim")); - intrinsicF.insert(string("jieor")); - intrinsicF.insert(string("jior")); - intrinsicF.insert(string("jishft")); - intrinsicF.insert(string("jishftc")); - intrinsicF.insert(string("jisign")); - intrinsicF.insert(string("jixor")); - intrinsicF.insert(string("jmax0")); - intrinsicF.insert(string("jmax1")); - intrinsicF.insert(string("jmin0")); - intrinsicF.insert(string("jmin1")); - intrinsicF.insert(string("jmod")); - intrinsicF.insert(string("jnot")); - intrinsicF.insert(string("kiabs")); - intrinsicF.insert(string("kiand")); - intrinsicF.insert(string("kibclr")); - intrinsicF.insert(string("kibits")); - intrinsicF.insert(string("kibset")); - intrinsicF.insert(string("kidim")); - intrinsicF.insert(string("kieor")); - intrinsicF.insert(string("kior")); - intrinsicF.insert(string("kishft")); - intrinsicF.insert(string("kishftc")); - intrinsicF.insert(string("kisign")); - intrinsicF.insert(string("kmax0")); - intrinsicF.insert(string("kmax1")); - intrinsicF.insert(string("kmin0")); - intrinsicF.insert(string("kmin1")); - intrinsicF.insert(string("kmod")); - intrinsicF.insert(string("knot")); - intrinsicF.insert(string("len")); - intrinsicF.insert(string("len_trim")); - intrinsicF.insert(string("lge")); - intrinsicF.insert(string("lgt")); - intrinsicF.insert(string("lle")); - intrinsicF.insert(string("llt")); - intrinsicF.insert(string("log_gamma")); - intrinsicF.insert(string("log")); - intrinsicF.insert(string("log10")); - intrinsicF.insert(string("lshft")); - intrinsicF.insert(string("lshift")); - intrinsicF.insert(string("max")); - intrinsicF.insert(string("max0")); - intrinsicF.insert(string("max1")); - intrinsicF.insert(string("merge_bits")); - intrinsicF.insert(string("min")); -#ifdef __SPF - intrinsicF.insert(string("minval")); - intrinsicF.insert(string("maxval")); -#endif - intrinsicF.insert(string("min0")); - intrinsicF.insert(string("min1")); - intrinsicF.insert(string("mod")); - intrinsicF.insert(string("modulo")); - intrinsicF.insert(string("not")); - intrinsicF.insert(string("nint")); - intrinsicF.insert(string("null")); - intrinsicF.insert(string("or")); - intrinsicF.insert(string("popcnt")); - intrinsicF.insert(string("poppar")); - intrinsicF.insert(string("random_number")); - intrinsicF.insert(string("real")); - intrinsicF.insert(string("reshape")); - intrinsicF.insert(string("present")); - intrinsicF.insert(string("repeat")); - intrinsicF.insert(string("rshft")); - intrinsicF.insert(string("rshift")); - intrinsicF.insert(string("sign")); - intrinsicF.insert(string("size")); - intrinsicF.insert(string("scan")); -#ifdef __SPF - intrinsicF.insert(string("sizeof")); -#endif - intrinsicF.insert(string("sngl")); - intrinsicF.insert(string("sqrt")); - intrinsicF.insert(string("sin")); - intrinsicF.insert(string("sind")); - intrinsicF.insert(string("sinh")); - intrinsicF.insert(string("shifta")); - intrinsicF.insert(string("shiftl")); - intrinsicF.insert(string("shiftr")); -#ifdef __SPF - intrinsicF.insert(string("system_clock")); -#endif - intrinsicF.insert(string("sum")); - intrinsicF.insert(string("tan")); - intrinsicF.insert(string("tand")); - intrinsicF.insert(string("tanh")); - intrinsicF.insert(string("tiny")); - intrinsicF.insert(string("trailz")); - intrinsicF.insert(string("trim")); - intrinsicF.insert(string("xor")); - intrinsicF.insert(string("wtime")); - intrinsicF.insert(string("zabs")); - intrinsicF.insert(string("zcos")); - intrinsicF.insert(string("zexp")); - intrinsicF.insert(string("zlog")); - intrinsicF.insert(string("zsin")); - intrinsicF.insert(string("zsqrt")); - intrinsicF.insert(string("ztan")); - -#ifdef __SPF - //TODO: add all OMP functions - intrinsicF.insert(string("omp_get_wtime")); - intrinsicF.insert(string("omp_get_num_threads")); - intrinsicF.insert(string("omp_destroy_lock")); - intrinsicF.insert(string("omp_destroy_nest_lock")); - intrinsicF.insert(string("omp_get_dynamic")); - intrinsicF.insert(string("omp_get_max_threads")); - intrinsicF.insert(string("omp_get_nested")); - intrinsicF.insert(string("omp_get_num_procs")); - intrinsicF.insert(string("omp_get_thread_num")); - intrinsicF.insert(string("omp_init_lock")); - intrinsicF.insert(string("omp_get_wtick")); - intrinsicF.insert(string("omp_in_parallel")); - intrinsicF.insert(string("omp_init_nest_lock")); - intrinsicF.insert(string("omp_set_dynamic")); - intrinsicF.insert(string("omp_set_lock")); - intrinsicF.insert(string("omp_set_nest_lock")); - intrinsicF.insert(string("omp_set_nested")); - intrinsicF.insert(string("omp_set_num_threads")); - intrinsicF.insert(string("omp_test_lock")); - intrinsicF.insert(string("omp_test_nest_lock")); - intrinsicF.insert(string("omp_unset_lock")); - intrinsicF.insert(string("omp_unset_nest_lock")); - - //TODO: add all MPI functions - intrinsicF.insert("mpi_abort"); - intrinsicF.insert("mpi_address"); - intrinsicF.insert("mpi_allgather"); - intrinsicF.insert("mpi_allgatherv"); - intrinsicF.insert("mpi_allreduce"); - intrinsicF.insert("mpi_alltoall"); - intrinsicF.insert("mpi_alltoallv"); - intrinsicF.insert("mpi_barrier"); - intrinsicF.insert("mpi_bcast"); - intrinsicF.insert("mpi_bsend"); - intrinsicF.insert("mpi_bsend_init"); - intrinsicF.insert("mpi_buffer_attach"); - intrinsicF.insert("mpi_buffer_detach"); - intrinsicF.insert("mpi_cart_coords"); - intrinsicF.insert("mpi_cart_create"); - intrinsicF.insert("mpi_cart_get"); - intrinsicF.insert("mpi_cart_rank"); - intrinsicF.insert("mpi_cart_shift"); - intrinsicF.insert("mpi_cart_sub"); - intrinsicF.insert("mpi_cartdim_get"); - intrinsicF.insert("mpi_comm_create"); - intrinsicF.insert("mpi_comm_dup"); - intrinsicF.insert("mpi_comm_free"); - intrinsicF.insert("mpi_comm_group"); - intrinsicF.insert("mpi_comm_rank"); - intrinsicF.insert("mpi_comm_size"); - intrinsicF.insert("mpi_comm_split"); - intrinsicF.insert("mpi_dims_create"); - intrinsicF.insert("mpi_finalize"); - intrinsicF.insert("mpi_gather"); - intrinsicF.insert("mpi_gatherv"); - intrinsicF.insert("mpi_get_count"); - intrinsicF.insert("mpi_get_processor_name"); - intrinsicF.insert("mpi_graph_create"); - intrinsicF.insert("mpi_graph_get"); - intrinsicF.insert("mpi_graph_neighbors"); - intrinsicF.insert("mpi_graph_neighbors_count"); - intrinsicF.insert("mpi_graphdims_get"); - intrinsicF.insert("mpi_group_compare"); - intrinsicF.insert("mpi_group_difference"); - intrinsicF.insert("mpi_group_excl"); - intrinsicF.insert("mpi_group_free"); - intrinsicF.insert("mpi_group_incl"); - intrinsicF.insert("mpi_group_intersection"); - intrinsicF.insert("mpi_group_rank"); - intrinsicF.insert("mpi_group_size"); - intrinsicF.insert("mpi_group_translate_ranks"); - intrinsicF.insert("mpi_group_union"); - intrinsicF.insert("mpi_ibsend"); - intrinsicF.insert("mpi_init"); - intrinsicF.insert("mpi_initialized"); - intrinsicF.insert("mpi_iprobe"); - intrinsicF.insert("mpi_irecv"); - intrinsicF.insert("mpi_irsend"); - intrinsicF.insert("mpi_isend"); - intrinsicF.insert("mpi_issend"); - intrinsicF.insert("mpi_op_create"); - intrinsicF.insert("mpi_op_free"); - intrinsicF.insert("mpi_pack"); - intrinsicF.insert("mpi_pack_size"); - intrinsicF.insert("mpi_probe"); - intrinsicF.insert("mpi_recv"); - intrinsicF.insert("mpi_recv_init"); - intrinsicF.insert("mpi_reduce"); - intrinsicF.insert("mpi_reduce_scatter"); - intrinsicF.insert("mpi_request_free"); - intrinsicF.insert("mpi_rsend"); - intrinsicF.insert("mpi_rsend_init"); - intrinsicF.insert("mpi_scan"); - intrinsicF.insert("mpi_scatter"); - intrinsicF.insert("mpi_scatterv"); - intrinsicF.insert("mpi_send"); - intrinsicF.insert("mpi_send_init"); - intrinsicF.insert("mpi_sendrecv"); - intrinsicF.insert("mpi_sendrecv_replace"); - intrinsicF.insert("mpi_ssend"); - intrinsicF.insert("mpi_ssend_init"); - intrinsicF.insert("mpi_start"); - intrinsicF.insert("mpi_startall"); - intrinsicF.insert("mpi_test"); - intrinsicF.insert("mpi_testall"); - intrinsicF.insert("mpi_testany"); - intrinsicF.insert("mpi_testsome"); - intrinsicF.insert("mpi_topo_test"); - intrinsicF.insert("mpi_type_commit"); - intrinsicF.insert("mpi_type_contiguous"); - intrinsicF.insert("mpi_type_extent"); - intrinsicF.insert("mpi_type_free"); - intrinsicF.insert("mpi_type_hindexed"); - intrinsicF.insert("mpi_type_hvector"); - intrinsicF.insert("mpi_type_indexed"); - intrinsicF.insert("mpi_type_lb"); - intrinsicF.insert("mpi_type_size"); - intrinsicF.insert("mpi_type_struct"); - intrinsicF.insert("mpi_type_ub"); - intrinsicF.insert("mpi_type_vector"); - intrinsicF.insert("mpi_unpack"); - intrinsicF.insert("mpi_wait"); - intrinsicF.insert("mpi_waitall"); - intrinsicF.insert("mpi_waitany"); - intrinsicF.insert("mpi_waitsome"); - intrinsicF.insert("mpi_wtick"); - intrinsicF.insert("mpi_wtime"); -#endif - - // set Types - intrinsicDoubleT.insert(string("ddim")); - intrinsicDoubleT.insert(string("dble")); - intrinsicDoubleT.insert(string("dfloat")); - intrinsicDoubleT.insert(string("dfloti")); - intrinsicDoubleT.insert(string("dflotj")); - intrinsicDoubleT.insert(string("dflotk")); - intrinsicDoubleT.insert(string("dint")); - intrinsicDoubleT.insert(string("dmax1")); - intrinsicDoubleT.insert(string("dmin1")); - intrinsicDoubleT.insert(string("dmod")); - intrinsicDoubleT.insert(string("dprod")); - intrinsicDoubleT.insert(string("dreal")); - intrinsicDoubleT.insert(string("dsign")); - intrinsicDoubleT.insert(string("dshiftl")); - intrinsicDoubleT.insert(string("dshiftr")); - intrinsicDoubleT.insert(string("dabs")); - intrinsicDoubleT.insert(string("dsqrt")); - intrinsicDoubleT.insert(string("dexp")); - intrinsicDoubleT.insert(string("dlog")); - intrinsicDoubleT.insert(string("dlog10")); - intrinsicDoubleT.insert(string("dsin")); - intrinsicDoubleT.insert(string("dcos")); - intrinsicDoubleT.insert(string("dcosd")); - intrinsicDoubleT.insert(string("dtan")); - intrinsicDoubleT.insert(string("dtand")); - intrinsicDoubleT.insert(string("dasin")); - intrinsicDoubleT.insert(string("dasind")); - intrinsicDoubleT.insert(string("dasinh")); - intrinsicDoubleT.insert(string("dacos")); - intrinsicDoubleT.insert(string("dacosd")); - intrinsicDoubleT.insert(string("dacosh")); - intrinsicDoubleT.insert(string("datan")); - intrinsicDoubleT.insert(string("datand")); - intrinsicDoubleT.insert(string("datanh")); - intrinsicDoubleT.insert(string("datan2")); - intrinsicDoubleT.insert(string("datan2d")); - intrinsicDoubleT.insert(string("derf")); - intrinsicDoubleT.insert(string("derfc")); - intrinsicDoubleT.insert(string("dsind")); - intrinsicDoubleT.insert(string("dsinh")); - intrinsicDoubleT.insert(string("dcosh")); - intrinsicDoubleT.insert(string("dcotan")); - intrinsicDoubleT.insert(string("dcotand")); - intrinsicDoubleT.insert(string("dtanh")); - intrinsicDoubleT.insert(string("dnint")); - intrinsicDoubleT.insert(string("dcmplx")); - intrinsicDoubleT.insert(string("dconjg")); - intrinsicDoubleT.insert(string("dimag")); - - intrinsicFloatT.insert(string("sngl")); - intrinsicFloatT.insert(string("real")); - intrinsicFloatT.insert(string("float")); -} - -//need to extend -int getIntrinsicFunctionType(const char* name) -{ - if (!name) - return 0; - - set::iterator result = intrinsicF.find(name); - if (result == intrinsicF.end()) - return 0; - - if (intrinsicDoubleT.find(name) != intrinsicDoubleT.end()) - return T_DOUBLE; - else if (intrinsicFloatT.find(name) != intrinsicFloatT.end()) - return T_FLOAT; - - return 0; -} - -int isIntrinsicFunctionName(const char *name) -{ - if (!name) - return 0; - - int retval = 1; - set::iterator result = intrinsicF.find(name); - - if (result == intrinsicF.end()) - retval = 0; - - //check for dabs, dtan and etc. - if (retval == 0 && name[0] == 'd') - { - string partName(name + 1); - result = intrinsicF.find(partName); - - if (result != intrinsicF.end()) - retval = 1; - } - - return retval; -} - -SgSymbol *OriginalSymbol(SgSymbol *s) -{ - return((IS_BY_USE(s) ? (s)->moduleSymbol() : s)); -} - -#ifdef __SPF -extern "C" void addToCollection(const int line, const char *file, void *pointer, int type); -#endif - -void addNumberOfFileToAttribute(SgProject *project) -{ - int numOfFiles = project->numberOfFiles(); - for (int i = 0; i < numOfFiles; ++i) - { - SgFile *currF = &(project->file(i)); - string t = currF->filename(); - int *num = new int[1]; -#ifdef __SPF - addToCollection(__LINE__, __FILE__, num, 2); -#endif - num[0] = i; - currF->addAttribute(SG_FILE_ATTR, num, sizeof(int)); - - SgFile::addFile(std::make_pair(currF, i)); - - // fill private info for all statements - for (SgStatement *st = currF->firstStatement(); st; st = st->lexNext()) - { - st->setFileId(i); - st->setProject(project); - } - - for (SgSymbol *sm = currF->firstSymbol(); sm; sm = sm->next()) - { - sm->setFileId(i); - sm->setProject(project); - } - } -} - -// correct private list after CUDA kernel generation -void correctPrivateList(int flag) -{ - if (newVars.size() != 0) - { - if (flag == RESTORE) - { - if (private_list) - { - for (size_t i = 0; i < newVars.size(); ++i) - private_list = private_list->rhs(); - } - } - else if (flag == ADD) - { - for (size_t i = 0; i < newVars.size(); ++i) - { - SgExprListExp *e = new SgExprListExp(*new SgVarRefExp(*newVars[i])); - e->setRhs(private_list); - private_list = e; - } - } - } -} - -// create kernel call functions from HOST: skernel<<< specs>>>( args) -SgFunctionCallExp *cudaKernelCall(SgSymbol *skernel, SgExpression *specs, SgExpression *args = NULL) -{ - SgExpression *fe = new SgExpression(ACC_CALL_OP); - fe->setSymbol(*skernel); - fe->setRhs(*specs); - if (args) - fe->setLhs(*args); - - return (SgFunctionCallExp *)fe; -} - -// create FORTRAN index type in kernel: integer*4 if rt_INT or -// integer*8 if rt_LONG, rt_LLONG -static SgType *FortranIndexType(int rtType) -{ - SgType *type = NULL; - - if (rtType == rt_INT) - { - SgExpression *le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(4)); - type = new SgType(T_INT, le, SgTypeInt()); - } - else if (rtType == rt_LONG || rtType == rt_LLONG) - { - SgExpression *le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - type = new SgType(T_INT, le, SgTypeInt()); - } - return type; -} - -// create cuda index type in kernel for FORTRAN and C -SgType *indexTypeInKernel(int rt_Type) -{ - SgType *ret = NULL; - - if (indexType_int == NULL) - { - s_indexType_int = new SgSymbol(TYPE_NAME, "__indexTypeInt", options.isOn(C_CUDA) ? *block_C_Cuda : *mod_gpu); - s_indexType_int->setType(new SgDescriptType(*SgTypeInt(), BIT_TYPEDEF)); - if (options.isOn(C_CUDA)) - indexType_int = C_Derived_Type(s_indexType_int); - else - { - SgExpression *le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(4)); - indexType_int = new SgType(T_INT, new SgVariableSymb("_int", *FortranIndexType(rt_INT), *mod_gpu), le, SgTypeInt()); - } - } - - if (indexType_long == NULL) - { - s_indexType_long = new SgSymbol(TYPE_NAME, "__indexTypeLong", options.isOn(C_CUDA) ? *block_C_Cuda : *mod_gpu); - s_indexType_long->setType(C_LongType()); - if (options.isOn(C_CUDA)) - indexType_long = C_Derived_Type(s_indexType_long); - else - { - SgExpression *le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - indexType_long = new SgType(T_INT, new SgVariableSymb("_long", *FortranIndexType(rt_LONG), *mod_gpu), le, SgTypeInt()); - } - } - - if (indexType_llong == NULL) - { - s_indexType_llong = new SgSymbol(TYPE_NAME, "__indexTypeLLong", options.isOn(C_CUDA) ? *block_C_Cuda : *mod_gpu); - s_indexType_llong->setType(C_LongLongType()); - if (options.isOn(C_CUDA)) - indexType_llong = C_Derived_Type(s_indexType_llong); - else - { - SgExpression *le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - indexType_llong = new SgType(T_INT, new SgVariableSymb("_llong", *FortranIndexType(rt_LLONG), *mod_gpu), le, SgTypeInt()); - } - } - - if (rt_Type == rt_INT) - ret = indexType_int; - else if (rt_Type == rt_LONG) - ret = indexType_long; - else if (rt_Type == rt_LLONG) - ret = indexType_llong; - - return ret; -} - -// declare DO variables of parallel loop nest in kernel by indexType: rt_INT, rt_LONG, rt_LLONG -void DeclareDoVars(SgType *indexType) -{ - SgStatement *st; - SgExpression *vl, *el; - - // declare do_variables of parallel loop nest - if (options.isOn(C_CUDA)) - { - vl = &(dvm_parallel_dir->expr(2))->copy(); // do_variables list copy - for (el = vl; el; el = el->rhs()) - (el->lhs())->setSymbol(new SgVariableSymb(el->lhs()->symbol()->identifier(), *indexType, *kernel_st)); - st = Declaration_Statement(vl->lhs()->symbol()); // of CudaIndexType - st->setExpression(0, *vl); - kernel_st->insertStmtAfter(*st); - st->addComment("// Local needs"); - } - else // Fortran-Cuda - { - st = indexType->symbol()->makeVarDeclStmt(); // of CudaIndexType - kernel_st->insertStmtAfter(*st); - vl = dvm_parallel_dir->expr(2); // do_variables list - st->setExpression(0, vl->copy()); - st->addComment("! Local needs\n"); - } -} - - -// create dvm coefficient:*0001, *0002 by indexType: rt_INT, rt_LONG, rt_LLONG -static SgExpression *dvm_coef(SgSymbol *ar, int i, SgType *indeTypeInKernel) -{ - SgVarRefExp *ret = NULL; - if (options.isOn(C_CUDA)) - { - SgSymbol *s_dummy_coef = new SgSymbol(VARIABLE_NAME, AR_COEFFICIENTS(ar)->sc[i]->identifier(), *indeTypeInKernel, *kernel_st); - ret = new SgVarRefExp(*s_dummy_coef); - } - else - ret = new SgVarRefExp(*(AR_COEFFICIENTS(ar)->sc[i])); - return ret; -} - -// create array list by indexType: rt_INT, rt_LONG, rt_LLONG -SgExpression *CreateArrayDummyList(SgType *indeTypeInKernel) -{ - symb_list *sl; - SgExpression *ae, *coef_list, *edim; - int n, d; - SgExpression *arg_list = NULL; - - edim = new SgExprListExp(); // [] dimension - - for (sl = acc_array_list; sl; sl = sl->next) // + base_ref + - { - SgSymbol *s_dummy; - s_dummy = KernelDummyArray(sl->symb); - if (options.isOn(C_CUDA)) - ae = new SgArrayRefExp(*s_dummy, *edim); - else - ae = new SgArrayRefExp(*s_dummy); - ae->setType(s_dummy->type()); //for C_Cuda - ae = new SgExprListExp(*ae); - - arg_list = AddListToList(arg_list, ae); - coef_list = NULL; - if (Rank(sl->symb) == 0) //remote_access buffer may be of rank 0 - continue; - d = options.isOn(AUTO_TFM) ? 0 : 1; - for (n = Rank(sl->symb) - d; n>0; n--) - { - ae = new SgExprListExp(*dvm_coef(sl->symb, n + 1, indeTypeInKernel)); - coef_list = AddListToList(coef_list, ae); - } - - arg_list = AddListToList(arg_list, coef_list); - } - return(arg_list); - -} - - -// create local parts of array list by indexType: rt_INT, rt_LONG, rt_LLONG -SgSymbol *KernelDummyLocalPart(SgSymbol *s, SgType *indeTypeInKernel) -{ - SgArrayType *typearray; - SgType *type; - - // for C_Cuda - typearray = new SgArrayType(*indeTypeInKernel); - typearray->addDimension(NULL); - type = typearray; - - return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); - -} - -SgExpression *CreateLocalPartList(SgType *indeTypeInKernel) -{ - local_part_list *pl; - SgExpression *ae; - SgExpression *arg_list = NULL; - for (pl = lpart_list; pl; pl = pl->next) // + - { - if (options.isOn(C_CUDA)) - ae = new SgExprListExp(*new SgArrayRefExp(*KernelDummyLocalPart(pl->local_part, indeTypeInKernel), - *new SgExprListExp())); //[] - else - ae = new SgExprListExp(*new SgArrayRefExp(*pl->local_part)); - arg_list = AddListToList(arg_list, ae); - } - return(arg_list); - -} - -// create two kernel calls (for rt_INT and rt_LLONG) in CUDA_handeler by base kernel function. -// return if(rt_INT) kernel<<< >>>() else kernel2<<< >>>() -SgStatement* createKernelCallsInCudaHandler(SgFunctionCallExp *baseFunc, SgSymbol *s_loop_ref, SgSymbol *idxTypeInKernel, SgSymbol *s_blocks) -{ - SgStatement *stmt = NULL; - std::string fcall_INT = baseFunc->symbol()->identifier(); - std::string fcall_LLONG = baseFunc->symbol()->identifier(); - fcall_INT += "_int"; - fcall_LLONG += "_llong"; - - SgExpression *args = baseFunc->args(); - - SgFunctionCallExp *funcCall_int = cudaKernelCall(new SgSymbol(VARIABLE_NAME, fcall_INT.c_str()), baseFunc->rhs()); - SgFunctionCallExp *funcCall_llong = cudaKernelCall(new SgSymbol(VARIABLE_NAME, fcall_LLONG.c_str()), baseFunc->rhs()); - - while (args) - { - bool flag = false; - if (args->lhs()->symbol()) - { - if (strcmp(args->lhs()->symbol()->identifier(), "blocks_info") == 0) - { - funcCall_int->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_INT)), *args->lhs())); - funcCall_llong->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_LLONG)), *args->lhs())); - flag = true; - } - - if (args->lhs()->getAttribute(0) != NULL) - { - SgAttribute *att = args->lhs()->getAttribute(0); - if (att->getAttributeSize() == 777) - { - funcCall_int->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_INT)), *args->lhs())); - funcCall_llong->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_LLONG)), *args->lhs())); - flag = true; - args->lhs()->deleteAttribute(0); - } - } - } - - if (flag == false) - { - funcCall_int->addArg(*args->lhs()); - funcCall_llong->addArg(*args->lhs()); - } - args = args->rhs(); - } - - if (options.isOn(RTC)) - { - SgFunctionCallExp *rtc_FCall_INT = new SgFunctionCallExp(*createNewFunctionSymbol("loop_cuda_rtc_launch")); - rtc_FCall_INT->addArg(*new SgVarRefExp(s_loop_ref)); - rtc_FCall_INT->addArg(*new SgValueExp(fcall_INT.c_str())); - rtc_FCall_INT->addArg(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, fcall_INT.c_str()))); - rtc_FCall_INT->addArg(SgAddrOp(*new SgVarRefExp(s_blocks))); - rtc_FCall_INT->addArg(*new SgValueExp(baseFunc->numberOfArgs())); - - RTC_FArgs.push_back(baseFunc->args()); - RTC_FCall.push_back(rtc_FCall_INT); - - SgFunctionCallExp *rtc_FCall_LLONG = new SgFunctionCallExp(*createNewFunctionSymbol("loop_cuda_rtc_launch")); - rtc_FCall_LLONG->addArg(*new SgVarRefExp(s_loop_ref)); - rtc_FCall_LLONG->addArg(*new SgValueExp(fcall_LLONG.c_str())); - rtc_FCall_LLONG->addArg(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, fcall_LLONG.c_str()))); - rtc_FCall_LLONG->addArg(SgAddrOp(*new SgVarRefExp(s_blocks))); - rtc_FCall_LLONG->addArg(*new SgValueExp(baseFunc->numberOfArgs())); - - RTC_FArgs.push_back(baseFunc->args()); - RTC_FCall.push_back(rtc_FCall_LLONG); - } - - if (options.isOn(RTC)) - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), - *new SgCExpStmt(*RTC_FCall[RTC_FCall.size() - 2]), *new SgCExpStmt(*RTC_FCall[RTC_FCall.size() - 1])); - else - stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), - *new SgCExpStmt(*funcCall_int), *new SgCExpStmt(*funcCall_llong)); - return stmt; -} - -static string getValue(SgExpression *exp) -{ - if (exp == NULL) - return ""; - - string ret = ""; - if (exp->symbol()) - { - if (exp->symbol()->identifier()) - ret = "(" + string(exp->symbol()->identifier()) + ")"; - } - else if (exp->variant() == INT_VAL) - { - char buf[256]; - sprintf(buf, "%d", exp->valueInteger()); - ret = "(" + string(buf) + ")"; - } - else if (exp->variant() == ADD_OP) - ret = "(+)"; - else if (exp->variant() == SUBT_OP) - ret = "(-)"; - else if (exp->variant() == MULT_OP) - ret = "(*)"; - else if (exp->variant() == DIV_OP) - ret = "(/)"; - else if (exp->variant() == MOD_OP) - ret = "(mod)"; - else if (exp->variant() == EXP_OP) - ret = "(**)"; - else if (exp->variant() == KEYWORD_VAL) - ret = "(" + string(((SgKeywordValExp*)exp)->value()) + ")"; - return ret; -} - -static void recExpressionPrint(SgExpression* exp, const int lvl, const char* LR, const int currNum, int& allNum) -{ - if (exp) - { - SgExpression* lhs = exp->lhs(); - SgExpression* rhs = exp->rhs(); - int lNum, rNum; - - string vCurr = getValue(exp); - string vL = getValue(lhs); - string vR = getValue(rhs); - - if (lhs && rhs) - { - lNum = allNum + 1; - rNum = allNum + 2; - allNum += 2; - printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_L_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), lNum, lvl + 1, tag[lhs->variant()], vL.c_str()); - printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_R_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), rNum, lvl + 1, tag[rhs->variant()], vR.c_str()); - } - else if (lhs) - { - lNum = allNum + 1; - allNum++; - printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_L_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), lNum, lvl + 1, tag[lhs->variant()], vL.c_str()); - } - else if (rhs) - { - rNum = allNum + 1; - allNum++; - printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_R_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), rNum, lvl + 1, tag[rhs->variant()], vR.c_str()); - } - if (lhs) - recExpressionPrint(lhs, lvl + 1, "L", lNum, allNum); - if (rhs) - recExpressionPrint(rhs, lvl + 1, "R", rNum, allNum); - } -} - -void recExpressionPrintFdvm(SgExpression *exp) -{ - printf("digraph G{\n"); - int allNum = 0; - recExpressionPrint(exp, 0, "L", allNum, allNum); - if (allNum == 0 && exp) - printf("\"%d_%d_%s_%s_%s\";\n", allNum, 0, "L", tag[exp->variant()], getValue(exp).c_str()); - printf("}\n"); - fflush(NULL); -} \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/aks_analyzeLoops.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/aks_analyzeLoops.cpp deleted file mode 100644 index 5de45e2..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/aks_analyzeLoops.cpp +++ /dev/null @@ -1,2567 +0,0 @@ -#include "dvm.h" -#include "aks_structs.h" -#include "acc_data.h" - -// extern block vars -extern SgStatement *loop_body, *dvm_parallel_dir, *first_do_par; - -// extern block functions -extern void correctPrivateList(int); - -// local block vars -static std::vector scalar_stmts; -static bool only_scalar; -static bool operation; - -// local functions -SgExpression *preCalculate(SgExpression*); -SgExpression *correctDvmDirPattern(SgExpression*, SgExpression*); - -// for countInDims -static int leftBound; -static int rightBound; -static bool existLB; -static bool existRB; - -//for analyzeVarRef -static std::vector lBound; -static std::vector rBound; -static std::vector globalStep; -static std::vector symbolsOfForNode; -static std::vector actualDocycle; -static std::vector loopMultCount; - -static FILE *file; -static FILE *fileStmts; - -static std::stack controlEndsOfIfStmt; -static std::stack controlEndsOfForStmt; - -static unsigned generator = 0; -static bool unknownLoop = false; - -//global variables -std::vector loopVars; -ArrayIntents regionArrayInfo; -LoopInfo currentLoopInfo; - -void printEXP(SgExpression *ex, int what, int lvl) -{ - if(what == 3) - printf("ROOT var %d lvl %d\n", ex->variant(), lvl); - else if(what == 2) - printf("LHS var %d lvl %d\n", ex->variant(), lvl); - else - printf("RHS var %d lvl %d\n", ex->variant(),lvl); - if(ex->lhs()) - printEXP(ex->lhs(), 2, lvl+1); - if(ex->rhs()) - printEXP(ex->rhs(), 1, lvl+1); -} - -void fprintEXP(SgExpression *ex, int what, int lvl) -{ - if(what == 3) - fprintf(file, "ROOT var %d lvl %d\n", ex->variant(), lvl); - else if(what == 2) - fprintf(file, "LHS var %d lvl %d\n", ex->variant(), lvl); - else - fprintf(file, "RHS var %d lvl %d\n", ex->variant(),lvl); - if(ex->lhs()) - fprintEXP(ex->lhs(), 2, lvl+1); - if(ex->rhs()) - fprintEXP(ex->rhs(), 1, lvl+1); -} - -void createDoAssigns(AnalyzeStat ¤tStat, std::vector &newSymbs, SgExpression *arrayRef, int dim, int dimNew, BestPattern &pattern, std::vector &writeStmts, std::vector &readStmts) -{ - SgForStmt *forStmtR = NULL, *forStmtW = NULL; - int leftBound; - int rightBound; - bool exL = false; - bool exR = false; - int wasFirst = 0; - - if(dimNew >= 1) - { - SgArrayType *tpArrNew = new SgArrayType(*arrayRef->symbol()->type()); - for(size_t i = 0; i < pattern.what.size(); ++i) - { - if(pattern.what[i] < 0) - { - if(pattern.bounds[i].ifDdot) - { - SgExprListExp *ex = new SgExprListExp(DDOT); - ex->setLhs(*new SgValueExp(pattern.bounds[i].L)); - ex->setRhs(*new SgValueExp(pattern.bounds[i].R)); - tpArrNew->addDimension(ex); - } - else - tpArrNew->addDimension(new SgValueExp(abs(pattern.bounds[i].R - pattern.bounds[i].L) + 1)); - } - } - - SgExpression *subsc = arrayRef->lhs(); - SgSymbol *symbArray = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(arrayRef->symbol()->identifier())); - - symbArray->setType(tpArrNew); - - SgArrayRefExp *newArray = new SgArrayRefExp(*symbArray); - SgArrayRefExp *oldArray = new SgArrayRefExp(*arrayRef->symbol()); - SgArrayRefExp *newArray1 = new SgArrayRefExp(*symbArray); - SgArrayRefExp *oldArray1 = new SgArrayRefExp(*arrayRef->symbol()); - - SgStatement *stmtW = new SgAssignStmt(*oldArray, *newArray); - SgStatement *stmtR = new SgAssignStmt(*newArray1, *oldArray1); - - for(size_t i = 0; i < pattern.what.size(); ++i) - { - exL = exR = false; - char *idx = new char[32]; - char *number = new char[32]; - idx[0] = number[0] = '\0'; - strcat(idx, arrayRef->symbol()->identifier()); - strcat(idx, "_"); - strcat(idx, "m"); - number[sprintf(number, "%u", (unsigned)i)] = 0; - strcat(idx, number); - - if(pattern.what[i] < 0) - { - SgSymbol *doVarName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(idx)); - newSymbs.push_back(doVarName); - - leftBound = pattern.bounds[i].L; - rightBound = pattern.bounds[i].R; - exL = exR = true; - - if(leftBound > rightBound) - { - int tmp = rightBound; - rightBound = leftBound; - leftBound = tmp; - } - - if(exL && exR) - { - if(wasFirst == 0) - { - forStmtR = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), stmtR); - forStmtW = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), stmtW); - wasFirst = 1; - } - else - { - forStmtR = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), forStmtR); - forStmtW = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), forStmtW); - } - if(pattern.bounds[i].additionalExpr) - { - SgExpression *ex = new SgExpression(SUBT_OP); - ex->setLhs(pattern.bounds[i].additionalExpr); - ex->setRhs(pattern.bounds[i].additionalExpr); - SgExpression *res = preCalculate(ex); - res = Calculate(res); - - oldArray->addSubscript(subsc->lhs()->copy() + *new SgValueExp(res->valueInteger()) + *new SgVarRefExp(*doVarName)); - oldArray1->addSubscript(subsc->lhs()->copy() + *new SgValueExp(res->valueInteger()) + *new SgVarRefExp(*doVarName)); - } - else - { - oldArray->addSubscript(*new SgVarRefExp(*doVarName)); - oldArray1->addSubscript(*new SgVarRefExp(*doVarName)); - } - newArray->addSubscript(*new SgVarRefExp(*doVarName)); - newArray1->addSubscript(*new SgVarRefExp(*doVarName)); - } - } - else - { - oldArray->addSubscript(subsc->lhs()->copy()); - oldArray1->addSubscript(subsc->lhs()->copy()); - } - subsc = subsc->rhs(); - } - - readStmts.push_back(forStmtR); - writeStmts.push_back(forStmtW); - newSymbs.push_back(symbArray); - currentStat.replaceSymbol = symbArray; - currentStat.ifHasDim = 1; - } - else if(dimNew == 0) - { - SgArrayRefExp *oldArray = new SgArrayRefExp(*arrayRef->symbol()); - SgExpression *subsc = arrayRef->lhs(); - for(int i = 0; i < dim; ++i) - { - oldArray->addSubscript(subsc->lhs()->copy()); - subsc = subsc->rhs(); - } - - SgArrayRefExp *oldArray1 = new SgArrayRefExp(*arrayRef->symbol()); - subsc = arrayRef->lhs(); - for(int i = 0; i < dim; ++i) - { - oldArray1->addSubscript(subsc->lhs()->copy()); - subsc = subsc->rhs(); - } - - SgSymbol *scalar = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(arrayRef->symbol()->identifier())); - scalar->setType(arrayRef->symbol()->type()->baseType()); - - SgStatement *stmtW = new SgAssignStmt(*oldArray, *new SgVarRefExp(scalar)); - SgStatement *stmtR = new SgAssignStmt(*new SgVarRefExp(scalar), *oldArray1); - - readStmts.push_back(stmtR); - writeStmts.push_back(stmtW); - newSymbs.push_back(scalar); - currentStat.replaceSymbol = scalar; - currentStat.ifHasDim = 0; - } -} - -int findPattern(SgExpression *patt, AnalyzeStat &Stat) -{ - bool noEq = true; - int num = -1; - for(size_t i = 0; i < Stat.patterns.size(); ++i) - { - if(ExpCompare(patt, Stat.patterns[i].symbs) == 1) - { - noEq = false; - num = i; - break; - } - } - return num; -} - -void replaceInExpr(SgExpression *ex, SgExpression *by, int nested) -{ - if(ex) - { - bool L = false; - bool R = false; - if(ex->lhs()) - { - if(ex->lhs()->variant() == VAR_REF) - { - if(ex->lhs()->symbol() == symbolsOfForNode[nested]) - ex->setLhs(by); - } - L = true; - } - if(ex->rhs()) - { - if(ex->rhs()->variant() == VAR_REF) - { - if(ex->rhs()->symbol() == symbolsOfForNode[nested]) - ex->setRhs(by); - } - R = true; - } - if(L) - replaceInExpr(ex->lhs(), by, nested); - if(R) - replaceInExpr(ex->rhs(), by, nested); - } -} - -void _setsetPatternSymbs(int plus, bool &change, SgExpression *lBound, SgExpression *parent, int where_) -{ - if(lBound->variant() != INT_VAL) - { - if(lBound->lhs()) - _setsetPatternSymbs(plus, change, lBound->lhs(), lBound, 0); - if(lBound->rhs()) - _setsetPatternSymbs(plus, change, lBound->rhs(), lBound, 1); - } - else - { - plus += lBound->valueInteger(); - if(where_ == 0) - parent->setLhs(*new SgValueExp(plus)); - if(where_ == 1) - parent->setRhs(*new SgValueExp(plus)); - if(where_ == -1) - lBound = new SgValueExp(plus); - change = true; - } -} - -void setPatternSymbs(SgExpression *patt, SgExpression *in, int plus, int nested) -{ - SgExpression *returnEx = patt; - SgExpression *localLB = new SgExpression(EXPR_LIST); - localLB->setLhs(&lBound[nested]->copy()); - bool change = false; - _setsetPatternSymbs(plus, change, localLB, localLB, -1); - localLB = localLB->lhs(); - - SgExpression *replace = Calculate(localLB); - while(in) - { - SgExpression *newEx = new SgExpression(EXPR_LIST); - newEx->setLhs(&in->lhs()->copy()); - replaceInExpr(newEx, replace, nested); - newEx = newEx->lhs(); - - patt->setLhs(newEx); - in = in->rhs(); - if(in) - { - patt->setRhs(new SgExprListExp()); - patt = patt->rhs(); - } - } - patt = returnEx; -} - -// -SgExpression* findReplaceEx(SgSymbol *s) -{ - SgExpression *returnEx = NULL; - if(scalar_stmts.size() != 0) - { - for(int i = scalar_stmts.size() - 1; i >= 0; i--) - { - if(scalar_stmts[i]->expr(0)->symbol() == s) - { - returnEx = scalar_stmts[i]->expr(1); - break; - } - } - } - return returnEx; -} - -void ifNeedReplace(SgExpression *s, SgExpression *parent, int where_) -{ - if(s->variant() == VAR_REF) - { - bool ifN = false; - bool ifInAllSymb = false; - for (size_t i = 0; i < symbolsOfForNode.size(); ++i) - { - if (symbolsOfForNode[i] == s->symbol()) - { - ifInAllSymb = true; - break; - } - } - // if symbol isnt FOR symbol - if(ifInAllSymb == false) - { - for(size_t i = 0; i < loopVars.size(); ++i) - { - if(loopVars[i] != s->symbol()) - { - ifN = true; - break; - } - } - - if(ifN) // replace - { - SgExpression *find = findReplaceEx(s->symbol()); - if(find) - { - if(where_ == 0) - parent->setLhs(find); - else if(where_ == 1) - parent->setRhs(find); - } - } - } - } - else - { - if(s->lhs()) - ifNeedReplace(s->lhs(), s, 0); - if(s->rhs()) - ifNeedReplace(s->rhs(), s, 1); - } -} - -void correctIdxOfArraRef(SgExpression *ex) -{ - SgExpression *tmp = ex->lhs(); - while(tmp) - { - ifNeedReplace(tmp->lhs(), tmp, 0); - tmp = tmp->rhs(); - } -} - -void insertLoopVariatns(std::vector &allStat, int num, bool _new, SgSymbol *s, SgExpression *ex, int nested) -{ - if (actualDocycle[nested]) - { - for (int i = 0; i < loopMultCount[nested]; ++i) - { - SgExpression *pattTmp = new SgExprListExp(); - setPatternSymbs(pattTmp, &ex->lhs()->copy(), globalStep[nested] * i, nested); - if (nested == (int)actualDocycle.size() - 1) - { - if (_new) - { - Pattern p; - p.count_read_op = 0; - p.count_write_op = 0; - if (operation == READ) - p.count_read_op = 1; - else - p.count_write_op = 1; - p.symbs = pattTmp; - allStat[num].patterns.push_back(p); - } - else - { - int num_p = findPattern(pattTmp, allStat[num]); - if (num_p == -1) - { - Pattern p; - p.count_read_op = 0; - p.count_write_op = 0; - if (operation == READ) - p.count_read_op = 1; - else - p.count_write_op = 1; - p.symbs = pattTmp; - allStat[num].patterns.push_back(p); - } - else - { - if (operation == READ) - allStat[num].patterns[num_p].count_read_op++; - else - allStat[num].patterns[num_p].count_write_op++; - } - } - } - else - insertLoopVariatns(allStat, num, _new, s, ex, nested + 1); - } - } - else if (nested != (int)actualDocycle.size() - 1) - insertLoopVariatns(allStat, num, _new, s, ex, nested + 1); -} - -void analyzeVarRef(std::set &private_vars, std::vector &allStat, SgSymbol *s, SgExpression *ex) -{ - bool inPrivateList = private_vars.find(s) != private_vars.end(); - - if(isSgArrayType(s->type()) && !inPrivateList) // if array ref - { - bool inList = false; - int num = -1; - - correctIdxOfArraRef(ex); - only_scalar = false; - for(size_t i = 0; i < allStat.size(); ++i) - { - if(allStat[i].name_of_array == s) - { - inList = true; - num = i; - break; - } - } - - if(!inList) - { - AnalyzeStat tmp; - tmp.name_of_array = s; - tmp.ex_name_of_array = ex; - allStat.push_back(tmp); - int newNum = allStat.size() - 1; - - // if stmt in loops - if(symbolsOfForNode.size() != 0) - insertLoopVariatns(allStat, newNum, true, s, ex, 0); - else - { - Pattern p; - p.count_read_op = 0; - p.count_write_op = 0; - if(operation == READ) - p.count_read_op = 1; - else - p.count_write_op = 1; - p.symbs = ex->lhs(); - allStat[newNum].patterns.push_back(p); - } - - } - else - { - // if stmt in loops - if(symbolsOfForNode.size() != 0) - insertLoopVariatns(allStat, num, false, s, ex, 0); - else - { - int num_p = findPattern(ex->lhs(), allStat[num]); - if(num_p == -1) - { - Pattern p; - p.count_read_op = 0; - p.count_write_op = 0; - if(operation == READ) - p.count_read_op = 1; - else - p.count_write_op = 1; - p.symbs = ex->lhs(); - allStat[num].patterns.push_back(p); - } - else - { - if(operation == READ) - allStat[num].patterns[num_p].count_read_op ++; - else - allStat[num].patterns[num_p].count_write_op ++; - } - } - } - } -} - -void analyzeRightAssing(std::set &private_vars, std::vector &allStat, SgExpression *ex) -{ - //printf("var %d\n", ex->variant()); - if(ex->variant() != ARRAY_REF) - { - if(ex->lhs()) - analyzeRightAssing(private_vars, allStat, ex->lhs()); - if(ex->rhs()) - analyzeRightAssing(private_vars, allStat, ex->rhs()); - } - else - analyzeVarRef(private_vars, allStat, ex->symbol(), ex); -} - -void findBest(std::vector &allStat, std::vector &best, SgExpression *dvm_dir_pattern) -{ - for(size_t i = 0; i < allStat.size(); ++i) - { - int count = 0; - size_t first = allStat[i].patterns.size() + 1; - SgExpression *ex = NULL; - std::vector flags; - std::vector exps; - std::vector dvm_dir; - BestPattern tmp; - - tmp.count_of_pattern = 0; - for(size_t it = 0; it < allStat[i].patterns.size(); ++it) - { - if(allStat[i].patterns[it].count_write_op != 0) - { - first = it; - break; - } - } - - if(first > allStat[i].patterns.size()) - { - ex = allStat[i].patterns[0].symbs; - while(ex) - { - flags.push_back(false); - ex = ex->rhs(); - } - } - else - { - SgExpression *t = correctDvmDirPattern(dvm_dir_pattern, allStat[i].patterns[first].symbs); - ex = allStat[i].patterns[first].symbs; - tmp.count_of_pattern += allStat[i].patterns[first].count_write_op; - while(ex) - { - count++; - exps.push_back(ex->lhs()); - flags.push_back(true); - ex = ex->rhs(); - - dvm_dir.push_back(t->lhs()); - t = t->rhs(); - } - tmp.bounds = std::vector(count); - std::vector extraExprsInIdx = std::vector(count); - std::vector minVal = std::vector(count); - std::vector maxVal = std::vector(count); - - for(size_t k = first + 1; k < allStat[i].patterns.size(); ++k) - { - if(allStat[i].patterns[k].count_write_op != 0) - { - tmp.count_of_pattern += allStat[i].patterns[k].count_write_op; - ex = allStat[i].patterns[k].symbs; - for(int m = 0; m < count; ++m) - { - if(flags[m]) - { - if(ExpCompare(ex->lhs(), exps[m]) != 1) - { - if(dvm_dir[m] != NULL) - { - if(dvm_dir[m]->variant() != KEYWORD_VAL) - { - SgExprListExp *countEx = new SgExprListExp(SUBT_OP); - countEx->setRhs(*exps[m]); - countEx->setLhs(*ex->lhs()); - SgExpression *res = preCalculate(countEx); - - res = Calculate(res); - if(res->variant() != INT_VAL) - flags[m] = false; - else - { - int resval = res->valueInteger(); - if(extraExprsInIdx[m] == NULL) - { - extraExprsInIdx[m] = exps[m]; - minVal[m] = maxVal[m] = 0; - } - if(resval < minVal[m]) - minVal[m] = resval; - else if(resval > maxVal[m]) - maxVal[m] = resval; - } - } - else - { - flags[m] = false; - extraExprsInIdx[m] = NULL; - } - } - else - { - flags[m] = false; - extraExprsInIdx[m] = NULL; - } - } - } - ex = ex->rhs(); - } - } - } - - for(int i = 0; i < count; ++i) - { - if(extraExprsInIdx[i] != NULL) - { - Bound tmpB; - tmpB.additionalExpr = extraExprsInIdx[i]; - tmpB.exL = true; - tmpB.exR = true; - tmpB.ifDdot = true; - tmpB.L = minVal[i]; - tmpB.R = maxVal[i]; - tmp.bounds[i] = tmpB; - flags[i] = false; - } - } - } - tmp.what = flags; - if(first < allStat[i].patterns.size()) - tmp.bestPatt = allStat[i].patterns[first].symbs; - else - { - //printf(" NO FOUND!!! \n"); - tmp.bestPatt = NULL; - } - best.push_back(tmp); - } -} - -void findSymbolInExpression(SgExpression *inFind, int &flag, std::vector &symbsInDvmDir, int &numFind, SgSymbol *sFind) -{ - if(flag == 1) - { - SgExpression *left = inFind->lhs(); - SgExpression *right = inFind->rhs(); - - if(inFind->variant() != VAR_REF) - { - if(left) - findSymbolInExpression(left, flag, symbsInDvmDir, numFind, sFind); - if(right) - findSymbolInExpression(right, flag, symbsInDvmDir, numFind, sFind); - } - else - { - bool find = false; - size_t i = 0; - SgSymbol *s = inFind->symbol(); - for( ; i < symbsInDvmDir.size(); i++) - { - if(symbsInDvmDir[i] == s) - { - find = true; - break; - } - } - - if(i < symbsInDvmDir.size()) - { - if(numFind == -1) - { - numFind = i; - sFind = inFind->symbol(); - } - else if(numFind != (int)i) - flag = 0; - } - } - } -} - -SgExpression *correctDvmDirPattern(SgExpression *dvm_dir_pattern, SgExpression *firstPatt) -{ - SgExpression *tmp1 = dvm_dir_pattern; - SgExpression *returnExp = dvm_dir_pattern; - std::vector symbsInDvmDir; - int countDVM = 0; - int count = 0; - - while(tmp1) - { - countDVM++; - if(tmp1->lhs()->variant() == VAR_REF) - symbsInDvmDir.push_back(tmp1->lhs()->symbol()); - tmp1 = tmp1->rhs(); - } - tmp1 = firstPatt; - while(tmp1) - { - count++; - tmp1 = tmp1->rhs(); - } - - // if correction needed - if(count != countDVM) - { - tmp1 = firstPatt; - - returnExp = new SgExprListExp(); - SgExpression *t = returnExp; - - for(int i = 0; i < count; ++i) - { - int flag = 1; - int numFind = -1; - SgSymbol *sFind = NULL; - - findSymbolInExpression(tmp1->lhs(), flag, symbsInDvmDir, numFind, sFind); - if(flag != 1) - { - returnExp = NULL; - break; - } - else - { - - SgExprListExp *newL = new SgExprListExp(); - if(numFind != -1) - t->setLhs(*new SgVarRefExp(symbsInDvmDir[numFind])); - - t->setRhs(newL); - t = t->rhs(); - } - tmp1 = tmp1->rhs(); - } - } - - return returnExp; -} - -void correctBestPattern(std::vector &allStat, std::vector &best, SgExpression *dvm_dir_pattern) -{ - for(size_t i = 0; i < allStat.size(); ++i) - { - SgExpression *t = dvm_dir_pattern; - SgExpression *t1 = NULL; - for(size_t p = 0; p < allStat[i].patterns.size(); ++p) - { - if(allStat[i].patterns[p].count_write_op != 0) - { - t1 = allStat[i].patterns[p].symbs; - break; - } - } - if(t1 != NULL) - { - t = correctDvmDirPattern(dvm_dir_pattern, t1); - if(DVM_DEBUG_LVL > 1) - if(t) - fprintf(file, " Found pattern is %s\n", copyOfUnparse(t->unparse())); - - if(t) - { - for(size_t k = 0; k < best[i].what.size(); ++k) - { - if(best[i].what[k] != 0) - { - if(ExpCompare(t->lhs(), t1->lhs()) != 1) - best[i].what[k] = 0; - } - - t = t->rhs(); - t1 = t1 ->rhs(); - } - } - else - { - for(size_t k = 0; k < best[i].what.size(); ++k) - best[i].what[k] = 0; - } - } - } -} - -int countSizeInDim(SgExpression *ex, bool &ifDdot) -{ - int res = 0; - existLB = existRB = false; - SgExpression *result; - if(ex->variant() == DDOT) - { - ifDdot = true; - if (ex->lhs()) - { - result = Calculate(ex->lhs()); - if (result->variant() == INT_VAL) - { - existLB = true; - leftBound = result->valueInteger(); - } - } - - if (ex->rhs()) - { - result = Calculate(ex->rhs()); - if (result->variant() == INT_VAL) - { - existRB = true; - rightBound = result->valueInteger(); - } - } - if(existLB && existRB) - res = abs(leftBound - rightBound) + 1; - } - else - { - result = Calculate(ex); - existLB = true; - leftBound = 1; - if(result->variant() == INT_VAL) - { - existRB = true; - rightBound = result->valueInteger(); - } - if(existLB && existRB) - res = abs(leftBound - rightBound) + 1; - } - return -1 * res; -} - -bool compareWithPatten(SgExpression *inPatt, SgExpression *compared, std::vector &flags) -{ - bool retval = true; - SgExpression *t1 = inPatt; - SgExpression *t2 = compared; - char **str = new char*[2]; - - if(DVM_DEBUG_LVL > 1) - fprintf(file, "%s VS %s is ", copyOfUnparse(t1->unparse()), copyOfUnparse(t2->unparse())); - - for(size_t i = 0; i < flags.size(); ++i) - { - if(flags[i] == 1) - { - if(ExpCompare(t1->lhs(), t2->lhs()) != 1) - { - str[0] = copyOfUnparse(t1->lhs()->unparse()); - str[1] = copyOfUnparse(t2->lhs()->unparse()); - retval = false; - break; - } - } - - t1 = t1->rhs(); - t2 = t2->rhs(); - } - if(DVM_DEBUG_LVL > 1) - { - fprintf(file, "retval = %d flags: ", retval); - for(size_t i = 0; i < flags.size(); ++i) - fprintf(file, "%d ", flags[i]); - - if(!retval) - fprintf(file, " %s VS %s ", str[0], str[1]); - - fprintf(file, "\n"); - } - - return retval; -} - -void replaceInStmt(std::vector &allStat, std::vector &best, SgExpression *expr, SgExpression *ex_parrent, SgStatement *ex_parrent_st, int RL) -{ - if(expr->variant() == ARRAY_REF) - { - size_t i = 0; - SgSymbol *tmp = expr->symbol(); - for( ; i < allStat.size(); i++) - { - if(allStat[i].name_of_array == tmp) - break; - } - if(i < allStat.size()) //if found - { - if(best[i].count_of_pattern != 0) - { - if(compareWithPatten(best[i].bestPatt, expr->lhs(), best[i].what)) - { - SgArrayRefExp *newExp = NULL; - if(allStat[i].ifHasDim) - { - newExp = new SgArrayRefExp(*allStat[i].replaceSymbol); - SgExpression *idxEx = expr->lhs(); - for(size_t k = 0; k < best[i].what.size(); ++k) - { - if(best[i].what[k] != 1) - { - if(best[i].bounds[k].additionalExpr) - newExp->addSubscript(idxEx->lhs()->copy() - *best[i].bounds[k].additionalExpr); - else - newExp->addSubscript(idxEx->lhs()->copy()); - } - idxEx = idxEx->rhs(); - } - } - if(ex_parrent) - { - if(RL == RIGHT) - { - if(newExp) - ex_parrent->setRhs(*newExp); - else - ex_parrent->setRhs(*new SgVarRefExp(*allStat[i].replaceSymbol)); - } - else if(RL == LEFT) - { - if(newExp) - ex_parrent->setLhs(*newExp); - else - ex_parrent->setLhs(*new SgVarRefExp(*allStat[i].replaceSymbol)); - } - } - else if(ex_parrent_st) - { - if(RL == RIGHT) - { - if(newExp) - ex_parrent_st->setExpression(1, *newExp); - else - ex_parrent_st->setExpression(1, *new SgVarRefExp(*allStat[i].replaceSymbol)); - } - else if(RL == LEFT) - { - if(newExp) - ex_parrent_st->setExpression(0, *newExp); - else - ex_parrent_st->setExpression(0, *new SgVarRefExp(*allStat[i].replaceSymbol)); - } - } - } - } - } - } - else - { - if(expr->lhs()) - replaceInStmt(allStat, best, expr->lhs(), expr, NULL, LEFT); - if(expr->rhs()) - replaceInStmt(allStat, best, expr->rhs(), expr, NULL, RIGHT); - } -} - -void generateOptimalExpressions(std::vector &allStat, std::vector &best, std::vector &newVars) -{ - std::vector writeStmts; - std::vector readStmts; - - for(size_t i = 0; i < allStat.size(); ++i) - { - SgArrayType *type = isSgArrayType(allStat[i].name_of_array->type()); - if(type != NULL) - { - int dims = type->dimension(); - int sum = 1; - bool ifSumChanged = false; - //fprintf(file, "dims size "); - for(int k = 0; k < dims; ++k) - { - if(!best[i].what[k] && best[i].count_of_pattern != 0) - { - if(best[i].bounds[k].additionalExpr == NULL) - { - SgExpression *ex = type->sizeInDim(k); - best[i].what[k] = countSizeInDim(ex, best[i].bounds[k].ifDdot); - - best[i].bounds[k].L = best[i].bounds[k].R = 0; - best[i].bounds[k].exL = existLB; - best[i].bounds[k].exR = existRB; - if(existLB) - best[i].bounds[k].L = leftBound; - if(existRB) - best[i].bounds[k].R = rightBound; - - sum *= (-1 * best[i].what[k]); - } - else - { - best[i].what[k] = -1 * (abs(best[i].bounds[k].L - best[i].bounds[k].R) + 1); - sum *= (-1 * best[i].what[k]); - } - ifSumChanged = true; - } - /*else - { - Bound tmpB; - best[i].bounds.push_back(tmpB); - }*/ - //fprintf(file, "%d ", best[i].what[k]); - } - //fprintf(file, "\n"); - if(!ifSumChanged) // scalar ? - sum = 1; - if(sum >= best[i].count_of_pattern) - { - if(DVM_DEBUG_LVL > 1) - fprintf(file, " [INFO] in array \" %s \" needed to read = %d, write operations = %d\n", allStat[i].name_of_array->identifier(), sum, best[i].count_of_pattern); - - for(int k = 0; k < dims; ++k) - { - best[i].what[k] = 0; - } - best[i].count_of_pattern = 0; - } - else - { - if(DVM_DEBUG_LVL > 1) - fprintf(file, " [INFO] in array \" %s \" needed to read = %d, write operations = %d\n", allStat[i].name_of_array->identifier(), sum, best[i].count_of_pattern); - sum = 0; - for(int k = 0; k < dims; ++k) - { - if(best[i].what[k] < 0) - sum ++; - if(best[i].what[k] == 0) - { - sum = -1; - break; - } - } - - if(sum != -1) - createDoAssigns(allStat[i], newVars, allStat[i].ex_name_of_array, best[i].what.size(), sum, best[i], writeStmts, readStmts); - } - } - } - - // insert and correct loop_body - SgStatement *tmp, *contrEnd = NULL; - tmp = loop_body; - if(readStmts.size() != 0) - while(tmp) - { - if(tmp->variant() == ASSIGN_STAT) - { - if(DVM_DEBUG_LVL > 1) - fprintf(file, "COMPARE PATTERNS start:\n"); - - replaceInStmt(allStat, best, tmp->expr(0), NULL, tmp, LEFT); - replaceInStmt(allStat, best, tmp->expr(1), NULL, tmp, RIGHT); - - if(DVM_DEBUG_LVL > 1) - fprintf(file, "COMPARE PATTERNS stop:\n\n"); - } - - tmp = tmp->lexNext(); - } - - for(size_t i = 0; i < readStmts.size(); ++i) - { - tmp = readStmts[i]; - tmp->lastNodeOfStmt()->setLexNext(*loop_body); - loop_body = tmp; - } - - tmp = loop_body; - int count = 0; - while(tmp) - { - tmp = tmp->lexNext(); - count++; - } - - tmp = loop_body; - for(int i = 0; i < count - 2; ++i) - { - tmp = tmp->lexNext(); - } - if(tmp->lexNext()->variant() == CONTROL_END) - contrEnd = tmp->lexNext(); - - for(size_t i = 0; i < writeStmts.size(); ++i) - { - tmp->setLexNext(*writeStmts[i]); - tmp = tmp->lexNext()->lastNodeOfStmt(); - } - if(contrEnd) - tmp->setLexNext(*contrEnd); - - // printf its - if(DVM_DEBUG_LVL > 1) - { - if(readStmts.size() != 0) - fprintf(file, " Generated READ stms:\n"); - for(size_t i = 0; i < readStmts.size(); ++i) - fprintf(file, "%s", readStmts[i]->unparse()); - if(writeStmts.size() != 0) - fprintf(file, " Generated WRITE stms:\n"); - for(size_t i = 0; i < writeStmts.size(); ++i) - fprintf(file, "%s", writeStmts[i]->unparse()); - } -} - -// sign = 0 - plus, sing = 1 - minus -void getInformation(std::vector &signs, std::vector &symbs, std::vector &values, int sign, SgExpression *ex) -{ - if(ex->variant() == SUBT_OP) - { - getInformation(signs, symbs, values, 0, ex->lhs()); - getInformation(signs, symbs, values, 1, ex->rhs()); - } - else if(ex->variant() == ADD_OP) - { - getInformation(signs, symbs, values, 0 + sign, ex->lhs()); - getInformation(signs, symbs, values, 0 + sign, ex->rhs()); - } - else if(ex->variant() == VAR_REF) - { - symbs.push_back(ex->symbol()); - signs.push_back(sign); - } - else if(ex->variant() == INT_VAL) - { - if(sign == 1) - values.push_back(-1 * ex->valueInteger()); - else - values.push_back(ex->valueInteger()); - } -} - -SgExpression *preCalculate(SgExpression *exprL) // -{ - std::vector symbs; - std::vector values; - std::vector signs; - int val = 0; - bool ifALL = true; - SgExpression *retval = exprL; - - getInformation(signs, symbs, values, 0, exprL); - for(size_t i = 0; i < symbs.size(); ++i) - { - SgSymbol *s = symbs[i]; - for(size_t k = i + 1; k < symbs.size(); ++k) - { - if(s == symbs[k]) - { - if(signs[i] * signs[k] == 0) - { - symbs[i] = NULL; - symbs[k] = NULL; - } - break; - } - } - } - - for(size_t i = 0; i < symbs.size(); ++i) - { - if(symbs[i]) - { - ifALL = false; - break; - } - } - - for(size_t i = 0; i < values.size(); ++i) - { - val += values[i]; - } - - if(ifALL) - { - retval = new SgValueExp(val); - } - return retval; -} - -bool existEqOp(SgExpression *ex) -{ - bool retval = false; - if(ex) - { - if(ex->variant() == EQ_OP) - retval = true; - else - { - if(ex->lhs()) - retval = retval || existEqOp(ex->lhs()); - if(ex->rhs() && !retval) - retval = retval || existEqOp(ex->rhs()); - } - } - return retval; -} - -// for <-gpuO1:lvl2> -void findGroups(std::vector &allStat, std::vector &allArrayGroups) -{ - for (size_t i = 0; i < allStat.size(); ++i) - { - AnalyzeStat tmp = allStat[i]; - SgExpression *ex = tmp.patterns[0].symbs; - int countOfVariants = 0; - int position = 0; - - while (ex) - { - countOfVariants++; - ex = ex->rhs(); - } - - std::vector allGroup; - std::vector allPosGr; - ArrayGroup newArrayGroup; - - newArrayGroup.arrayName = allStat[i].name_of_array; - for (int k = 0; k < countOfVariants; ++k) - { - position = k; - PositionGroup newGr; - - newGr.position = position; - for (size_t gl = 0; gl < tmp.patterns.size(); ++gl) - { - ex = tmp.patterns[gl].symbs; - std::vector charEx; - SgExpression *exInPos = NULL; - SgExprListExp *positions = new SgExprListExp(); - SgExpression *currentPos = positions; - - int num = 0; - bool first = true; - for (int m = 0; m < countOfVariants; ++m) - { - if (m != k) - { - charEx.push_back(copyOfUnparse(ex->lhs()->unparse())); - num += strlen(charEx[charEx.size() - 1]); - if (first != true) - { - currentPos->setRhs(new SgExprListExp()); - currentPos = currentPos->rhs(); - } - else - first = false; - - currentPos->setLhs(ex->lhs()); - currentPos->setRhs(NULL); - } - else - { - exInPos = ex->lhs(); - if (gl == 0) - newGr.idxInPos = ex->lhs(); - } - ex = ex->rhs(); - } - char *buf = new char[num + 16]; - buf[0] = '\0'; - strcat(buf, "("); - for (size_t m = 0; m < charEx.size(); ++m) - { - strcat(buf, charEx[m]); - if (m != charEx.size() - 1) - strcat(buf, ","); - } - strcat(buf, ")"); - - bool exist = false; - num = 0; - for (size_t m = 0; m < newGr.allPosGr.size(); ++m) - { - if (strcmp(newGr.allPosGr[m].strOfmain, buf) == 0) - { - num = m; - exist = true; - break; - } - } - - if (exist) - newGr.allPosGr[num].inGroup.push_back(exInPos); - else - { - Group gr; - gr.inGroup.push_back(exInPos); - gr.strOfmain = buf; - gr.mainPattern = positions; - newGr.allPosGr.push_back(gr); - } - } - allPosGr.push_back(newGr); - } - newArrayGroup.allGroups = allPosGr; - allArrayGroups.push_back(newArrayGroup); - } -} - -void createSwaps(newInfo &info) -{ - for (int i = 0; i < info.dimSize[0] - 1; ++i) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); - SgArrayRefExp *arrayEx1 = new SgArrayRefExp(*info.newArray); - - arrayEx->addSubscript(*new SgValueExp(i)); - arrayEx1->addSubscript(*new SgValueExp(i + 1)); - info.swapsDown.push_back(new SgAssignStmt(*arrayEx, *arrayEx1)); - } - - for (int i = 1; i < info.dimSize[0]; ++i) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); - SgArrayRefExp *arrayEx1 = new SgArrayRefExp(*info.newArray); - - arrayEx->addSubscript(*new SgValueExp(i - 1)); - arrayEx1->addSubscript(*new SgValueExp(i)); - info.swapsUp.push_back(new SgAssignStmt(*arrayEx1, *arrayEx)); - } -} - -void createLoadsAndStores(Group &gr, newInfo &info, ArrayGroup &oldArray, int numGr, PositionGroup &posGr) -{ - SgExprListExp *ddot = new SgExprListExp(DDOT); - SgArrayType *tpArrNew = new SgArrayType(*oldArray.arrayName->type()); - - ddot->setLhs(*new SgValueExp(0)); - ddot->setRhs(*new SgValueExp(info.dimSize[0] - 1)); - - tpArrNew->addDimension(ddot); - info.newArray->setType(tpArrNew); - - for (int i = 0; i < info.dimSize[0]; ++i) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); - SgArrayRefExp *oldArrayEx = new SgArrayRefExp(*oldArray.arrayName); - SgExpression *tmpEx = gr.mainPattern; - int size = 0; - - while (tmpEx) - { - size++; - tmpEx = tmpEx->rhs(); - } - size++; - - tmpEx = gr.mainPattern; - for (size_t k = 0; k < (size_t)size; ++k) - { - if ((int)k == numGr) - oldArrayEx->addSubscript(*gr.inGroup[i]); - else - { - oldArrayEx->addSubscript(*tmpEx->lhs()); - tmpEx = tmpEx->rhs(); - } - } - - arrayEx->addSubscript(*new SgValueExp((int)i)); - // fill table - posGr.tableReplace[copyOfUnparse(oldArrayEx->lhs()->unparse())] = arrayEx->copyPtr(); - - if (i != info.dimSize[0] - 1) - info.loadsBeforePlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - - if (i != 0) - info.loadsBeforeMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - - if (i == info.dimSize[0] - 1) - info.loadsInForPlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - - if (i == 0) - info.loadsInForMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - /* - if (i == 0) - info.stores.push_back(new SgAssignStmt(*oldArrayEx, *arrayEx));*/ - } -} - -void sortInGroup(Group &gr) -{ - for (size_t i = 0; i < gr.sortLen.size() - 1; ++i) - { - for (size_t k = i; k < gr.sortLen.size() - 1; ++k) - { - if (gr.sortLen[k] > gr.sortLen[k + 1]) - { - int tmp = gr.sortLen[k]; - SgExpression *tmpEx = gr.inGroup[k]; - - gr.sortLen[k] = gr.sortLen[k + 1]; - gr.inGroup[k] = gr.inGroup[k + 1]; - gr.sortLen[k + 1] = tmp; - gr.inGroup[k + 1] = tmpEx; - } - } - } -} - -SgExpression *substitutionStep(int stepSub, SgExpression *in, char *symb) -{ - SgExpression *ret = NULL; - SgExpression *left = NULL, *right = NULL; - if (in->variant() == VAR_REF) - { - if (strcmp(symb, in->symbol()->identifier()) == 0) - { - ret = new SgValueExp(stepSub); - } - } - else - { - if (in->lhs()) - left = substitutionStep(stepSub, in->lhs(), symb); - if (in->rhs()) - right = substitutionStep(stepSub, in->rhs(), symb); - - if (left != NULL && right != NULL) - { - ret = new SgExprListExp(in->variant()); - ret->setLhs(left); - ret->setRhs(right); - } - else if (left != NULL) - { - ret = new SgExprListExp(in->variant()); - ret->setLhs(left); - } - else if (right != NULL) - { - ret = new SgExprListExp(in->variant()); - ret->setRhs(right); - } - else - { - ret = in; - } - } - return ret; -} - -SgExpression* replaceInExpr(SgExpression *current, SgExpression *parent, int nested, char *arrayS, PositionGroup &posGr) -{ - SgExpression *ret = NULL; - if (current->variant() == ARRAY_REF) - { - if (strcmp(current->symbol()->identifier(), arrayS) == 0) - { - SgExpression *replace = NULL; - char *need = copyOfUnparse(current->lhs()->unparse()); - - replace = posGr.tableReplace[need]; - if (replace != NULL) - { - SgSymbol *s = posGr.tableNewVars[replace->symbol()->identifier()]; - if (s == NULL) - posGr.tableNewVars[replace->symbol()->identifier()] = replace->symbol(); - - if (nested == 0) // assign - ret = replace->copyPtr(); - else if (nested == -1) // left - parent->setLhs(replace); - else if (nested == 1) // rights - parent->setRhs(replace); - - if (DVM_DEBUG_LVL > 1) - { - char *old = NULL, *new_ = NULL; - old = copyOfUnparse(current->unparse()); - new_ = copyOfUnparse(replace->unparse()); - fprintf(file, " %s -> %s\n", old, new_); - } - } - } - } - else - { - if (current->lhs()) - replaceInExpr(current->lhs(), current, -1, arrayS, posGr); - if (current->rhs()) - replaceInExpr(current->rhs(), current, 1, arrayS, posGr); - } - return ret; -} - -void correctLoopBody(std::vector &allArrayGroups) -{ - if (DVM_DEBUG_LVL > 1) - fprintf(file, "********** [REPLACE INFO] *********\n"); - - for (size_t i = 0; i < allArrayGroups.size(); ++i) - { - int bestPosition = -1; - int bestSum = -1; - // find best replace - for (size_t k = 0; k < allArrayGroups[i].allGroups.size(); ++k) - { - int sum = 0; - for (size_t m = 0; m < allArrayGroups[i].allGroups[k].allPosGr.size(); ++m) - { - if (allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size() > 1) - sum++; - } - if (sum >= bestSum && allArrayGroups[i].allGroups[k].position != 0) - { - bestSum = sum; - bestPosition = allArrayGroups[i].allGroups[k].position; - } - } - - if (bestPosition != -1) - { - SgStatement *st = loop_body; - while (st) - { - if (st->variant() == ASSIGN_STAT) - { - SgExpression *left, *right; - left = right = NULL; - left = replaceInExpr(st->expr(0), st->expr(0), 0, allArrayGroups[i].arrayName->identifier(), allArrayGroups[i].allGroups[bestPosition]); - right = replaceInExpr(st->expr(1), st->expr(1), 0, allArrayGroups[i].arrayName->identifier(), allArrayGroups[i].allGroups[bestPosition]); - if (left != NULL) - st->setExpression(0, *left); - if (right != NULL) - st->setExpression(1, *right); - } - st = st->lexNext(); - } - - for (std::map < std::string, SgSymbol*> ::iterator it = allArrayGroups[i].allGroups[bestPosition].tableNewVars.begin(); it != allArrayGroups[i].allGroups[bestPosition].tableNewVars.end(); it++) - { - newVars.push_back(&*it->second); - } - } - } - - - if (DVM_DEBUG_LVL > 1) - fprintf(file, "********** [REPLACE INFO] *********\n"); -} - -void checkGroup(Group &gr, int stepCycle, SgSymbol *symb) -{ - int *old = new int[gr.sortLen.size()]; - for (size_t i = 0; i < gr.sortLen.size(); ++i) - old[i] = gr.sortLen[i]; - - for (size_t i = 0; i < gr.sortLen.size(); ++i) - { - for (size_t k = 0; k < gr.sortLen.size() - 1 - i; ++k) - { - if (old[k] > old[k + 1]) - { - int tmp = old[k]; - old[k] = old[k + 1]; - old[k + 1] = tmp; - } - } - } - - /*for (size_t i = 0; i < gr.sortLen.size(); ++i) - { - printf("%d ", old[i]); - } - printf("\n");*/ - - size_t size_ = gr.sortLen.size(); - for (size_t i = 0; i < size_ - 1; ++i) - { - if (abs(old[i] - old[i + 1]) > abs(stepCycle)) - { - int insertVal = old[i] + stepCycle; - - gr.sortLen.push_back(insertVal); - if (insertVal == 0) - { - gr.len.push_back(0); - gr.inGroup.push_back(new SgVarRefExp(*symb)); - } - else - { - gr.len.push_back(abs(insertVal)); - SgExprListExp *add = NULL; - if (insertVal < 0) - { - add = new SgExprListExp(SUBT_OP); - add->setLhs(*new SgVarRefExp(*symb)); - add->setRhs(*new SgValueExp(-insertVal)); - } - else - { - add = new SgExprListExp(ADD_OP); - add->setLhs(*new SgVarRefExp(*symb)); - add->setRhs(*new SgValueExp(insertVal)); - } - gr.inGroup.push_back(add); - } - } - } -} - -void correctGroups(std::vector &allArrayGroups) -{ - for (size_t i = 0; i < allArrayGroups.size(); ++i) - { - for (size_t k = 0; k < allArrayGroups[i].allGroups.size(); ++k) - { - for (size_t m = 0; m < allArrayGroups[i].allGroups[k].allPosGr.size(); ++m) - { - bool nextStep = false; - if (strcmp(allArrayGroups[i].allGroups[k].allPosGr[m].strOfmain, "()") != 0 && allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size() > 1) - { - nextStep = true; - allArrayGroups[i].allGroups[k].allPosGr[m].len.push_back(0); - - for (size_t p = 1; p < allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size(); ++p) - { - SgExprListExp *expr = new SgExprListExp(SUBT_OP); - SgExpression *result; - - expr->setLhs(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[p - 1]); - expr->setRhs(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[p]); - result = preCalculate(expr); - if (result->variant() == INT_VAL) - allArrayGroups[i].allGroups[k].allPosGr[m].len.push_back(abs(result->valueInteger())); - else - { - allArrayGroups[i].allGroups[k].allPosGr[m].len.clear(); - nextStep = false; - break; - } - } - - for (size_t p = 0; p < allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size() && nextStep; ++p) - { - SgExprListExp *expr = new SgExprListExp(SUBT_OP); - SgExpression *result; - - expr->setLhs(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[p]); - expr->setRhs(allArrayGroups[i].allGroups[k].idxInPos); - result = preCalculate(expr); - if (result->variant() == INT_VAL) - allArrayGroups[i].allGroups[k].allPosGr[m].sortLen.push_back(result->valueInteger()); - else - { - allArrayGroups[i].allGroups[k].allPosGr[m].sortLen.clear(); - nextStep = false; - break; - } - } - - if (nextStep) - { - int stepCycle = 1; // , . - int size; - int shift = 0; - char *symb = NULL; - bool allOk = true; - - if (allArrayGroups[i].allGroups[k].idxInPos->symbol()) - symb = allArrayGroups[i].allGroups[k].idxInPos->symbol()->identifier(); - else - allOk = false; - if (allOk) - { - checkGroup(allArrayGroups[i].allGroups[k].allPosGr[m], stepCycle, allArrayGroups[i].allGroups[k].idxInPos->symbol()); - - size = allArrayGroups[i].allGroups[k].allPosGr[m].len.size(); - SgExpression **template1 = new SgExpression*[size]; - SgExpression **template2 = new SgExpression*[size]; - - // fill templates - for (int i1 = 0; i1 < size; ++i1) - { - template1[i1] = preCalculate(substitutionStep(0, allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[i1], symb)); - template2[i1] = preCalculate(substitutionStep(0 + stepCycle, allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[i1], symb)); - } - - // find shift - allOk = false; - for (int k1 = 1; k1 < size; ++k1) - { - shift = k1; - allOk = true; - for (int i = shift; i < size; ++i) - { - SgExprListExp *compare = new SgExprListExp(SUBT_OP); - SgExpression *zero = NULL; - compare->setLhs(template1[i]); - compare->setRhs(template2[i - shift]); - zero = preCalculate(compare); - if (zero->variant() == INT_VAL) - { - if (zero->valueInteger() != 0) - { - allOk = false; - break; - } - } - else - { - allOk = false; - break; - } - } - if (allOk) - break; - else - allOk = false; - } - - // if found - if (allOk) - { - char buf[32]; - char *newName = new char[strlen(allArrayGroups[i].arrayName->identifier()) + 32]; - - buf[0] = '\0'; - sprintf(buf, "%d", generator); - generator++; - newName[0] = '\0'; - strcat(newName, allArrayGroups[i].arrayName->identifier()); - strcat(newName, "_"); - strcat(newName, buf); - allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo.newArray = new SgSymbol(VARIABLE_NAME, newName); - allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo.dimSize.push_back(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size()); - sortInGroup(allArrayGroups[i].allGroups[k].allPosGr[m]); - // - createLoadsAndStores(allArrayGroups[i].allGroups[k].allPosGr[m], allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo, allArrayGroups[i], k, allArrayGroups[i].allGroups[k]); - createSwaps(allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo); - } - - delete []template1; - delete []template2; - } - } - } - } - } - } -} - -// main functions for <-gpuO1>. All above for this -AnalyzeReturnGpuO1 analyzeLoopBody(int type) -{ - SgStatement *loop_body_start = loop_body; - SgStatement *analyze_stmt = loop_body_start; - SgExpression *tmp = NULL; - SgExpression *dvm_dir_pattern = NULL; - std::set private_vars; - std::vector allStat; - std::vector best_patterns; - std::vector allArrayGroup; - bool ifBreak = false; - std::set otherVars; - - // !!! - int lastDLVL = DVM_DEBUG_LVL; - DVM_DEBUG_LVL = 2; - - loopVars.clear(); - scalar_stmts.clear(); - - tmp = dvm_parallel_dir->expr(2); - while(tmp) - { - loopVars.push_back(tmp->lhs()->symbol()); - tmp = tmp->rhs(); - } - - if(DVM_DEBUG_LVL > 1) - if(file == NULL) - file = fopen("log_optimization.txt", "w+"); - - if(DVM_DEBUG_LVL > 1) - if(fileStmts == NULL) - fileStmts = fopen("log_stms.txt", "w+"); - - dvm_dir_pattern = dvm_parallel_dir->expr(0)->lhs(); - tmp = dvm_parallel_dir->expr(1); - - while(tmp) - { - SgExpression *t = tmp->lhs(); - if(t->variant() == ACC_PRIVATE_OP) - { - t = t->lhs(); - while(t) - { - SgExpression *t1 = &t->lhs()->copy(); - private_vars.insert(t1->symbol()); - //printf("symbol as private: %s\n",t1->symbol()->identifier()); - t = t->rhs(); - } - break; - } - tmp = tmp->rhs(); - } - - // all stmts is not in internal loop - //loopMultCount = 1; - - if(DVM_DEBUG_LVL > 1) - fprintf(file, "start analyze stmts in LOOP on line number %d\n", first_do_par->lineNumber()); - while(analyze_stmt) - { - if(analyze_stmt->variant() == ASSIGN_STAT) - { - SgSymbol *s = analyze_stmt->expr(0)->symbol(); - SgExpression *ex = analyze_stmt->expr(0); - - only_scalar = true; - operation = WRITE; - analyzeVarRef(private_vars, allStat, s, ex); - if(analyze_stmt->expr(1)) - { - //printf("start\n"); - //analyze_stmt->expr(1)->unparsestdout(); - operation = READ; - analyzeRightAssing(private_vars, allStat, analyze_stmt->expr(1)); - //printf("\nend\n\n"); - } - if(only_scalar) - scalar_stmts.push_back(analyze_stmt); - } - else if(analyze_stmt->variant() == FOR_NODE) // !!! - { - int step = 1; - bool exStep = true; - SgExpression *ex = NULL; - - symbolsOfForNode.push_back(analyze_stmt->symbol()); - controlEndsOfForStmt.push(analyze_stmt->lastNodeOfStmt()); - - if(analyze_stmt->expr(1)) - { - ex = Calculate(analyze_stmt->expr(1)); - if(ex->variant() == INT_VAL) - step = ex->valueInteger(); - else - exStep = false; - fprintf(file, "step is %s \n", copyOfUnparse(analyze_stmt->expr(1)->unparse())); - } - - if(exStep) - { - if(analyze_stmt->expr(0)->variant() == DDOT) - { - SgExprListExp *exprL = new SgExprListExp(SUBT_OP); - - globalStep.push_back(step); - lBound.push_back(analyze_stmt->expr(0)->lhs()); - rBound.push_back(analyze_stmt->expr(0)->rhs()); - loopMultCount.push_back(-999); - exprL->setLhs(rBound[rBound.size() - 1]); - exprL->setRhs(lBound[lBound.size() - 1]); - - ex = preCalculate(exprL); - ex = Calculate(ex); - if(ex->variant() == INT_VAL) - { - loopMultCount[loopMultCount.size() - 1] = ((abs(ex->valueInteger()) + 1) / abs(step)); - actualDocycle.push_back(1); - if(DVM_DEBUG_LVL > 1) - fprintf(file, " Change loopMultCount by number %d with symbol %s, calculation value = %d, [%s, %s]\n", loopMultCount[loopMultCount.size() - 1], symbolsOfForNode[symbolsOfForNode.size() - 1]->identifier(), ex->valueInteger(), copyOfUnparse(lBound[lBound.size() - 1]->unparse()), copyOfUnparse(rBound[rBound.size() - 1]->unparse())); - } - else - { - unknownLoop = true; - actualDocycle.push_back(1); - loopMultCount[loopMultCount.size() - 1] = 1; - fprintf(file, " **[ATTENTION]**: can't calculate expression << %s >> with variant %d\n", copyOfUnparse(ex->unparse()), analyze_stmt->expr(0)->variant()); - } - } - } - } - else if(analyze_stmt->variant() == CONTROL_END) - { - if (controlEndsOfForStmt.size() != 0) - { - if (analyze_stmt == controlEndsOfForStmt.top()) - { - loopMultCount.pop_back(); - symbolsOfForNode.pop_back(); - lBound.pop_back(); - rBound.pop_back(); - actualDocycle.pop_back(); - globalStep.pop_back(); - controlEndsOfForStmt.pop(); - - if (DVM_DEBUG_LVL > 1) - fprintf(file, " Return back value of loopMultCount\n"); - } - } - else if (controlEndsOfIfStmt.size() != 0) - { - if (analyze_stmt == controlEndsOfIfStmt.top()) - controlEndsOfIfStmt.pop(); - } - else - { - if (DVM_DEBUG_LVL > 1) - fprintf(file, " **[ATTENTION]**: unknown CONTROL_END in line %d!! It may be end of local \"loop_body\" \n", analyze_stmt->lineNumber()); - } - } - else if (analyze_stmt->variant() == IF_NODE || analyze_stmt->variant() == ELSEIF_NODE)// || analyze_stmt->variant() == LOGIF_NODE) - { - SgExpression *ex = analyze_stmt->expr(0); - SgIfStmt *tmpIf = (SgIfStmt*)analyze_stmt; - - if (tmpIf->falseBody()) - { - if (tmpIf->falseBody()->variant() != ELSEIF_NODE) - controlEndsOfIfStmt.push(analyze_stmt->lastNodeOfStmt()); - } - else - controlEndsOfIfStmt.push(analyze_stmt->lastNodeOfStmt()); - - if(existEqOp(ex)) - { - if (tmpIf->falseBody()) - { - if (tmpIf->falseBody()->variant() == ELSEIF_NODE) - { - analyze_stmt = tmpIf->falseBody(); - continue; - } - else - analyze_stmt = tmpIf->falseBody(); - } - else - { - analyze_stmt = tmpIf->lastNodeOfStmt(); - controlEndsOfIfStmt.pop(); - } - } - } - else - { - if(DVM_DEBUG_LVL > 1) - otherVars.insert(analyze_stmt->variant()); - } - if(DVM_DEBUG_LVL > 1) - fprintf(fileStmts, "%s \n", copyOfUnparse(analyze_stmt->unparse())); - - analyze_stmt = analyze_stmt->lexNext(); - } - - if(DVM_DEBUG_LVL > 1) - { - for(std::set::iterator t = otherVars.begin(); t != otherVars.end(); t++) - fprintf(file, " [INFO] other variant is %d\n", *t); - - fprintf(file, "finish analyze stmts\n"); - fprintf(fileStmts, "//--------------------------------- end -------------------------------//\n\n"); - - fflush(file); - fflush(fileStmts); - } - - if(!ifBreak) - { - // <-gpuO1 lvl1> BLOCK - findBest(allStat, best_patterns, dvm_dir_pattern); - correctBestPattern(allStat, best_patterns, dvm_dir_pattern); - generateOptimalExpressions(allStat, best_patterns, newVars); - // end BLOCK - - // <-gpuO1 lvl2> BLOCK - /*if (type == NON_ACROSS_TYPE && unknownLoop == false) - { - findGroups(allStat, allArrayGroup); - correctGroups(allArrayGroup); - correctLoopBody(allArrayGroup); - }*/ - // end BLOCK - - if(DVM_DEBUG_LVL > 1) - { - fprintf(file, "allStat size %u\n", (unsigned) allStat.size()); - - for(size_t i = 0; i < allStat.size(); ++i) - { - fprintf(file, " name of array %s\n", allStat[i].name_of_array->identifier()); - fprintf(file, " patterns size %u\n", (unsigned) allStat[i].patterns.size()); - for(size_t k = 0; k < allStat[i].patterns.size(); ++k) - { - if(allStat[i].patterns[k].count_write_op != 0) - { - fprintf(file, " ex W = %d; ", allStat[i].patterns[k].count_write_op); - fprintf(file, "(%s)\n", copyOfUnparse(allStat[i].patterns[k].symbs->unparse())); - } - } - - for(size_t k = 0; k < allStat[i].patterns.size(); ++k) - { - if(allStat[i].patterns[k].count_read_op != 0) - { - fprintf(file, " ex R = %d; ", allStat[i].patterns[k].count_read_op); - fprintf(file, "(%s)\n", copyOfUnparse(allStat[i].patterns[k].symbs->unparse())); - } - } - - if(best_patterns.size() != 0) - { - fprintf(file, " best pattern: "); - for(size_t k = 0; k < best_patterns[i].what.size(); ++k) - fprintf(file, "%d ", best_patterns[i].what[k]); - - fprintf(file, " with count_of_pattern %d\n", best_patterns[i].count_of_pattern); - } - } - - fprintf(file, "scalar_stmts size %u\n", (unsigned) scalar_stmts.size()); - for(size_t i = 0; i < scalar_stmts.size(); ++i) - { - fprintf(file, " stmt "); - fprintf(file, "%s", copyOfUnparse(scalar_stmts[i]->unparse())); - } - fprintf(file, "finish analyze stmts\n"); - fprintf(file, "//--------------------------------- end -------------------------------//\n\n"); - } - - DVM_DEBUG_LVL = lastDLVL; - if(newVars.size() != 0) - { - printf(" -------- Loop on line %d was optimized ---------- \n", first_do_par->lineNumber()); - correctPrivateList(ADD); - } - } - - AnalyzeReturnGpuO1 retStruct; - retStruct.allArrayGroup = allArrayGroup; - retStruct.allStat = allStat; - retStruct.bestPatterns = best_patterns; - - return retStruct; -} - -// optimization of one ACROSS, that is needed. BLOCK start - -SgExpression* replaceInEx(std::vector &allNewInfo, std::vector &allInfo, SgExpression *ex, SgExpression *parent, int LR) -{ - SgExpression *ret = NULL; - if (ex->variant() == ARRAY_REF) - { - char *name = ex->symbol()->identifier(); - for (size_t i = 0; i < allInfo.size(); ++i) - { - if (strcmp(name, allInfo[i].nameOfArray) == 0) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*allNewInfo[i].newArray); - SgExpression *list = ex->lhs(); - for (size_t k = 0; k < allInfo[i].dims.size(); ++k) - { - if (allInfo[i].dims[k] != 1 && allInfo[i].acrossPos != (int)k) - { - arrayEx->addSubscript(*&list->lhs()->copy()); - } - else if (allInfo[i].acrossPos == (int)k) - { - arrayEx->addSubscript(*&list->lhs()->copy() - *new SgVarRefExp(allInfo[i].symbs[k])); - } - list = list->rhs(); - } - if (LR == 1) - parent->setLhs(arrayEx); - else if (LR == 2) - parent->setRhs(arrayEx); - else - ret = arrayEx; - break; - } - } - } - else - { - if (ex->lhs()) - replaceInEx(allNewInfo, allInfo, ex->lhs(), ex, 1); - if (ex->rhs()) - replaceInEx(allNewInfo, allInfo, ex->rhs(), ex, 2); - } - return ret; -} - -void replace(std::vector &allNewInfo, std::vector &allInfo) -{ - SgStatement *body = loop_body; - while (body) - { - if (body->variant() == ASSIGN_STAT) - { - SgExpression *left, *right; - left = replaceInEx(allNewInfo, allInfo, body->expr(0), NULL, 3); - right = replaceInEx(allNewInfo, allInfo, body->expr(1), NULL, 3); - if (left != NULL && right != NULL) - { - body->setExpression(0, *left); - body->setExpression(1, *right); - - } - else if (left != NULL) - { - body->setExpression(0, *left); - } - else if (right != NULL) - { - body->setExpression(1, *right); - } - } - body = body->lexNext(); - } -} - -void createSwaps(newInfo &info, acrossInfo &oldInfo, int pos, std::vector idxVal) -{ - if (info.dimSize.size() - 1 == (size_t)pos) // last and across - { - //down - for (int i = oldInfo.widthL; i < oldInfo.widthR; ++i) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); - SgArrayRefExp *arrayExLast = new SgArrayRefExp(*info.newArray); - - for (size_t k = 0; k < idxVal.size(); ++k) - { - arrayEx->addSubscript(*new SgValueExp(idxVal[k])); - arrayExLast->addSubscript(*new SgValueExp(idxVal[k])); - } - arrayEx->addSubscript(*new SgValueExp((int)i)); - arrayExLast->addSubscript(*new SgValueExp((int)(i + 1))); - info.swapsDown.push_back(new SgAssignStmt(*arrayEx, *arrayExLast)); - } - - //up - for (int i = oldInfo.widthR; i > oldInfo.widthL; i--) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); - SgArrayRefExp *arrayExLast = new SgArrayRefExp(*info.newArray); - - for (size_t k = 0; k < idxVal.size(); ++k) - { - arrayEx->addSubscript(*new SgValueExp(idxVal[k])); - arrayExLast->addSubscript(*new SgValueExp(idxVal[k])); - } - arrayEx->addSubscript(*new SgValueExp((int)i)); - arrayExLast->addSubscript(*new SgValueExp((int)(i - 1))); - info.swapsUp.push_back(new SgAssignStmt(*arrayEx, *arrayExLast)); - } - } - else - { - for (int i = 1; i <= info.dimSize[pos]; ++i) - { - std::vector newIdx = idxVal; - newIdx.push_back((int)i); - createSwaps(info, oldInfo, pos + 1, newIdx); - } - } -} - -void createLoadsAndStores(newInfo &info, acrossInfo &oldInfo, int pos, std::vector idxVal) -{ - if (info.dimSize.size() - 1 == (size_t)pos) // last and across - { - for (int i = oldInfo.widthL; i <= oldInfo.widthR; ++i) - { - SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); - SgArrayRefExp *oldArrayEx = new SgArrayRefExp(*oldInfo.symbol); - int idxValp = 0; - for (size_t k = 0; k < oldInfo.dims.size(); ++k) - { - if (oldInfo.dims[k] == 1) - { - if ((int)k == oldInfo.acrossPos) - oldArrayEx->addSubscript(*new SgVarRefExp(oldInfo.symbs[k]) + *new SgValueExp((int)i)); - else - oldArrayEx->addSubscript(*new SgVarRefExp(oldInfo.symbs[k])); - } - else - { - oldArrayEx->addSubscript(*new SgValueExp(idxVal[idxValp])); - idxValp++; - } - } - - for (size_t k = 0; k < idxVal.size(); ++k) - { - arrayEx->addSubscript(*new SgValueExp(idxVal[k])); - } - arrayEx->addSubscript(*new SgValueExp((int)i)); - - if (i == oldInfo.widthR) - { - info.loadsInForPlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - info.loadsBeforeMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - } - else if (i == oldInfo.widthL) - { - info.loadsBeforePlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - info.loadsInForMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - } - else - { - info.loadsBeforePlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - info.loadsBeforeMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); - } - if (i == 0) - info.stores.push_back(new SgAssignStmt(*oldArrayEx, *arrayEx)); - } - } - else // non across - { - for (int i = 1; i <= info.dimSize[pos]; ++i) - { - std::vector newIdx = idxVal; - newIdx.push_back((int)i); - createLoadsAndStores(info, oldInfo, pos + 1, newIdx); - } - } -} - -SgSymbol* searchOneIdx(SgExpression *ex) -{ - SgSymbol *ret = NULL; - if (ex->variant() == VAR_REF) - { - for (size_t i = 0; i < loopVars.size(); ++i) - { - if (strcmp(loopVars[i]->identifier(), ex->symbol()->identifier()) == 0) - { - ret = loopVars[i]; - break; - } - } - } - else - { - if (ex->lhs() && ret == NULL) - { - ret = searchOneIdx(ex->lhs()); - if (ret == NULL && ex->rhs()) - ret = searchOneIdx(ex->rhs()); - } - } - return ret; -} - -void searchIdxs(std::vector &allInfo, SgExpression *st) -{ - if (st->variant() == ARRAY_REF) - { - for (size_t i = 0; i < allInfo.size(); ++i) - { - if (strcmp(allInfo[i].nameOfArray, st->symbol()->identifier()) == 0) - { - int p = 0; - SgExpression *list = st->lhs(); - while (list) - { - if (allInfo[i].dims[p] == 0) - { - SgSymbol *stmp = searchOneIdx(list->lhs()); - if (stmp != NULL) - { - allInfo[i].dims[p] = 1; - allInfo[i].symbs[p] = stmp; - } - } - list = list->rhs(); - p++; - } - break; - } - } - } - else - { - if (st->lhs()) - searchIdxs(allInfo, st->lhs()); - if (st->rhs()) - searchIdxs(allInfo, st->rhs()); - } -} - -void optimizeLoopBodyForOne(std::vector &allNewInfo) -{ - SgExpression *tmp = dvm_parallel_dir->expr(1); - std::vector allInfo; - bool nextStep; - - while (tmp) - { - SgExpression *t = tmp->lhs(); - if (t->variant() == ACROSS_OP) - { - std::vector toAnalyze; - if (t->lhs()->variant() == EXPR_LIST) - toAnalyze.push_back(t->lhs()); - else - { - if (t->lhs()->variant() == DDOT) - toAnalyze.push_back(t->lhs()->rhs()); - - if (t->rhs()) - if (t->rhs()->variant() == DDOT) - toAnalyze.push_back(t->rhs()->rhs()); - } - - for (int i = 0; i < toAnalyze.size(); ++i) - { - t = toAnalyze[i]; - while (t) - { - acrossInfo tmpI; - tmpI.nameOfArray = t->lhs()->symbol()->identifier(); - tmpI.symbol = t->lhs()->symbol(); - tmpI.allDim = 0; - tmpI.widthL = 0; - tmpI.widthR = 0; - tmpI.acrossPos = 0; - tmpI.acrossNum = 0; - SgExpression *tt = t->lhs()->lhs(); - int position = 0; - while (tt) - { - bool here = true; - if (tt->lhs()->lhs()->valueInteger() != 0) - { - tmpI.acrossPos = position; - tmpI.acrossNum++; - tmpI.widthL = (-1) * tt->lhs()->lhs()->valueInteger(); - here = false; - } - if (tt->lhs()->rhs()->valueInteger() != 0) - { - tmpI.acrossPos = position; - if (here) - tmpI.acrossNum++; - tmpI.widthR = tt->lhs()->rhs()->valueInteger(); - } - position++; - tt = tt->rhs(); - } - for (int i = 0; i < position; ++i) - { - tmpI.dims.push_back(0); - tmpI.symbs.push_back(NULL); - } - allInfo.push_back(tmpI); - - t = t->rhs(); - } - } - break; - } - tmp = tmp->rhs(); - } - - nextStep = true; - for (size_t i = 0; i < allInfo.size(); ++i) - { - if (allInfo[i].acrossNum > 1) - { - nextStep = false; - break; - } - } - - if (nextStep) - { - SgStatement *st = loop_body; - loopVars.clear(); - - tmp = dvm_parallel_dir->expr(2); - while (tmp) - { - loopVars.push_back(tmp->lhs()->symbol()); - tmp = tmp->rhs(); - } - - while (st) - { - if (st->variant() == ASSIGN_STAT) - { - searchIdxs(allInfo, st->expr(0)); - searchIdxs(allInfo, st->expr(1)); - } - st = st->lexNext(); - } - - for (size_t i = 0; i < allInfo.size(); ++i) - { - if (allInfo[i].symbs[allInfo[i].acrossPos] == NULL) - { - nextStep = false; - break; - } - } - - if (nextStep) - { - for (size_t i = 0; i < allInfo.size(); ++i) - { - for (size_t k = 0; k < allInfo[i].dims.size(); ++k) - { - if (allInfo[i].dims[k] == 0) - { - SgArrayType *tArr = isSgArrayType(allInfo[i].symbol->type()); - if (tArr != NULL) - { - SgExpression *dimList = tArr->getDimList(); - if (dimList != NULL) - { - size_t p = 0; - while (dimList && p != k) - { - p++; - dimList = dimList->rhs(); - } - // DDOT !! - int val = dimList->lhs()->valueInteger(); - allInfo[i].dims[k] = val; - } - } - } - } - } - - for (size_t i = 0; i < allInfo.size(); ++i) - { - for (size_t k = 0; k < allInfo[i].dims.size(); ++k) - { - if (allInfo[i].dims[k] == 0) - { - nextStep = false; - break; - } - } - } - - if (nextStep) - { - for (size_t i = 0; i < allInfo.size(); ++i) - { - char *newName = new char[strlen(allInfo[i].nameOfArray) + 2]; - newName[0] = '\0'; - strcat(newName, allInfo[i].nameOfArray); - strcat(newName, "_"); - newInfo tmpNewInfo; - tmpNewInfo.newArray = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newName)); - SgArrayType *tpArrNew = new SgArrayType(*allInfo[i].symbol->type()); - for (size_t k = 0; k < allInfo[i].dims.size(); ++k) - { - // DDOT - if (allInfo[i].dims[k] != 1) - { - tpArrNew->addDimension(new SgValueExp(allInfo[i].dims[k])); - tmpNewInfo.dimSize.push_back(allInfo[i].dims[k]); - } - } - - SgExprListExp *ex = new SgExprListExp(DDOT); - ex->setLhs(*new SgValueExp(allInfo[i].widthL)); - ex->setRhs(*new SgValueExp(allInfo[i].widthR)); - tpArrNew->addDimension(ex); - tmpNewInfo.newArray->setType(tpArrNew); - - tmpNewInfo.dimSize.push_back(abs(allInfo[i].widthR - allInfo[i].widthL) + 1); - allNewInfo.push_back(tmpNewInfo); - } - - //create loads and stores - // DDOT - for (size_t i = 0; i < allNewInfo.size(); ++i) - { - std::vector tmp; - createLoadsAndStores(allNewInfo[i], allInfo[i], 0, tmp); - createSwaps(allNewInfo[i], allInfo[i], 0, tmp); - } - - replace(allNewInfo, allInfo); - for (size_t i = 0; i < allNewInfo.size(); ++i) - newVars.push_back(allNewInfo[i].newArray); - if (newVars.size() != 0) - { - correctPrivateList(ADD); - printf(" -------- Loop on line %d was optimized ---------- \n", first_do_par->lineNumber()); - } - // TMP PRINT - /*printf("plus before assigns\n"); - for (size_t i = 0; i < allNewInfo[0].loadsBeforePlus.size(); ++i) - { - allNewInfo[0].loadsBeforePlus[i]->unparsestdout(); - } - printf("minus before assigns\n"); - for (size_t i = 0; i < allNewInfo[0].loadsBeforeMinus.size(); ++i) - { - allNewInfo[0].loadsBeforeMinus[i]->unparsestdout(); - } - printf("plus in FOR assigns\n"); - for (size_t i = 0; i < allNewInfo[0].loadsInForPlus.size(); ++i) - { - allNewInfo[0].loadsInForPlus[i]->unparsestdout(); - } - printf("minus in FOR assigns\n"); - for (size_t i = 0; i < allNewInfo[0].loadsInForMinus.size(); ++i) - { - allNewInfo[0].loadsInForMinus[i]->unparsestdout(); - } - printf("stores assigns\n"); - for (size_t i = 0; i < allNewInfo[0].stores.size(); ++i) - { - allNewInfo[0].stores[i]->unparsestdout(); - } - printf("swaps Down assigns\n"); - for (size_t i = 0; i < allNewInfo[0].swapsDown.size(); ++i) - { - allNewInfo[0].swapsDown[i]->unparsestdout(); - } - printf("swaps Up assigns\n"); - for (size_t i = 0; i < allNewInfo[0].swapsUp.size(); ++i) - { - allNewInfo[0].swapsUp[i]->unparsestdout(); - }*/ - } - } - } -} -// BLOCK end diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/aks_loopStructure.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/aks_loopStructure.cpp deleted file mode 100644 index 08b7aef..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/aks_loopStructure.cpp +++ /dev/null @@ -1,615 +0,0 @@ -#include "dvm.h" -#include "acc_data.h" -#include "aks_structs.h" -#include "aks_loopStructure.h" - -extern SgStatement *dvm_parallel_dir; -extern SgStatement* AssignStatement(SgExpression &lhs, SgExpression &rhs); - -using namespace std; - -// ---------------------------------------------------------------------- // Access - -Access::Access(SgExpression *_exp, Array *_parent) -{ - exp = _exp; - expAcc = copyOfUnparse(exp->unparse()); - operation[0] = operation[1] = 0; - parentArray = _parent; -} - -// only one idx in one dimention in exp -void Access::matchLoopIdxs(vector &symbols) -{ - SgExpression *tmp = exp; - int idx = 0; - - if (alignOnLoop.size() == 0) - alignOnLoop = vector(parentArray->getDimNum()); - - while (tmp) - { - for (unsigned i = 0; i < symbols.size(); ++i) - { - alignOnLoop[idx] = -1; - if (matchRecursion(tmp->lhs(), symbols[i])) - { - alignOnLoop[idx] = i; - break; - } - } - idx++; - tmp = tmp->rhs(); - } -} - -bool Access::matchRecursion(SgExpression *_exp, SgSymbol *symb) -{ - bool retVal = false; - - SgExpression *left = _exp->lhs(); - SgExpression *right = _exp->rhs(); - - if (_exp->variant() != VAR_REF) - { - if (left) - retVal = retVal || matchRecursion(left, symb); - if (right) - retVal = retVal || matchRecursion(right, symb); - } - else - { - SgSymbol *s = _exp->symbol(); - if (strcmp(s->identifier(), symb->identifier()) == 0) - retVal = true; - } - return retVal; -} - -void Access::setExp(char* _exp) { expAcc = _exp; } -void Access::setExp(SgExpression *_exp) { exp = _exp; } -char* Access::getExpChar() { return expAcc; } -SgExpression* Access::getExp() { return exp; } -void Access::incOperW() { operation[1]++; } -void Access::incOperR() { operation[0]++; } -Array* Access::getParentArray() { return parentArray; } -void Access::setParentArray(Array *_parent) { parentArray = _parent; } -std::vector* Access::getAlignOnLoop() { return &alignOnLoop; } - -// ---------------------------------------------------------------------- // Array - -Array::Array(int _dim, char *_name, Loop *_parent) -{ - dimNum = _dim; - name = _name; - parentLoop = _parent; - acrossType = 0; -} - -Array::Array(char *_name, Loop *_parent) -{ - name = _name; - parentLoop = _parent; - acrossType = 0; -} - -Access* Array::getAccess(char* _expAcc) -{ - int idx = -1; - for (unsigned i = 0; i < accesses.size(); ++i) - { - if (strcmp(_expAcc, accesses[i]->getExpChar()) == 0) - { - idx = i; - break; - } - } - if (idx == -1) - return NULL; - else - return accesses[idx]; -} - -void Array::analyzeAcrDims() -{ - SgExpression *tmp = dvm_parallel_dir->expr(1); - bool fieled = false; - while (tmp) - { - SgExpression *t = tmp->lhs(); - unsigned numberOfAcr = 0; - if (t->variant() == ACROSS_OP) - { - t = t->lhs(); - while (t) - { - if (strcmp(name, t->lhs()->symbol()->identifier()) == 0) - { - fieled = true; - SgExpression *tt = t->lhs()->lhs(); - while (tt) - { - bool acrossYes = false; - if (tt->lhs()->lhs()->valueInteger() != 0) - acrossYes = true; - if (tt->lhs()->rhs()->valueInteger() != 0) - acrossYes = true; - - if (acrossYes) - { - acrossDims.push_back(1); - numberOfAcr++; - } - else - acrossDims.push_back(0); - tt = tt->rhs(); - } - } - t = t->rhs(); - } - } - if (numberOfAcr != 0) - acrossType = (1 << numberOfAcr) - 1; - tmp = tmp->rhs(); - } - - if (fieled == false) - { - for (int i = 0; i < dimNum; ++i) - acrossDims.push_back(-1); - } - - if (abs(dimNum - parentLoop->getLoopDim())) - { - for (int i = 0; i < abs(dimNum - parentLoop->getLoopDim()); i++) - acrossDims.push_back(-1); - } - -} - -void Array::analyzeAlignOnLoop() -{ - alignOnLoop = std::vector(dimNum); - for (int i = 0; i < dimNum; ++i) - alignOnLoop[i] = -1; - - if (accesses.size() > 0) - { - - for (unsigned i = 0; i < accesses.size(); ++i) - { - if (accesses[i]->getAlignOnLoop()->size() == 0) - accesses[i]->matchLoopIdxs(*parentLoop->getSymbols()); - } - - int *tmp = new int[dimNum]; - for (int i = 0; i < dimNum; ++i) - tmp[i] = (*(accesses[0]->getAlignOnLoop()))[i]; - - bool eq = true; - for (unsigned i = 1; i < accesses.size(); ++i) - { - bool ok = true; - for (int k = 0; k < dimNum; ++k) - { - if (tmp[k] != (*(accesses[i]->getAlignOnLoop()))[k]) - { - ok = false; - break; - } - } - - if (!ok) - { - eq = false; - break; - } - } - - if (eq) - { - for (int i = 0; i < dimNum; ++i) - alignOnLoop[i] = tmp[i]; - } - } -} - -void Array::analyzeTrDims() -{ - int dimParLoop = parentLoop->getLoopDim(); - - int idxAcrossSymb1 = -1; - int idxAcrossSymb2 = -1; - - // all for's of Loop with across - if (dimParLoop > 1 && parentLoop->getAcrType() > 1) - { - if (parentLoop->getAcrType() == dimParLoop) - { - idxAcrossSymb1 = dimParLoop - 1; - idxAcrossSymb2 = dimParLoop - 2; - } - else - { - int t = 0; - for (int p = (int)(acrossDims.size() - 1); p >= 0 && t != 2; --p) - { - if (acrossDims[p] == 1) - { - idxAcrossSymb1 = p; - t++; - } - } - } - - int idxInArray1 = -1; - int idxInArray2 = -1; - for (unsigned i = 0; i < alignOnLoop.size(); ++i) - { - if (alignOnLoop[i] == idxAcrossSymb1) - idxInArray1 = i; - else if (alignOnLoop[i] == idxAcrossSymb2) - idxInArray2 = i; - } - - if (idxInArray1 != -1 && idxInArray2 != -1) - { - // inverse idxInArray and count from "1" - idxInArray1 = dimNum - idxInArray1; - idxInArray2 = dimNum - idxInArray2; - } - - addTfmDim(idxInArray1); - addTfmDim(idxInArray2); - } -} - -SgSymbol* Array::findAccess(SgExpression *_exp, char *&_charEx) -{ - SgSymbol *retVal = NULL; - char *retStr = new char[1024]; // WARNING!! may be segfault - SgExpression *tmp = _exp; - - retStr[0] = '\0'; - int out = 0; - int idx = 0; - while (tmp && out != 2) - { - if (dimNum - idx == transformDims[0] || dimNum - idx == transformDims[1]) - { - strcat(retStr, UnparseExpr(tmp->lhs())); - strcat(retStr, "_"); - out++; - } - idx++; - tmp = tmp->rhs(); - } - - for (unsigned i = 0; i < charEx.size(); ++i) - { - if (strcmp(charEx[i], retStr) == 0) - { - retVal = coefInAccess[i]; - break; - } - } - - if (retVal == NULL) - { - _charEx = new char[strlen(retStr) + 1]; - _charEx[0] = '\0'; - strcat(_charEx, retStr); - } - delete []retStr; - return retVal; -} - -void Array::addNewCoef(SgExpression *_exp, char *_charEx, SgSymbol* _symb) -{ - SgExpression *tmp = _exp; - - int out = 0; - int idx = 0; - while (tmp && out != 2) - { - if (dimNum - idx == transformDims[0]) - firstEx.push_back(tmp->lhs()); - else if (dimNum - idx == transformDims[1]) - secondEx.push_back(tmp->lhs()); - idx++; - tmp = tmp->rhs(); - } - - charEx.push_back(_charEx); - coefInAccess.push_back(_symb); -} - -void Array::generateAssigns(SgVarRefExp *offsetX, SgVarRefExp *offsetY, SgVarRefExp *Rx, SgVarRefExp *Ry, SgVarRefExp *slash) -{ - if (ifCalls.size() == 0 && elseCalls.size() == 0 && zeroSt.size() == 0) - { - for (unsigned i = 0; i < coefInAccess.size(); ++i) - { - zeroSt.push_back(AssignStatement(*new SgVarRefExp(coefInAccess[i]->copy()), *new SgValueExp(0))); - SgFunctionCallExp *funcCallExpIf, *funcCallExpElse; - - funcCallExpIf = new SgFunctionCallExp(*(new SgSymbol(FUNCTION_NAME, funcDvmhConvXYname))); - funcCallExpElse = new SgFunctionCallExp(*(new SgSymbol(FUNCTION_NAME, funcDvmhConvXYname))); - - funcCallExpIf->addArg(firstEx[i]->copy() - *offsetX); - funcCallExpIf->addArg(secondEx[i]->copy() - *offsetY); - funcCallExpIf->addArg(*Rx); - funcCallExpIf->addArg(*Ry); - funcCallExpIf->addArg(*slash); - funcCallExpIf->addArg(*new SgVarRefExp(coefInAccess[i]->copy())); - - funcCallExpElse->addArg(secondEx[i]->copy() - *offsetX); - funcCallExpElse->addArg(firstEx[i]->copy() - *offsetY); - funcCallExpElse->addArg(*Rx); - funcCallExpElse->addArg(*Ry); - funcCallExpElse->addArg(*slash); - funcCallExpElse->addArg(*new SgVarRefExp(coefInAccess[i]->copy())); - - ifCalls.push_back(funcCallExpIf); - elseCalls.push_back(funcCallExpElse); - } - } -} - -void Array::setDimNum(int _num) { dimNum = _num; } -int Array::getDimNum() { return dimNum; } -Loop* Array::getParentLoop() { return parentLoop; } -void Array::setParentLoop(Loop *_loop) { parentLoop = _loop; } -vector* Array::getAcrDims() { return &acrossDims; } -vector* Array::getAlignOnLoop() { return &alignOnLoop; } -void Array::addTfmDim(int _dim) { transformDims.push_back(_dim); } -vector* Array::getTfmDims() { return &transformDims; } -void Array::addAccess(Access* _newAccess) { accesses.push_back(_newAccess); } -vector* Array::getAccesses() { return &accesses; } -void Array::setArrayName(char* _name) { name = _name; } -char* Array::getArrayName() { return name; } -int Array::getAcrType() { return acrossType; } -void Array::setAcrType(int _type) { acrossType = _type; } -vector* Array::getIfCals() { return &ifCalls; } -vector* Array::getElseCals() { return &elseCalls; } -vector* Array::getZeroSt() { return &zeroSt; } -vector* Array::getCoefInAccess() { return &coefInAccess; } -// ---------------------------------------------------------------------- // Loop - -Loop::Loop(int _line) -{ - line = _line; - acrossType = 0; - loopDim = 0; -} - -Loop::Loop(int _line, SgStatement *_body) -{ - line = _line; - loopBody = _body; - acrossType = 0; - loopDim = 0; -} - -Loop::Loop(int _acrType, int _line, SgStatement *_body) -{ - line = _line; - loopBody = _body; - acrossType = _acrType; - loopDim = 0; -} - -Loop::Loop(int _line, SgStatement *_body, bool withAnalyze) -{ - line = _line; - loopBody = _body; - acrossType = 0; - loopDim = 0; - - if (withAnalyze) - analyzeLoopBody(); -} - -void Loop::analyzeLoopBody() -{ - // create info of array - SgStatement *stmt = loopBody; - while (stmt) - { - if (stmt->variant() == ASSIGN_STAT) - { - SgExpression *exL = stmt->expr(0); - SgExpression *exR = stmt->expr(1); - - if (exL) - analyzeAssignOp(exL, 1); - if (exR) - analyzeAssignOp(exR, 0); - } - stmt = stmt->lexNext(); - } - - // create idxs info - SgExpression *par_dir = dvm_parallel_dir->expr(2); - while (par_dir) - { - symbols.push_back(par_dir->lhs()->symbol()); - par_dir = par_dir->rhs(); - } - loopDim = symbols.size(); - - // create private list - SgExpression *tmp = dvm_parallel_dir->expr(1); - while (tmp) - { - SgExpression *t = tmp->lhs(); - if (t->variant() == ACC_PRIVATE_OP) - { - t = t->lhs(); - while (t) - { - if (isSgArrayType(t->lhs()->symbol()->type())) - privateList.push_back(copyOfUnparse(t->lhs()->symbol()->identifier())); - t = t->rhs(); - } - } - tmp = tmp->rhs(); - } - - // analyze acrossType and acrossDims in all arrays - for (unsigned i = 0; i < arrays.size(); ++i) - { - if ( !isArrayInPrivate(arrays[i]->getArrayName()) ) - { - arrays[i]->analyzeAcrDims(); - arrays[i]->analyzeAlignOnLoop(); - } - } - - analyzeAcrossType(); - - // analyze transformDims in all arrays - if (acrossType > 1) - { - for (unsigned i = 0; i < arrays.size(); ++i) - { - if (!isArrayInPrivate(arrays[i]->getArrayName())) - arrays[i]->analyzeTrDims(); - } - } -} - -void Loop::analyzeAssignOp(SgExpression *_exp, int oper) -{ - if (_exp->variant() != ARRAY_REF) - { - if (_exp->lhs()) - analyzeAssignOp(_exp->lhs(), oper); - if (_exp->rhs()) - analyzeAssignOp(_exp->rhs(), oper); - } - else - { - SgSymbol *arrName = _exp->symbol(); - if (isSgArrayType(arrName->type())) // if array ref - { - int idx; - Array *newArray = getArray(arrName->identifier(), &idx); - if (newArray == NULL) - { - Array *nArr = new Array(arrName->identifier(), this); - Access *nAcc = new Access(_exp->lhs(), nArr); - - nArr->setDimNum(isSgArrayType(arrName->type())->dimension()); - nArr->addAccess(nAcc); - addArray(nArr); - - if (oper == 1) - nAcc->incOperW(); - else if (oper == 0) - nAcc->incOperR(); - } - else - { - char *strAcc = copyOfUnparse(_exp->lhs()->unparse()); - Access *tAcc = newArray->getAccess(strAcc); - - if (tAcc == NULL) - { - tAcc = new Access(_exp->lhs(), newArray); - newArray->addAccess(tAcc); - } - - if (oper == 1) - tAcc->incOperW(); - else if (oper == 0) - tAcc->incOperR(); - } - } - } -} - -Array* Loop::getArray(char *name, int *_idx) -{ - int idx = -1; - for (unsigned i = 0; i < arrays.size(); ++i) - { - if (strcmp(name, arrays[i]->getArrayName()) == 0) - { - idx = i; - break; - } - } - _idx[0] = idx; - if (idx == -1) - return NULL; - else - return arrays[idx]; -} - -Array* Loop::getArray(char *name) -{ - int idx = -1; - for (unsigned i = 0; i < arrays.size(); ++i) - { - if (strcmp(name, arrays[i]->getArrayName()) == 0) - { - idx = i; - break; - } - } - - if (idx == -1) - return NULL; - else - return arrays[idx]; -} - -void Loop::analyzeAcrossType() -{ - for (int i = 0; i < loopDim; ++i) - acrDims.push_back(-1); - - for (unsigned i = 0; i < arrays.size(); ++i) - { - std::vector* tArrAcrDims = arrays[i]->getAcrDims(); - std::vector* tArrAlign = arrays[i]->getAlignOnLoop(); - - for (unsigned k = 0; k < tArrAlign->size(); ++k) - { - if ((*tArrAlign)[k] != -1) - acrDims[(*tArrAlign)[k]] = MAX(acrDims[(*tArrAlign)[k]], (*tArrAcrDims)[(*tArrAlign)[k]]); - } - } - - acrossType = 0; - for (int i = 0; i < loopDim; ++i) - { - if (acrDims[i] != -1) - acrossType++; - } - -} - -bool Loop::isArrayInPrivate(char *name) -{ - bool retVal = false; - for (unsigned i = 0; i < privateList.size(); ++i) - { - if (strcmp(name, privateList[i]) == 0) - { - retVal = true; - break; - } - } - return retVal; -} - -void Loop::addArray(Array *_array) { arrays.push_back(_array); } -void Loop::setLine(int _line) { line = _line; } -int Loop::getLine() { return line; } -void Loop::setAcrType(int _type) { acrossType = _type; } -int Loop::getAcrType() { return acrossType; } -vector* Loop::getArrays() { return &arrays; } -vector* Loop::getSymbols() { return &symbols; } -int Loop::getLoopDim() { return loopDim; } diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/aks_structs.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/aks_structs.cpp deleted file mode 100644 index ab4da20..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/aks_structs.cpp +++ /dev/null @@ -1,206 +0,0 @@ -#include "dvm.h" -#include "aks_structs.h" -#include -#include -#include - -using std::vector; -using std::string; -using std::map; - -#define DEBUG_LV1 true -#if 1 -std::ostream &out = std::cout; -#else -std::ofstream out("_log_debug_info.txt"); -#endif - -extern SgStatement *dvm_parallel_dir; - -SgExpression* findDirect(SgExpression *inExpr, int DIR) -{ - SgExpression *temp = NULL; - if (inExpr) - { - if (inExpr->variant() == DIR) - return inExpr; - else - { - if (inExpr->lhs()) - temp = findDirect(inExpr->lhs(), DIR); - - if(temp == NULL && inExpr->rhs()) - temp = findDirect(inExpr->rhs(), DIR); - } - } - return temp; -} - -static vector fillDataOfArray(SgExpression* on, int& dimInPar) -{ - dimInPar = 0; - SgExpression* temp = on; - while (temp) - { - dimInPar++; - temp = temp->rhs(); - } - - vector symbInPar(dimInPar); - temp = on; - for (int i = 0; i < dimInPar; ++i) - { - symbInPar[i] = temp->lhs()->symbol(); - temp = temp->rhs(); - } - return symbInPar; -} - -static void printError() -{ - err("internal error in across", 424, first_do_par); - exit(-1); -} - -static vector GetIdxInParDir(const map& on, SgExpression *across, bool tie = false) -{ - vector ret; - - int dimInPar = 0; - vector symbInPar; - vector toAnalyze; - - if (across->lhs()->variant() == EXPR_LIST) - toAnalyze.push_back(across->lhs()); - else - { - if (across->lhs()->variant() == DDOT) - toAnalyze.push_back(across->lhs()->rhs()); - if (across->rhs()) - if (across->rhs()->variant() == DDOT) - toAnalyze.push_back(across->rhs()->rhs()); - } - - for (int i = 0; i < toAnalyze.size(); ++i) - { - across = toAnalyze[i]; - while (across) - { - if (symbInPar.size() == 0) - { - if (on.size() == 0) - printError(); - else if (on.size() == 1) - symbInPar = fillDataOfArray(on.begin()->second, dimInPar); - } - - SgExpression *t = across->lhs(); - int dim = 0; - - if (tie) - { - if (t->variant() == ARRAY_REF) - { - if (on.find(t->symbol()->identifier()) == on.end()) - printError(); - else - symbInPar = fillDataOfArray(on.find(t->symbol()->identifier())->second, dimInPar); - } - else if (t->variant() == ARRAY_OP) - { - if (on.find(t->lhs()->symbol()->identifier()) == on.end()) - printError(); - else - symbInPar = fillDataOfArray(on.find(t->lhs()->symbol()->identifier())->second, dimInPar); - } - } - - if (t->variant() == ARRAY_REF) - t = t->lhs(); - else if (t->variant() == ARRAY_OP) - t = t->lhs()->lhs(); - else - { - if (DEBUG_LV1) - out << "!!! unknown variant in ACROSS dir: " << t->variant() << std::endl; - } - - SgExpression *tmp = t; - while (tmp) - { - dim++; - tmp = tmp->rhs(); - } - - SageArrayIdxs act; - - act.symb.resize(dim); - act.dim = dim; - for (int i = 0; i < dim; ++i) - { - act.symb[i].across_left = t->lhs()->lhs()->valueInteger(); - act.symb[i].across_right = t->lhs()->rhs()->valueInteger(); - if (act.symb[i].across_left != 0 || act.symb[i].across_right != 0) - act.symb[i].symb = symbInPar[i]; - else if (i < dimInPar) - act.symb[i].symb = symbInPar[i]; - else - act.symb[i].symb = NULL; - t = t->rhs(); - } - - ret.push_back(act); - across = across->rhs(); - } - } - - return ret; -} - -SageAcrossInfo GetLoopsWithParAndAcrDir() -{ - SageAcrossInfo retVal; - SgStatement *temp = dvm_parallel_dir; - - if (temp->variant() == DVM_PARALLEL_ON_DIR) - { - SgExpression *t = findDirect(temp->expr(1), ACROSS_OP); - SgExpression *tie = findDirect(temp->expr(1), ACC_TIE_OP); - - map arrays; - if (t != NULL) - { - if (temp->expr(0) && temp->expr(0)->lhs()) - { - arrays[temp->expr(0)->symbol()->identifier()] = temp->expr(0)->lhs(); - retVal.idxs = GetIdxInParDir(arrays, t); - } - else if (tie) - { - SgExpression* list = tie->lhs(); - while (list) - { - arrays[list->lhs()->symbol()->identifier()] = list->lhs()->lhs(); - list = list->rhs(); - } - retVal.idxs = GetIdxInParDir(arrays, t, true); - } - else - printError(); - } - } - return retVal; -} - -vector GetSymbInParalell(SgExpression *first) -{ - vector retval; - while(first) - { - SageSymbols q(first->lhs()->symbol(), -1, 0, 0); - retval.push_back(q); - - first = first->rhs(); - } - return retval; -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/calls.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/calls.cpp deleted file mode 100644 index bd37e4c..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/calls.cpp +++ /dev/null @@ -1,2589 +0,0 @@ -/*********************************************************************/ -/* Fortran DVM+OpenMP+ACC */ -/* */ -/* Call Site Processing */ -/*********************************************************************/ -#include "leak_detector.h" - -#include "dvm.h" -#include "acc_data.h" -#include "calls.h" - -using std::map; -using std::string; -using std::vector; -using std::pair; - -//--------------------------------------------------------------------------------- - -#define NEW 1 -#define STATIC 1 - -graph_node *cur_node; -graph_node *node_list; -int deb_reg = 0; -int do_dummy = 0; -int do_stmtfn = 0; -int gcount = 0; -int has_generic_interface = 0; -int in_region = 0; -int in_routine = 0; -//----------------------------------------------------------------------------------------- -graph_node *GraphNode(SgSymbol *s, SgStatement *header_st, int flag_new); -graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader); -graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st); -edge *CreateOutcomingEdge(graph_node *gnode, int inlined); -edge *CreateIncomingEdge(graph_node *gnode, int inlined); -edge *NewEdge(graph_node *from, graph_node *to, int inlined); -int isDummyArgument(SgSymbol *s); -int isHeaderStmtSymbol(SgSymbol *s); -int isStatementFunction(SgSymbol *s); -int isHeaderNode(graph_node *gnode); -int isDeadNode(graph_node *gnode); -int isNoBodyNode(graph_node *gnode); -void InsertPrototypesOfFunctionFromOtherFile(graph_node *node, SgStatement *after); -void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after, argument_numbers *arg_numbs); -void InsertCopiesOfProcedure(graph_node *ndl, SgStatement *after); -graph_node_list *addToNodeList(graph_node_list *pnode, graph_node *gnode); -graph_node_list *delFromNodeList(graph_node_list *pnode, graph_node *gnode); -graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode); -void PrintGraphNode(graph_node *gnode); -void PrintGraphNodeWithAllEdges(graph_node *gnode); -void PrintWholeGraph(); -void PrintWholeGraph_kind_2(); -void BuildingHeaderNodeList(); -void RemovingDeadSubprograms(); -void NoBodySubprograms(); -void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from); -void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto); -void ScanSymbolTable(SgFile *f); -void ScanTypeTable(SgFile *f); -void printSymb(SgSymbol *s); -void printType(SgType *t); -void replaceVectorRef(SgExpression *e); -//------------------------------------------------------------------------------------- -extern SgExpression *private_list; -extern map > > interfaceProcedures; - -void MarkAsUserProcedure(SgSymbol *s) -{ - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | USER_PROCEDURE_BIT; -} - -void MarkAsExternalProcedure(SgSymbol *s) -{ - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | EXTERNAL_BIT; -} - -SgSymbol * GetProcedureHeaderSymbol(SgSymbol *s) -{ - if (!ATTR_NODE(s)) - return(NULL); - return(GRAPHNODE(s)->symb); -} - -int FromOtherFile(SgSymbol *s) -{ - if (!ATTR_NODE(s)) - return(1); - graph_node *gnode = GRAPHNODE(s); - if(!gnode->st_header || current_file_id != gnode->file_id) - return(1); - else - return(0); -} - -int IsInternalProcedure(SgSymbol *s) -{ - if (!ATTR_NODE(s)) - return 0; - graph_node *gnode = GRAPHNODE(s); - if(gnode->st_header && gnode->st_header->controlParent()->variant() != GLOBAL && gnode->st_header->controlParent()->variant() != MODULE_STMT) - return 1; - else - return 0; -} - -SgStatement *hasInterface(SgSymbol *s) -{ - return (ATTR_NODE(s) ? GRAPHNODE(s)->st_interface : NULL); -} - -void SaveInterface(SgSymbol *s, SgStatement *interface) -{ - if (ATTR_NODE(s) && !GRAPHNODE(s)->st_interface) - GRAPHNODE(s)->st_interface = interface; -} - -SgStatement *Interface(SgSymbol *s) -{ - SgStatement *interface = hasInterface(s); - if (!interface) - interface = getInterface(s); - - if (isForCudaRegion() && interface) - { - SaveInterface(s,interface); - MarkAsUserProcedure(s); - } - return interface; -} - -int findParameterNumber(SgSymbol *s, char *name) -{ - int i; - int n = ((SgFunctionSymb *) s)->numberOfParameters(); - for(i=0; iparameter(i)->identifier(), name)) - return i; - return -1; -} - -int isInParameter(SgSymbol *s, int i) -{ - return (s && ((SgFunctionSymb *) s)->parameter(i) && (((SgFunctionSymb *) s)->parameter(i)->attributes() & IN_BIT) ? 1 : 0); -} - -int isArrayParameter(SgSymbol *s, int i) -{ - return (s && ((SgFunctionSymb *) s)->parameter(i) && (((SgFunctionSymb *) s)->parameter(i)->attributes() & DIMENSION_BIT) ? 1 : 0); -} - -int isArrayParameterWithAssumedShape(SgSymbol *s, int i) -{ - return (isArrayParameter(s,i) && AssumedShape(isSgArrayType(((SgFunctionSymb *) s)->parameter(i)->type())->getDimList())); -} - -int isPrivateArrayDummy(SgSymbol *s) -{ - int *private_attr = (int *) s->attributeValue(0, DUMMY_PRIVATE_AR); - if (!private_attr) - return 0; - else - return *private_attr; -} - -SgSymbol *ProcedureSymbol(SgSymbol *s) -{ - if (FromOtherFile(s)) - { - SgStatement *header = Interface(s); - return( header ? header->symbol() : NULL); - } - return (GetProcedureHeaderSymbol(s)); -} - -int IsPureProcedure(SgSymbol *s) -{ - SgSymbol *sproc = ProcedureSymbol(s); - return ( sproc ? sproc->attributes() & PURE_BIT : 0 ); -} - -int IsElementalProcedure(SgSymbol *s) -{ - SgSymbol *shedr; - shedr = GetProcedureHeaderSymbol(s); - if (shedr) - return(shedr->attributes() & ELEMENTAL_BIT); - else - return 0; -} - -int IsRecursiveProcedure(SgSymbol *s) -{ - SgSymbol *shedr; - shedr = GetProcedureHeaderSymbol(s); - if (shedr) - return(shedr->attributes() & RECURSIVE_BIT); - else - return 0; -} - -int isUserFunction(SgSymbol *s) -{ - return(s->attributes() & USER_PROCEDURE_BIT); -} - -int IsNoBodyProcedure(SgSymbol *s) -{ - if (!ATTR_NODE(s)) - return 0; - return(GRAPHNODE(s)->st_header == NULL); -} - -void MarkAsRoutine(SgSymbol *s) -{ - graph_node *gnode; - - if (!ATTR_NODE(s)) - return; - gnode = GRAPHNODE(s); - gnode->is_routine = 1; - return; -} - -void MarkAsCalled(SgSymbol *s) -{ - graph_node *gnode; - edge *gedge; - - if (!ATTR_NODE(s)) - return; - gnode = GRAPHNODE(s); - //if (gnode->st_header) // for nobody procedure (for intrinsic functions and ...) gnode->st_header== NULL - gnode->count++; - for (gedge = gnode->to_called; gedge; gedge = gedge->next) - MarkAsCalled(gedge->to->symb); - return; - -} - -void MarkPrivateArgumentsOfRoutine(SgSymbol *s, SgExpression *private_args) -{ - SgExpression *el; - for (el=private_args; el; el=el->rhs()) - { - SgSymbol *arg = el->lhs()->symbol(); - if (IS_ARRAY(arg) && !IS_DVM_ARRAY(arg)) - { - int i = findParameterNumber(s,arg->identifier()); - if (i>=0) - addArgumentNumber(findParameterNumber(s,arg->identifier()), s); - } - } -} - -void MakeFunctionCopy(SgSymbol *s) -{ - SgSymbol *s_header; - graph_node *gnode; - - if (!ATTR_NODE(s)) - return; - GRAPHNODE(s)->count++; - - - gnode = GRAPHNODE(s); - s_header = gnode->symb; - gnode->count++; - - /* - if(!gnode->st_copy) - { printf("make copy of %s\n",s_header->identifier()); - gnode->st_copy = s_header->copySubprogram(*mod_gpu->lexNext()).body(); - } - */ - //s_copy = &s_header->copySubprogram(*mod_gpu); *mod_gpu->lexNext() - //gnode->st_copy = s_header->copySubprogram(*mod_gpu).body(); - //gnode->st_copy->unparsestdout(); - //HeaderStatement(&s_header->copySubprogram(*mod_gpu)); //(s_copy); //(s_header->copySubprogram(*mod_gpu)); -} - -SgStatement *HeaderStatement(SgSymbol *s) -{ - return(s->body()); -} - - -void InsertCalledProcedureCopies() -{ - graph_node *ndl; - int n = 0; - if (!mod_gpu) - return; - - SgStatement *after = mod_gpu->lexNext(); - SgStatement *first_kernel_const = after->lexNext(); - - for (ndl = node_list; ndl; ndl = ndl->next) - if (ndl->count) - { - if (ndl->st_header && current_file_id == ndl->file_id) //procedure from current_file - { - InsertCopiesOfProcedure(ndl, after); - n++; - } - else //procedure from other file - { - InsertPrototypesOfFunctionFromOtherFile(ndl,after); - } - - ndl->count = 0; - ndl->st_interface = NULL; - //ndl->st_copy = NULL; - } - - if (options.isOn(C_CUDA) && mod_gpu->lexNext()->variant() == COMMENT_STAT) - mod_gpu->lexNext()->extractStmt(); //extracting empty statement (COMMENT_STAT) - - if (options.isOn(RTC) && options.isOn(C_CUDA) && n != 0) - ACC_RTC_AddFunctionsToKernelConsts(first_kernel_const); - cuda_functions = n; -} - -SgSymbol* getReturnSymbol(SgStatement *st_header, SgSymbol *s) -{ - if (st_header->expr(0) == NULL) - return s; - else - return st_header->expr(0)->symbol(); -} - -void replaceAttribute(SgStatement *header) -{ - SgExpression *e = new SgExpression(ACC_ATTRIBUTES_OP, new SgExpression(ACC_DEVICE_OP), NULL, NULL); - header->setExpression(2, *e); -} - -int isInterfaceStatement(SgStatement *stmt) -{ - if (stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR) - return 1; - return 0; -} - -void ReplaceInterfaceBlocks(SgStatement *header) -{ - SgStatement *last = header->lastNodeOfStmt(); - SgStatement *stmt; - for (stmt=header->lexNext(); stmt && stmt!=last; stmt=stmt->lexNext()) - { - if(isSgExecutableStatement(stmt)) - return; - if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR) - { - SgStatement *st_end = stmt->lastNodeOfStmt(); // END INTERFACE - stmt = stmt->lexNext(); - while(stmt!=st_end) - { - if(stmt->variant() == FUNC_HEDR || stmt->variant() == PROC_HEDR ) - { - replaceAttribute(stmt); - stmt = stmt->lastNodeOfStmt()->lexNext(); - } - else - stmt = stmt->lexNext(); - } - } - } -} - - -int HasDerivedTypeVariables(SgStatement *header) -{ - SgSymbol *s; - SgSymbol *s_last = LastSymbolOfFunction(header); - - for (s = header->symbol()->next(); s != s_last->next(); s = s->next()) - { - if( s->type() && s->type()->variant()==T_DERIVED_TYPE) - { // !!! not implemented - err_p("Derived type variables", header->symbol()->identifier(), 999); - return 1; - } - } - return 0; -} - -argument_numbers *GetFirstLenPlus(argument_numbers *source, int source_len, int list_len) -{ - // copy first (list_len+1) elements of source - if (list_len == source_len) - return NULL; - argument_numbers *cur_list, *source_list, *new_list, *new_elem; - new_list = new argument_numbers; - new_list->number = source->number; - new_list->next = NULL; - int i; - for (i=2, cur_list=new_list, source_list = source->next; i<=list_len+1; i++, source_list = source_list->next) - { - new_elem = new argument_numbers; - new_elem->number = source_list->number; - new_elem->next=NULL; - cur_list->next = new_elem; - cur_list = new_elem; - } - return new_list; -} - -argument_numbers *elementByValue(int numb, argument_numbers *nlist) -{ - for (; nlist; nlist=nlist->next) - if (nlist->number == numb) - return nlist; - return NULL; -} - -argument_numbers *element(int n, argument_numbers *nlist) -{ - for (int i=1; nlist; nlist=nlist->next, i++) - if (i == n) - return nlist; - return NULL; -} - -int numberOfElements(argument_numbers *nlist) -{ - int i; - for (i=0; nlist; nlist=nlist->next, i++) - ; - return i; -} - -void printValueList(argument_numbers *nlist) -{ - printf(" ("); - for (; nlist; nlist=nlist->next) - printf("%d ",nlist->number); - printf(") "); -} - -argument_numbers *GetNextWithChange(argument_numbers *source, int source_len, argument_numbers *nlist, int list_len) -{ - int i; - argument_numbers *elem, *source_elem; - for (i=1, elem=nlist; elem; i++, elem=elem->next) - if ( elem->number == (source_elem=element(source_len+i-list_len, source))->number ) - break; - - if (i == 1) return NULL; - elem = element(i-1, nlist); //element with serial number i-1 - int numb = elem->number; - source_elem = elementByValue(numb, source)->next; - for (int j=i-1; j<=list_len; j++, elem=elem->next, source_elem=source_elem->next) - elem->number = source_elem->number; - - return nlist; -} - -argument_numbers *GetNextNumberList(argument_numbers *source, argument_numbers *nlist) -{ - if (!source) return NULL; - if (!nlist) - { - nlist = new argument_numbers; - nlist->next = NULL; - nlist->number = source->number; - return nlist; - } - int source_len = numberOfElements(source); - int list_len = numberOfElements(nlist); - argument_numbers * last_elem = element(list_len, nlist); - argument_numbers *last_in_source = element(source_len, source); - - if (list_len == source_len) return NULL; - - argument_numbers *elem_in_source = elementByValue(last_elem->number, source); - if (elem_in_source != last_in_source) - { //get next in row - last_elem->number = elem_in_source->next->number; - return nlist; - } - else if ((nlist = GetNextWithChange(source, source_len, nlist, list_len))) - return nlist; - else - return GetFirstLenPlus(source, source_len, list_len); -} - -argument_numbers *correctArgList(argument_numbers *arg_numbs, SgStatement *st_header) -{ - SgSymbol *s = st_header->symbol(); - int i; - - argument_numbers *numb_list=NULL, *elem; - for (i=0; arg_numbs; arg_numbs=arg_numbs->next, i++) - { - if ( !isArrayParameterWithAssumedShape(s, arg_numbs->number) ) - { - elem = new argument_numbers; - elem->number = arg_numbs->number; - - if (numb_list) - { - elem->next = numb_list; - numb_list =elem; - } - else - elem->next = NULL; - numb_list = elem; - } - } - return numb_list; -} - -void InsertCopiesOfProcedure(graph_node *ndl, SgStatement *after) -{ - //insert copies of procedure after statement 'after' - argument_numbers *numb_list = NULL; - ndl->st_copy = InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, numb_list, after); - ndl->st_copy_first = ndl->st_copy; - - if (ndl->arg_numbs) - { - argument_numbers *arg_numbs = correctArgList(ndl->arg_numbs, ndl->st_header); - while ((numb_list = GetNextNumberList(arg_numbs, numb_list))) - ndl->st_copy = InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, numb_list, after); - } -} - -SgExpression *PrivateArrayDummyList(SgStatement *new_header, argument_numbers *arg_numbs) -{ - SgSymbol *s = new_header->symbol(); - SgExpression *pList = NULL; - SgExpression *ae; - int *id; - int n = ((SgFunctionSymb *)s)->numberOfParameters(); - for (int i = 0; i < n; i++) - { - SgSymbol *sarg = ((SgFunctionSymb *)s)->parameter(i); - if (isArrayParameterWithAssumedShape(s, i)) - { - id = new int; - *id = 1; - } - else if (arg_numbs && elementByValue(i, arg_numbs)) - { - id = new int; - *id = 2; - } - else - continue; - sarg->addAttribute(DUMMY_PRIVATE_AR, (void *)id, sizeof(int)); - ae = new SgArrayRefExp(*sarg); - ae ->setType(sarg->type()); - pList = AddListToList(pList, new SgExprListExp(*ae)); - } - return pList; -} - -SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is_routine, argument_numbers *arg_numbs, SgStatement *after) -{ //InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, after) - //insert copy of procedure after statement 'after' - SgStatement *new_header, *end_st; - SgSymbol *new_sproc = &sproc->copySubprogram(*after); - new_header = after->lexNext(); // new procedure header //new_sproc->body() - SYMB_SCOPE(new_sproc->thesymb) = mod_gpu->thebif; - new_header->setControlParent(mod_gpu); - SgSymbol *returnSymbol = getReturnSymbol(new_header, new_sproc); - - if (options.isOn(C_CUDA)) - { - RenamingNewProcedureVariables(new_sproc); // to avoid conflicts with C language keywords - int flagHasDerivedTypeVariables = HasDerivedTypeVariables(new_header); - - end_st = new_header->lastNodeOfStmt(); - - private_list = PrivateArrayDummyList(new_header,arg_numbs); - ConvertArrayReferences(new_header->lexNext(), end_st); - - TranslateProcedureHeader_To_C(new_header,arg_numbs); - - // extract specification statements and add local arrays to private_list - ExtractDeclarationStatements(new_header); - - SgSymbol *s_last = LastSymbolOfFunction(new_header); - if (sproc->variant() == FUNCTION_NAME) - { - SgSymbol *sfun = &new_sproc->copy(); - new_header->expr(0)->setSymbol(sfun); //fe->setSymbol(sfun); - SYMB_IDENT(new_sproc->thesymb) = FunctionResultIdentifier(new_sproc); - - InsertReturnBeforeEnd(new_header, end_st); - } - swapDimentionsInprivateList(); - - Translate_Fortran_To_C(new_header, end_st, 0, st_header); - cur_func = after; - if (sproc->variant() == FUNCTION_NAME) - { - new_header->insertStmtAfter(*Declaration_Statement(new_sproc), *new_header); - ChangeReturnStmts(new_header, end_st, returnSymbol); - } - - if(!flagHasDerivedTypeVariables) //!!! derived data type is not supported - MakeFunctionDeclarations(new_header, s_last); - - newVars.clear(); - private_list = NULL; - // generate prototype of function and insert it before 'after' - if (options.isOn(RTC) == false) - doPrototype(new_header, mod_gpu, is_routine ? !STATIC : STATIC); - - } - else //Fortran Cuda - { - replaceAttribute(new_header); - new_header->addComment("\n"); // add comment (empty line) to new procedure header - ReplaceInterfaceBlocks(new_header); - } - - return(new_header); -} - -SgStatement *FunctionPrototype(SgSymbol *sf) -{ - SgExpression *fref = new SgFunctionRefExp(*sf); - fref->setSymbol(*sf); - fref->setType(*sf->type()); - SgStatement *st = new SgStatement(VAR_DECL); - st->setExpression(0, *new SgExprListExp(*fref)); - - return (st); -} - - -void doPrototype(SgStatement *func_hedr, SgStatement *block_header, int static_flag) -{ - SgSymbol *sf = func_hedr->expr(0)->symbol(); - SgStatement *st = FunctionPrototype(sf); - if (func_hedr->expr(0)->lhs()) - st->expr(0)->lhs()->setLhs(func_hedr->expr(0)->lhs()->copy()); - st->addDeclSpec(BIT_CUDA_DEVICE); - if (static_flag) - st->addDeclSpec(BIT_STATIC); - - block_header->insertStmtAfter(*st, *block_header); //before->insertStmtAfter(*st,*before->controlParent()); -} - -SgStatement *TranslateProcedureHeader_To_C(SgStatement *new_header, argument_numbers *arg_numbs) -{ - SgSymbol *new_sproc = new_header->symbol(); - SgFunctionRefExp *fe = new SgFunctionRefExp(*new_sproc); - fe->setSymbol(*new_sproc); - new_header->setExpression(0, *fe); - - SgSymbol *returnSymbol = getReturnSymbol(new_header, new_sproc); - - if (new_sproc->variant() == PROCEDURE_NAME) - new_sproc->setType(C_VoidType()); - else // FUNCTION_NAME - { - //new_sproc->setType(C_Type(new_sproc->type())); - new_sproc->setType(C_Type(returnSymbol->type())); - } - fe->setType(new_sproc->type()); - fe->setLhs(FunctionDummyList(new_sproc, new_header, arg_numbs)); - BIF_LL3(new_header->thebif) = NULL; - new_header->addDeclSpec(BIT_CUDA_DEVICE); - new_header->setVariant(FUNC_HEDR); - - return new_header; -} - -void InsertPrototypesOfFunctionFromOtherFile(graph_node *node, SgStatement *after) -{ - if (options.isOn(RTC)) return; - //insert prototypes of procedure after statement 'after' - argument_numbers *numb_list = NULL; - PrototypeOfFunctionFromOtherFile(node, after, numb_list); - - if (node->arg_numbs) - { - argument_numbers *arg_numbs = correctArgList(node->arg_numbs, node->st_header); - while ((numb_list = GetNextNumberList(arg_numbs, numb_list))) - PrototypeOfFunctionFromOtherFile(node, after, numb_list); - } -} - -void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after, argument_numbers *arg_numbs) -{ - if (options.isOn(RTC)) return; - if(!node->st_interface) return; - - SgStatement *interface = node->st_interface; - //SgSymbol *sproc = interface->symbol() - //SgSymbol *new_sproc = new SgSymbol(sproc->variant(), sproc->identifier(), sproc->type(), current_file->firstStatement(),); - - SgSymbol *sh = &(interface->symbol()->copyLevel1()); - SYMB_SCOPE(sh->thesymb) = current_file->firstStatement()->thebif; - SgStatement *new_hedr = &(interface->copy()); - new_hedr->setSymbol(*sh); - TranslateProcedureHeader_To_C(new_hedr, arg_numbs); - doPrototype(new_hedr, mod_gpu, !STATIC); - - //current_file->firstStatement()->insertStmtAfter(*new_hedr, *current_file->firstStatement()); - //SYMB_FUNC_HEDR(sh->thesymb) = new_hedr->thebif; - - - //node->st_interface->setLexNext(*node->st_interface->lastNodeOfStmt()); - //SgStatement *hedr_st = InsertProcedureCopy(node->st_interface, node->st_interface->symbol(), after); - //hedr_st->extractStmt(); - node->st_interface = NULL; - return; -} - -SgExpression *FunctionDummyList(SgSymbol *s, SgStatement *st_header, argument_numbers *arg_numbs) -{ - SgExpression *arg_list = NULL, *ae = NULL; - - int n = ((SgFunctionSymb *)s)->numberOfParameters(); - //insert at 0-th position inf-argument - //check for optional arguments, if some argunemt exist with optional then add argument-mask - - //int useOption = false; - //for (i = 0; i < n; i++) - //{ - // useOption |= ((SgFunctionSymb *)s)->parameter(i)->attributes() & OPTIONAL_BIT; - //} - //if(useOption) - //{ - // std::string nameForArgsInfo = "arg_info"; // name for new arguments - // SgSymbol* argInfo = new SgSymbol(VARIABLE_NAME,nameForArgsInfo.c_str()); - // argInfo->setType(C_LongType()); - // ae = new SgVarRefExp(argInfo); - // ae = new SgExprListExp(*ae); - // arg_list = AddListToList(arg_list, ae); - //} - - for (int i = 0; i < n; i++) - { - SgSymbol *sarg = ((SgFunctionSymb *)s)->parameter(i); - - if (!isSgArrayType(sarg->type())) - { - sarg->setType(C_Type(sarg->type())); - if (sarg->attributes() & OPTIONAL_BIT) - { - sarg->setType(new SgDerivedTemplateType(new SgTypeRefExp(*sarg->type()), new SgSymbol(TYPE_NAME, "optArg"))); - } - ae = new SgVarRefExp(sarg); - //ae->setType(C_ReferenceType(sarg->type())); - if (sarg->attributes() & IN_BIT) - ae = new SgExprListExp(*ae); - else - ae = new SgExprListExp(SgAddrOp(*ae)); - arg_list = AddListToList(arg_list, ae); - - } - else - { - int needChanged = true; - SgArrayType* arrT = (SgArrayType*)sarg->type(); - int dims = arrT->dimension(); - SgExpression *dimList = arrT->getDimList(); - - while (dimList) - { - if (dimList->lhs()->variant() != DDOT) - { - needChanged = false; - break; - } - else if (dimList->lhs()->rhs()) - { - needChanged = false; - break; - } - dimList = dimList->rhs(); - } - int rank = Rank(sarg); - SgType *ar_type = sarg->type(); - SgType *tbase = C_Type(sarg->type()->baseType()); - SgType *t = C_PointerType(tbase); - SgSymbol *new_arg = &sarg->copy();//new SgVariableSymb(sarg->identifier(), *t, *st_header); - //new_arg->thesymb->entry.var_decl.local = IO; // is new dummy argument - new_arg->setType(t); - ae = new SgVarRefExp(new_arg); - //ae->setType(t); - - if (needChanged) - { - SgExpression *ce = new SgExprListExp(*new SgTypeRefExp(*tbase)); - SgDerivedTemplateType *tpc = new SgDerivedTemplateType(ce, private_array_class); - tpc->addArg(new SgValueExp(rank)); - new_arg->setType(tpc); - //int *id = new int; - //*id = 1; - //sarg->addAttribute(DUMMY_PRIVATE_AR, (void *)id, sizeof(int)); - ae = &SgAddrOp(*new SgVarRefExp(new_arg)); - //} - //else - //{ else - - // sarg->setType(new SgDerivedTemplateType(new SgTypeRefExp(*t), new SgSymbol(TYPE_NAME, "s_array"))); - // ae = new SgVarRefExp(sarg); - //} - ae = new SgExprListExp(*ae); - arg_list = AddListToList(arg_list, ae); - continue; - } - - if (arg_numbs && elementByValue(i, arg_numbs)) - { - //SgType *tp = C_Type(sarg->type()->baseType()); - t = C_PointerType(C_VoidType()); - SgSymbol *sp = new SgSymbol(VARIABLE_NAME, PointerNameForPrivateArray(sarg), *t, *st_header); - //sp->thesymb->entry.var_decl.local = IO; - SgSymbol **symb = new (SgSymbol *); - *symb= sarg; - sp->addAttribute(FUNCTION_AR_DUMMY, (void*) symb, sizeof(SgSymbol *)); - ae->setSymbol(*sp); - //ae->setType(t); - //sarg->setType(ar_type); // restoration of argument type - //int *id = new int; - //*id = 2; - //sarg->addAttribute(DUMMY_PRIVATE_AR, (void *)id, sizeof(int)); - - //ae->setType(C_ReferenceType(t)); - //ae = new SgPointerDerefExp(*ae); - //ae = new SgCastExp(*C_PointerType(C_VoidType()), *ae); - //arg_list = AddListToList( int *id = new int; - //continue; - - //ae = new SgCastExp(*C_PointerType( t), *new SgVarRefExp(sp)); - // ae = new SgVarRefExp(sp); - //ae = new SgExprListExp(*ae); - //arg_list = AddListToList(arg_list, ae); - //continue; - - } - - //sarg->setType(t); - //ae = new SgVarRefExp(sarg); - //ae->setType(t); - - ae->setType(C_ReferenceType(t));//(sarg->type())); //t - ae = new SgExprListExp(*new SgPointerDerefExp(*ae)); - arg_list = AddListToList(arg_list, ae); - //SgSymbol *arr_info = new SgSymbol(VAR_REF, ("inf_" + std::string(sarg->identifier())).c_str()); - //arr_info->setType(C_PointerType(C_Type(new SgType(T_INT)))); - //ae = new SgVarRefExp(arr_info); - //ae = new SgExprListExp(*new SgPointerDerefExp(*ae)); - //arg_list = AddListToList(arg_list, ae); - } - } - return (arg_list); -} - -char *FunctionResultIdentifier(SgSymbol *sfun) -{ - char *name; - name = (char *)malloc((unsigned)(strlen(sfun->identifier()) + 4 + 1)); - sprintf(name, "%s_res", sfun->identifier()); - return(NameCheck(name, sfun)); -} - -SgSymbol *isSameNameInProcedure(char *name, SgSymbol *sfun) -{ - SgSymbol *s; - for (s = sfun->next(); s; s = s->next()) - if (!strcmp(s->identifier(), name)) - return(s); - return(NULL); -} - -char *NameCheck(char *name, SgSymbol *sfun) -{ - SgSymbol *s; - while ((s = isSameNameInProcedure(name, sfun)) != 0) - { - name = (char *)malloc((unsigned)(strlen(name) + 2)); - sprintf(name, "%s_", s->identifier()); - } - return(name); -} - -void InsertReturnBeforeEnd(SgStatement *new_header, SgStatement *end_st) -{ - SgStatement *prev = end_st->lexPrev(); - if (prev->variant() == RETURN_STAT) - return; - prev->insertStmtAfter(*new SgStatement(RETURN_STAT), *new_header); -} - -void ChangeReturnStmts(SgStatement *new_header, SgStatement *end_st, SgSymbol *sres) -{ - SgStatement *stmt; - for (stmt = new_header->lexNext(); stmt != end_st; stmt = stmt->lexNext()) - if (stmt->variant() == RETURN_STAT) - stmt->setExpression(0, *new SgVarRefExp(sres)); - -} - -template -static void createIntefacePrototype(callStatType *funcDecl) -{ - string funcName = funcDecl->name().identifier(); - const int parNum = funcDecl->numberOfParameters(); - vector prototype(parNum); - for (int i = 0; i < parNum; ++i) - { - SgSymbol *par = funcDecl->parameter(i); - SgType *type = par->type(); - prototype[i] = type; - } - map > >::iterator it = interfaceProcedures.find(funcName); - if (it == interfaceProcedures.end()) - { - vector > prototypes = vector >(); - prototypes.push_back(prototype); - - interfaceProcedures.insert(it, make_pair(funcName, prototypes)); - } - else - it->second.push_back(prototype); -} - -bool CreateIntefacePrototype(SgStatement *header) -{ - bool retVal = true; - if (header->variant() == FUNC_HEDR) - { - SgFuncHedrStmt *funcDecl = isSgFuncHedrStmt(header); - if (funcDecl) - createIntefacePrototype(funcDecl); - else - retVal = false; - } - else if (header->variant() == PROC_HEDR) - { - SgProcHedrStmt *procDecl = isSgProcHedrStmt(header); - if (procDecl) - createIntefacePrototype(procDecl); - else - retVal = false; - } - else - retVal = false; - - return retVal; -} - -void ExtractDeclarationStatements(SgStatement *header) -{ - SgStatement *cur_st; - SgStatement *stmt = header->lexNext(); - SgExprListExp *e; - SgExpression *list, *it; - - if(stmt->variant()==CONTROL_END) - return; - - while (stmt && (!isSgExecutableStatement(stmt) || stmt->variant()==ACC_ROUTINE_DIR)) //is Fortran specification statement or ROUTINE directive - { - cur_st = stmt; - stmt = stmt->lexNext(); - if (cur_st->variant() == INTERFACE_STMT || cur_st->variant() == INTERFACE_ASSIGNMENT || cur_st->variant() == INTERFACE_OPERATOR) - { - SgStatement *last = cur_st->lastNodeOfStmt(); - SgStatement *start = cur_st; - while (start != last) - { - // save prototypes of FUNC and PROC - if (start->variant() == FUNC_HEDR) - { - SgFuncHedrStmt *funcDecl = isSgFuncHedrStmt(start); - if (funcDecl) - { - createIntefacePrototype(funcDecl); - start = funcDecl->lastNodeOfStmt(); - } - } - else if (start->variant() == PROC_HEDR) - { - SgProcHedrStmt *procDecl = isSgProcHedrStmt(start); - if (procDecl) - { - createIntefacePrototype(procDecl); - start = procDecl->lastNodeOfStmt(); - } - } - start = start->lexNext(); - } - stmt = cur_st->lastNodeOfStmt()->lexNext(); - cur_st->extractStmt(); - continue; - } - if(cur_st->variant()==STRUCT_DECL) - { - stmt = cur_st->lastNodeOfStmt()->lexNext(); - cur_st->extractStmt(); - continue; - } - //if(cur_st->variant()==IMPL_DECL || cur_st->variant()==DATA_DECL || cur_st->variant()==USE_STMT || cur_st->variant()==FORMAT_STAT || cur_st->variant()==ENTRY_STAT || cur_st->variant()==COMM_STAT || cur_st->variant()==STMTFN_STAT ) - if(!isSgVarDeclStmt(cur_st) && !isSgVarListDeclStmt(cur_st)) - { - cur_st->extractStmt(); - continue; - } - - list = cur_st->expr(0); - for(; list; list = list->rhs()) - { - if(IS_DUMMY(list->lhs()->symbol()) || !isSgArrayType(list->lhs()->symbol()->type())) - continue; - //add local array in private list - e = new SgExprListExp(*new SgVarRefExp(*list->lhs()->symbol())); - e->setRhs(private_list); - private_list = e; - } - cur_st->extractStmt(); - } -} - -/* -std::string ArrParametrs(SgSymbol* arr) -{ - return ("inf_" + std::string(arr->identifier())).c_str(); -} -SgExpression* InheritUpperBound(SgSymbol* arr, int i) -{ - SgExpression *dim = ((SgArrayType *)(arr->type()))->sizeInDim(i); - SgExpression *lb = dim->lhs(); - SgExpression *ub = dim->rhs(); - if(dim->variant() != DDOT || ub != NULL) - { - return UpperBound(arr,i); - } - if(lb == NULL) - { - return &(*(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp((i-1)+7))) - - *(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp(i-1))) - + *new SgValueExp(1)) ; - } - else if(1) - { - return &(*(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp((i-1)+7))) - - *(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp(i-1))) - + *lb) ; - } - -} -SgExpression* InheritLowerBound(SgSymbol* arr, int i) -{ - SgExpression *dim = ((SgArrayType *)(arr->type()))->sizeInDim(i); - SgExpression *lb = dim->lhs(); - SgExpression *ub = dim->rhs(); - if(dim->variant() != DDOT || ub != NULL) - { - return UpperBound(arr,i); - } - if(lb == NULL) - { - return new SgValueExp(1) ; - } - else - { - return lb; - } - -} -*/ -void CorrectSubscript(SgExpression *e) -{ - int dims = ((SgArrayType *)(e->symbol()->type()))->dimension(); - std::deque > koefs; -// SgExpression *infUpperBound = NULL; ; -// SgExpression *infLowerBound = NULL; - SgExpression *tmp = e->lhs(); - if (tmp == NULL) - { - return; - } - for (int i = 0; i < dims; ++i) - { - SgExpression *dimsize = ((SgArrayType *)(e->symbol()->type()))->sizeInDim(i); - if (dimsize->variant() == STAR_RANGE) - { - break; - } - } - for (int i = 0; i < dims; ++i) - { - std::pair tmp_pair; - SgExpression * koef = new SgValueExp(1); - SgExpression *dimsize = ((SgArrayType *)(e->symbol()->type()))->sizeInDim(i); - SgExpression *check = dimsize->lhs(); - for (int j = 0; j < i; ++j) - { -// SgExpression *dimsize = ((SgArrayType *)(e->symbol()->type()))->sizeInDim(j); -// if (isSgSubscriptExp(dimsize) && !dimsize->rhs()) -// { -// infLowerBound = (new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(e->symbol()).c_str()), *new SgValueExp(j))); -// infUpperBound = (new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(e->symbol()).c_str()), *new SgValueExp(j+7))); -// -// koef = Calculate(&(*koef * (*infUpperBound - *infLowerBound + *new SgValueExp(1)))); -// -// } -// else -// { - SgExpression * up = UpperBound(e->symbol(), j); - if(up->variant() == FUNC_CALL) - { - up = new SgExpression(RECORD_REF); - up->setLhs(new SgVarRefExp(e->symbol())); - //up->setRhs(new SgVarRefExp(*new SgSymbol(FIELD_NAME,(std::string("ub[")+std::to_string(j)+std::string("]")).c_str()))); - up->setRhs(new SgFunctionCallExp(*new SgSymbol(MEMBER_FUNC,"ub"), *new SgExprListExp(*new SgValueExp(j)))); - } - SgExpression * low = LowerBound(e->symbol(), j); - koef = Calculate(&(*koef * (*up - *LowerBound(e->symbol(), j) + *new SgValueExp(1)))); -// } - } - tmp_pair.first = koef; - - tmp_pair.second = Calculate(&(*tmp->lhs() - *LowerBound(e->symbol(), i))); - tmp = tmp->rhs(); - koefs.push_back(tmp_pair); - - } - SgExpression *line = koefs.front().second; - koefs.pop_front(); - tmp = e->lhs(); - for (int i = 0; i < dims - 1; ++i) - { - line = &(*koefs.front().second * *koefs.front().first + *line); - koefs.pop_front(); - tmp = tmp->rhs(); - } - e->setLhs((new SgExprListExp(*line))); -} - -void replaceArgument(SgSymbol *fsym, SgExpression *arg, int i) -{ - if (isSgArrayRefExp(arg) && !arg->lhs()) //argument is whole array (array name) - { - if (fsym && isPrivateArrayDummy(arg->symbol()) && !isArrayParameterWithAssumedShape(ProcedureSymbol(fsym),i)) - arg->setLhs(FirstArrayElementSubscriptsOfPrivateArray(arg->symbol())); - return; - } - replaceVectorRef(arg); - return; -} - -void replaceArgumentList(SgSymbol *fsym, SgExpression *arg_list) -{ - if (!arg_list) return; - int i; - SgExpression *el; - for (el=arg_list, i=0; el; el=el->rhs(),i++) - replaceArgument(fsym, el->lhs(), i); -} - -void replaceVectorRef(SgExpression *e) -{ - SgType *type; - if (e == NULL) - return; - if (isSgArrayRefExp(e)) - { - type = isSgArrayType(e->symbol()->type()); - if (IS_DUMMY(e->symbol()) && type) - { - if (!isPrivateArrayDummy(e->symbol())) //isPrivate(e->symbol()->identifier()) - CorrectSubscript(e); - } - return; - } - if (isSgFunctionCallExp(e)) - { - replaceArgumentList(e->symbol(),e->lhs()); - return; - } - replaceVectorRef(e->lhs()); - replaceVectorRef(e->rhs()); -} - -void ConvertArrayReferences(SgStatement *first, SgStatement *last) -{ - SgStatement *st; - for (st = first; st != last; st = st->lexNext()) - { - if (isInterfaceStatement(st)) - { - st = st->lastNodeOfStmt(); - continue; - } - if (st->variant() == PROC_STAT) // call statement - { - replaceArgumentList(st->symbol(), st->expr(0)); - continue; - } - if (st->expr(0)) - replaceVectorRef(st->expr(0)); - if (st->expr(1)) - replaceVectorRef(st->expr(1)); - if (st->expr(2)) - replaceVectorRef(st->expr(2)); - } -} - -void convertArrayDecl(SgSymbol* s) -{ - SgExprListExp *resDims, *tmp; - std::stackdims; - if(isSgArrayType(s->type())) - { - SgExpression *dimList = isSgArrayType(s->type())->getDimList(); - while (dimList) - { - if(dimList->lhs()->variant() == DDOT) - { - dims.push(Calculate(&(*(dimList->lhs()->rhs()) - *(dimList->lhs()->lhs()) + *new SgValueExp(1)))); - } - else - { - dims.push(Calculate(&(*(dimList->lhs())))); - } - dimList = dimList->rhs(); - } - SgType* t = C_Type(isSgArrayType(s->type())->baseType()); - SgArrayType *arr = new SgArrayType(*t); - while (!dims.empty()) - { - arr->addDimension(dims.top()); - dims.pop(); - } - s->setType(arr); - } - - -} - -void MakeFunctionDeclarations(SgStatement *header, SgSymbol *s_last) -{ - SgSymbol *s; - SgStatement *cur_stat = header; - SgStatement *st; - SgExpression *el; - char* name = header->expr(0)->symbol()->identifier(); - - for (s = header->symbol()->next(); s != s_last->next(); s = s->next()) - { - if (isSgFunctionSymb(s) != NULL) - continue; - - int flags = s->attributes(); - - if (IS_DUMMY(s)) - { - if (flags & (IN_BIT | OUT_BIT | INOUT_BIT)) - ; - else if(!options.isOn(NO_PURE_FUNC)) - err_p("Dummy argument need to have INTENT attribute in PURE procedure", name, 617); - continue; - } - - if (flags & SAVE_BIT) - err_p("SAVE not be used in PURE procedure", name, 618); - if (flags & COMMON_BIT) - err_p("COMMON not be used in PURE procedure", name, 619); - - if (s->scope() != header) - { - //printf("%s: %d \n",s->identifier(),s->scope()->variant()); //printf("%s: %d %s \n",s->identifier(),s->scope()->variant(),s->scope()->symbol()->identifier()); - continue; - } - - SgSymbol **sarg = (SgSymbol **) s->attributeValue(0, FUNCTION_AR_DUMMY); - if (sarg) // pointer for PrivateArray class object - { - SgExpression *elist = NULL; - int rank = Rank(*sarg); - if (rank > 1) - for (int i=rank-1; i; i--) - elist = AddListToList(elist, new SgExprListExp(*Calculate(ArrayDimSize(*sarg,i)))); - makeClassObjectDeclaration(*sarg, s, header, C_UnsignedLongLongType(), elist, 1); //makeSymbolDeclaration(s); //MakePrivateArrayDeclaration(*sarg, s); - continue; - } - if (!isSgArrayType(s->type())) //scalar variable - s->setType(C_Type(s->type())); - else - continue; - - if (isSgConstantSymb(s)) - { - SgExpression *ce = ((SgConstantSymb *)s)->constantValue(); - convertExpr(ce, ce); - st = makeSymbolDeclarationWithInit(s, ce); - st->addDeclSpec(BIT_CONST); - } - else if(isSgVariableSymb(s)) - st = makeSymbolDeclaration(s); //st = Declaration_Statement(s); - else - continue; - cur_stat->insertStmtAfter(*st); - cur_stat = st; - } - - for (el = private_list; el; el = el->rhs()) - { - if (IS_DUMMY(el->lhs()->symbol())) return; - convertArrayDecl(el->lhs()->symbol()); - st = makeSymbolDeclaration(el->lhs()->symbol()); - cur_stat->insertStmtAfter(*st); - cur_stat = st; - } -} - -SgSymbol *LastSymbolOfFunction(SgStatement *header) -{ - SgSymbol *s = header->symbol(); - while (s->next()) - { //printf(" %s: %d %s\n", s->next()->identifier(),s->next()->scope()->variant(), s->next()->scope()->symbol() ? s->next()->scope()->symbol()->identifier() : "N"); - s = s->next(); - } - return(s); -} - - -//--------------------------------------------------------------------------------------- -void ProjectStructure(SgProject &project) -{ - int n = project.numberOfFiles(); - SgFile *file; - int i; - - // building program structure - // looking through the file list of project (first time) - for (i = n - 1; i >= 0; i--) - { - file = &(project.file(i)); - current_file = file; - current_file_id = i; - FileStructure(file); - //printf("%s %d\n",project.fileName(i),i); PrintWholeGraph(); - } - for (i = n - 1; i >= 0; i--) - { - file = &(project.file(i)); - current_file = file; - current_file_id = i; - doCallGraph(file); - } - //ScanSymbolTable(file); - //PrintWholeGraph(); -} - -void FileStructure(SgFile *file) -{// looking through the file and creating graph node for header of each program unit - SgStatement *stat; - - // grab the first statement in the file. - stat = file->firstStatement(); // file header - for (stat = stat->lexNext(); stat; stat = stat->lexNext()) - { - if (stat->variant() == INTERFACE_STMT || stat->variant() == INTERFACE_ASSIGNMENT || stat->variant() == INTERFACE_OPERATOR) - { - stat = stat->lastNodeOfStmt(); //InterfaceBlock(stat); - continue; - } - - if (stat->variant() == FUNC_HEDR || stat->variant() == PROC_HEDR || stat->variant() == PROG_HEDR || stat->variant() == MODULE_STMT) - { //printf("%d %s \n",stat->lineNumber(),stat->symbol()->identifier()); - //creating graph node for header of function (procedure, program) - cur_node = GraphNode(stat->symbol(), stat, NEW); - - } - - } - -} - -void ReplaceGenericInterfaceBlocks(SgStatement *hedr, SgStatement *end_of_unit) -{ - SgStatement *stmt; - //SgSymbol *symb = NULL; - for (stmt = hedr->lexNext(); stmt != end_of_unit; stmt = stmt->lastNodeOfStmt()->lexNext()) - { - if(stmt->variant() == INTERFACE_STMT && stmt->symbol()) - BIF_SYMB(stmt->thebif) = NULL; - if(stmt->variant() == FUNC_HEDR || stmt->variant() == PROC_HEDR ) - stmt = stmt->lexNext(); - } -} - - -void doCallGraph(SgFile *file) -{// scanning the file to search procedure calls - SgStatement *stat = NULL, *end_of_unit = NULL; - //char *func_name; - //int *ir; - //int has_main_program_unit = 0; - - // grab the first statement in the file. - stat = file->firstStatement(); // file header - for (stat = stat->lexNext(); stat; stat = end_of_unit->lexNext()) - { - has_generic_interface = 0; - end_of_unit = ProgramUnit(stat); - if (has_generic_interface) - ReplaceGenericInterfaceBlocks(stat,end_of_unit); - } - // add the attribute (last statement of file) to first statement of file - SgStatement **last = new (SgStatement *); -#if __SPF - addToCollection(__LINE__, __FILE__, last, 1); -#endif - *last = end_of_unit; - file->firstStatement()->addAttribute(LAST_STATEMENT, (void*)last, sizeof(SgStatement *)); - -} - -SgStatement *ProgramUnit(SgStatement *first) -{ - SgStatement *stat, *end_of_unit; - - // program unit: main program, external subprogram, module or block data - for (stat = first; stat; stat = end_of_unit->lexNext()) - { - //end of program unit with CONTAINS statement - if (stat->variant() == CONTROL_END) - { - if (stat->controlParent() == first) //end of program unit with CONTAINS statement - return(stat); - else - { - end_of_unit = stat; - continue; - } - } - if (stat->variant() == BLOCK_DATA) //BLOCK_DATA header - return(stat->lastNodeOfStmt()); - - // PROGRAM, SUBROUTINE, FUNCTION or MODULE header - - //scanning the Symbols Table of the function - // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); - - end_of_unit = Subprogram(stat); // end_of unit may be END or CONTAINS statement - //printf("---%d %d %s \n",stat->lineNumber(),end_of_unit->lineNumber(),stat->symbol()->identifier()); - GRAPHNODE(stat->symbol())->st_last = end_of_unit; - if (end_of_unit->variant() == CONTROL_END && end_of_unit->controlParent() == first) //end of program unit without CONTAINS statement - return(end_of_unit); - } - return NULL; -} - -SgStatement *Subprogram(SgStatement *func) -{ - // Build a directed acyclic call multigrahp (call DAMG) - // which represents calls between routines of the program - - SgStatement *stmt, *last, *first; - - - DECL(func->symbol()) = 1; - HEDR(func->symbol()) = func->thebif; - cur_func = func; - in_routine = 0; - //if( func->variant() == PROG_HEDR) - // PROGRAM_HEADER(func->symbol()) = func->thebif; - - // determing graph node for header of function (procedure, program) - cur_node = ATTR_NODE(func->symbol()) ? GRAPHNODE(func->symbol()) : GraphNode(func->symbol(), func, 0); - - first = func->lexNext(); - //printf("\n%s header_id= %d \n", func->symbol()->identifier(), func->symbol()->id()); - //!!!debug - //if(fsymb) - //printf("\n%s %s \n", header(func->variant()),fsymb->identifier()); - //else { - //printf("Function name error \n"); - //return; - //} - - last = func->lastNodeOfStmt(); - - // follow the statements of the function in lexical order - // until last statement - for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) - { - switch (stmt->variant()) { - - case CONTAINS_STMT: - last = stmt; - goto END_; - break; - - case ENTRY_STAT: - // !!!!!!! - break; - - case DATA_DECL: - case CONTROL_END: - case STOP_STAT: - case PAUSE_NODE: - case GOTO_NODE: // GO TO - break; - case ACC_ROUTINE_DIR: - in_routine = 1; - break; - case VAR_DECL: - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case WHILE_NODE: // DO WHILE (...) - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - case LOGIF_NODE: // Logical IF - FunctionCallSearch(stmt->expr(0)); - break; - case STMTFN_STAT: - DECL(stmt->expr(0)->symbol()) = 2; - break; - case COMGOTO_NODE: // Computed GO TO - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - FunctionCallSearch(stmt->expr(1)); - break; - - case PROC_STAT: { // CALL - SgExpression *el; - int inlined; - //printf("\n%s call_id= %d \n", stmt->symbol()->identifier(), stmt->symbol()->id()); - //!!!temporary - //inlined = (func->variant() == PROG_HEDR) ? 0 : 1; - inlined = 1; - Call_Site(stmt->symbol(), inlined, stmt, NULL); - // looking through the arguments list - for (el = stmt->expr(0); el; el = el->rhs()) - Arg_FunctionCallSearch(el->lhs()); // argument - } - break; - - case ASSIGN_STAT: // Assign statement - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - case FOR_NODE: - FunctionCallSearch(stmt->expr(0)); // left part - FunctionCallSearch(stmt->expr(1)); // right part - break; - case ACC_REGION_DIR: - in_region++; - break; - case ACC_END_REGION_DIR: - in_region--; - break; - default: - FunctionCallSearch(stmt->expr(0)); - FunctionCallSearch(stmt->expr(1)); - FunctionCallSearch(stmt->expr(2)); - break; - } - - } // end of processing statement/directive - -END_: - // for debugging - if (deb_reg > 1) - PrintGraphNode(cur_node); - in_routine = 0; - return(last); - -} - -void FunctionCallSearch(SgExpression *e) -{ - SgExpression *el; - if (!e) - return; - - if (isSgFunctionCallExp(e)) { - Call_Site(e->symbol(), 1, NULL, e); - for (el = e->lhs(); el; el = el->rhs()) - Arg_FunctionCallSearch(el->lhs()); - return; - } - FunctionCallSearch(e->lhs()); - FunctionCallSearch(e->rhs()); - return; -} - -void Arg_FunctionCallSearch(SgExpression *e) -{ - FunctionCallSearch(e); - return; -} - -void FunctionCallSearch_Left(SgExpression *e) -{ - FunctionCallSearch(e); -} - -int isAsterDummy(SgSymbol *s) -{ - if (!s) return 0; - if (!strcmp(s->identifier(),"*")) return 1; - return 0; -} - -SgExpression * TypeKindExpr(SgType *t) -{ - SgExpression *len; - SgExpression *selector; - if(!t) return (NULL); - len = t->length(); - selector = t->selector(); - //printf("\nTypeSize"); - //printf("\nranges:"); if(len) len->unparsestdout(); - //printf("\nkind_len:"); if(selector) selector->unparsestdout(); - - //the number of bytes is not specified in type declaration statement - if (!len && !selector) - return (new SgValueExp(IntrinsicTypeSize(t))); - if (t->variant() != T_STRING) // numeric types - { - if (len && !selector) //INTEGER*2,REAL*8,CHARACTER*(N+1) - return(Calculate(len)); - else - return(Calculate(selector->lhs() ? selector->lhs() : selector)); //specified kind:INT_VAL for literal constants or KIND_OP - } - else // character (T_STRING) - { - if (!selector->lhs()) // for literal constants 1_"xxx" - return(Calculate(selector)); - else if (selector->variant() == KIND_OP) - return(Calculate(selector->lhs())); - else if (selector->variant() == LENGTH_OP) - return(new SgValueExp(IntrinsicTypeSize(t))); - else if (selector->lhs()->variant()==KIND_OP) - return(Calculate(selector->lhs())); - else if (selector->rhs()->variant()==KIND_OP) - return(Calculate(selector->rhs())); - } - return (NULL); -} - -int CompareKind(SgType *type_arg, SgType *type_dummy) -{ - int kind1=-1, kind2=-1; - SgExpression *e1 = TypeKindExpr(type_dummy); - if (e1 && e1->isInteger()) - kind1 = e1->valueInteger(); - - SgExpression *e2 = TypeKindExpr(type_arg); - if (e2 && e2->isInteger()) - kind2 = e2->valueInteger(); - - if (kind1>=0 && kind1 == kind2) - return 1; - else - return 0; -} - -int CompareTypeKindRank (SgExpression *e, SgSymbol *dummy) -{ - if (!dummy) return 0; - if (e->variant() == ARRAY_OP) - CompareTypeKindRank (e->lhs(), dummy); - //if (isSgRecordRefExp(e)) - // CompareTypeKindRank (RightMostField(e), dummy); - if (!e->type() && !dummy->type()) - return 1; - else if (!e->type()) - return 0; - else if (!dummy->type()) - return 0; - - SgArrayType *artype_dummy = isSgArrayType(dummy->type()); - SgArrayType *artype_arg = isSgArrayType(e->type()); - if (artype_dummy != 0 && artype_arg != 0) - { - if (TYPE_DIM(artype_dummy->thetype) != TYPE_DIM(artype_arg->thetype)) //dimension() method cannot be used - return 0; - } - else if (artype_dummy == 0 && artype_arg == 0) - ; - else - return 0; - SgType *type_arg = artype_arg ? artype_arg->baseType() : e->type(); - SgType *type_dummy = artype_dummy ? artype_dummy->baseType() : dummy->type(); - - if (type_dummy->variant() == T_DERIVED_TYPE && type_arg->variant() == T_DERIVED_TYPE) - { - if (!strcmp(ORIGINAL_SYMBOL(type_dummy->symbol())->identifier(), ORIGINAL_SYMBOL(type_arg->symbol())->identifier())) - return 1; - else - return 0; - } - else if (type_dummy->variant() == T_DERIVED_TYPE || type_arg->variant() == T_DERIVED_TYPE) - return 0; - if (type_dummy->variant() == T_STRING) - { - if( type_arg->variant() == T_STRING) - return 1; - else - return 0; - } - if ( type_dummy->variant() == T_COMPLEX || type_dummy->variant() == T_DCOMPLEX) - if ( type_arg->variant() == T_COMPLEX || type_arg->variant() == T_DCOMPLEX) - return (CompareKind(type_arg, type_dummy)); - else - return 0; - if (type_dummy->variant() == T_FLOAT || type_dummy->variant() == T_DOUBLE) - if (type_arg->variant() == T_FLOAT || type_arg->variant() == T_DOUBLE) - return (CompareKind(type_arg,type_dummy)); - else - return 0; - if (type_arg->variant() != type_dummy->variant()) - return 0; - - return (CompareKind(type_arg,type_dummy)); -} - -int CompareArgDummy(SgExpression *e, int i, SgSymbol *symb) -{ - if (i == -1) return 0; - if (e->variant() == KEYWORD_ARG) - CompareArgDummy(e->rhs(), findParameterNumber(symb, NODE_STR(e->lhs()->thellnd)), symb); - //if((((SgFunctionSymb *) symb)->parameter(i))->attributes() & OPTIONAL_BIT ) return 1; - if (e->variant() == LABEL_ARG) return isAsterDummy(((SgFunctionSymb *) symb)->parameter(i)); //!!! illegal - return (CompareTypeKindRank(e, ((SgFunctionSymb *) symb)->parameter(i) )); -} - -int CompareArguments(SgSymbol *symb, SgExpression *arg_list) -{ - SgExpression *el, *e; - int i; - for (el = arg_list, i = 0; el; el = el->rhs(), i++) - if (!CompareArgDummy(el->lhs(), i, symb)) - return 0; - return 1; -} - -SgStatement *getInterfaceInScope(SgSymbol *s, SgStatement *func) -{ - enum { SEARCH_INTERFACE, CHECK_INTERFACE, FIND_NAME }; - - SgStatement *searchStmt = func->lexNext(); - SgStatement *tmp; - const char *funcName = s->identifier(); - const char *toCmp; - - int mode = SEARCH_INTERFACE; - //search interface in the specification part of a program unit - while (searchStmt && (!isSgExecutableStatement(searchStmt) || isDvmSpecification(searchStmt))) - { - switch (mode) - { - case SEARCH_INTERFACE: - if (searchStmt->variant() != INTERFACE_STMT) - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - else - mode = CHECK_INTERFACE; - break; - case CHECK_INTERFACE: - if (searchStmt->symbol()) - toCmp = searchStmt->symbol()->identifier(); - else - toCmp = ""; - - if (searchStmt->symbol() && strcmp(toCmp, funcName) != 0) - { - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - mode = SEARCH_INTERFACE; - } - else - { - if(searchStmt->symbol()) - { - return searchStmt; - } - else - { - mode = FIND_NAME; - searchStmt = searchStmt->lexNext(); - } - } - break; - case FIND_NAME: - if (searchStmt->variant() == FUNC_HEDR || searchStmt->variant() == PROC_HEDR) - { - if (!strcmp(searchStmt->symbol()->identifier(), funcName)) - return searchStmt; - else - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - } - else if (searchStmt->variant() == MODULE_PROC_STMT) - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - - if (searchStmt->variant() == CONTROL_END) // end of interface block - { - mode = SEARCH_INTERFACE; - searchStmt = searchStmt->lexNext(); - } - break; - } - } - return NULL; -} - -SgStatement *getInterface(SgSymbol *s) -{ - SgStatement *func = cur_func; - SgStatement *interface_st = NULL; - while (func->variant() != GLOBAL) - { - if (interface_st = getInterfaceInScope(s, func)) - return interface_st; - else - func = func->controlParent(); - } - return interface_st; -} - -int CompareModuleProcedureName(SgExpression *name_list, SgSymbol *symb) -{ - SgExpression *el; - for (el=name_list; el; el=el->rhs()) - if (!strcmp(el->lhs()->symbol()->identifier(), symb->identifier())) - return 1; - return 0; -} - -SgStatement *SearchModuleProcedure(SgExpression *name_list, SgExpression *arg_list, SgStatement *module_st) -{ - SgStatement *stmt = module_st->lexNext(); - while (stmt->variant() != CONTAINS_STMT && stmt->variant() != CONTROL_END ) - stmt = stmt->lastNodeOfStmt()->lexNext(); - if (stmt->variant() == CONTROL_END) - return NULL; - SgStatement *last = module_st->lastNodeOfStmt(); - for (stmt=stmt->lexNext(); stmt != last; stmt = stmt->lastNodeOfStmt()->lexNext()) - { - if (CompareModuleProcedureName(name_list, stmt->symbol()) && CompareArguments(stmt->symbol(),arg_list)) - return stmt; - else - continue; - } - return NULL; -} - -SgStatement *getGenericInterfaceInScope(SgSymbol *s, SgExpression *arg_list, SgStatement *func) -{ - enum { SEARCH_INTERFACE, CHECK_INTERFACE, FIND_NAME }; - - SgStatement *searchStmt = func->lexNext(); - SgStatement *tmp; - const char *funcName = s->identifier(); - const char *toCmp; - - int mode = SEARCH_INTERFACE; - //search interface in the specification part of a program unit - while (searchStmt && (!isSgExecutableStatement(searchStmt) || isDvmSpecification(searchStmt))) - { - switch (mode) - { - case SEARCH_INTERFACE: - if (searchStmt->variant() != INTERFACE_STMT) - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - else - mode = CHECK_INTERFACE; - break; - case CHECK_INTERFACE: - if (searchStmt->symbol()) - toCmp = searchStmt->symbol()->identifier(); - else - toCmp = ""; - - if (searchStmt->symbol() && !strcmp(toCmp, funcName)) - { - mode = FIND_NAME; - searchStmt = searchStmt->lexNext(); - } - else - { - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - mode = SEARCH_INTERFACE; - } - break; - case FIND_NAME: - if (searchStmt->variant() == FUNC_HEDR || searchStmt->variant() == PROC_HEDR) - { - if (CompareArguments(searchStmt->symbol(), arg_list)) - return searchStmt; - else - searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); - } - else if (searchStmt->variant() == MODULE_PROC_STMT) - { - SgStatement *module_proc = SearchModuleProcedure(searchStmt->expr(0), arg_list, func->variant()==MODULE_STMT ? func : ORIGINAL_SYMBOL(searchStmt->expr(0)->symbol())->scope()); - if (module_proc) - return module_proc; - else - searchStmt = searchStmt->lexNext(); - } - if (searchStmt->variant() == CONTROL_END) // end of interface block - { - mode = SEARCH_INTERFACE; - searchStmt = searchStmt->lexNext(); - } - break; - } - } - return NULL; -} - -SgStatement *getGenericInterface(SgSymbol *s, SgExpression *arg_list) -{ - SgStatement *func = IS_BY_USE(s) ? ORIGINAL_SYMBOL(s)->scope() : cur_func; - SgStatement *interface_st = NULL; - while (func->variant() != GLOBAL) - { - if (interface_st = getGenericInterfaceInScope(s, arg_list, func)) - return interface_st; - else - func = func->controlParent(); - } - return interface_st; -} - -void Call_Site(SgSymbol *s, int inlined, SgStatement *stat, SgExpression *e) -{ - graph_node * gnode, *node_by_attr = NULL; - SgSymbol *s_new = s; - SgStatement *interface_st = NULL; - //printf("\n%s id= %d type= %d\n", s->identifier(), s->id(), s->type() ? s->type()->variant() : 0); - if (!do_dummy && isDummyArgument(s)) return; - if (!do_stmtfn && isStatementFunction(s)) return; - // if(isIntrinsicFunction(s)) return; - //printf("\nLINE %d", cur_st->lineNumber()); - - if(s->variant() == INTERFACE_NAME && (in_region || in_routine)) - { - //printf("INTERFACE_NAME %s\n",s->identifier()); - interface_st = getGenericInterface(s, stat ? stat->expr(0) : e->lhs()); - SgSymbol *s_gen = s; - if(!interface_st) - { - Error("No interface found for the procedure %s", s->identifier(), 661, cur_func); - return; - } - s = interface_st->symbol(); - has_generic_interface = 1; - if (stat) - stat->setSymbol(*s); - else - e->setSymbol(*s); - MarkAsUserProcedure(s); - MarkAsExternalProcedure(s); - } - - if (ATTR_NODE(s)) - node_by_attr = GRAPHNODE(s); - gnode = GraphNode(s, NULL, 0); - CreateOutcomingEdge(gnode, inlined); // for node 'cur_node' edge: [cur_node]-> gnode - CreateIncomingEdge(gnode, inlined); // for node 'gnode' edge: cur_node ->[gnode] - if(node_by_attr && gnode != node_by_attr) - { - s_new = &s->copy(); - if (stat) - stat->setSymbol(*s_new); - else - e->setSymbol(*s_new); - graph_node **pnode = new (graph_node *); - *pnode = gnode; - s_new->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); - } - if (gnode->st_header) - MarkAsUserProcedure(s_new); - else if (in_routine && (interface_st || (interface_st = getInterface(s_new)))) - { - SaveInterface(s_new, interface_st); - MarkAsUserProcedure(s_new); - } - //printf(" call site on line %d: %d %s: %d %d\n", stat ? stat->lineNumber() : 0, ATTR_NODE(s_new) ? GRAPHNODE(s_new)->id : -1, s_new->identifier(), s_new->id(), s->id()); -} - -graph_node *GraphNode(SgSymbol *s, SgStatement *header_st, int flag_new) -{ - graph_node * gnode; - graph_node **pnode = new (graph_node *); - -#if __SPF - addToCollection(__LINE__, __FILE__, pnode, 1); -#endif - - gnode = flag_new == NEW ? NULL : NodeForSymbInGraph(s, header_st); - if (!gnode) - gnode = NewGraphNode(s, header_st); - - *pnode = gnode; - if (!ATTR_NODE(s)){ - s->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); - if (deb_reg > 1) - printf("\n attribute NODE[%d] for %s[%d]\n", GRAPHNODE(s)->id, s->identifier(), s->id()); - } - return(gnode); -} - -graph_node *SearchOriginalSymbolNode(SgSymbol *s, graph_node *first_node) -{ - graph_node *ndl; - SgSymbol * s_origin = ORIGINAL_SYMBOL(s); - for (ndl = first_node; ndl->same_name_next; ndl = ndl->same_name_next) - if (ndl->file_id == current_file_id && ndl->symb->scope() == s_origin->scope()) - return (ndl); - return (ndl); -} - -graph_node *SearchInternalProcedureName(SgSymbol *s, SgStatement *proc_scope, graph_node *first_node) -{ - graph_node *ndl; - for (ndl = first_node; ndl->same_name_next; ndl = ndl->same_name_next) - { - if (ndl->type != 2) continue; // is not internal procedure - if (ndl->file_id == current_file_id && ndl->symb->scope() == proc_scope) - return (ndl); - else - continue; - } - if (ndl->type == 2 && ndl->file_id == current_file_id && ndl->symb->scope() == proc_scope) - return (ndl); - else - return (NULL); - -} - -graph_node *SearchExternalProcedureName(graph_node *first_node) -{ - graph_node *ndl; - for (ndl = first_node; ndl->same_name_next; ndl = ndl->same_name_next) - if (ndl->type == 1) - return (ndl); - if (ndl->type == 1) - return (ndl); - else - return (NULL); -} - -graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader) -{ - graph_node *ndl, *node=NULL; - for (ndl = node_list; ndl; ndl = ndl->next) { - - if (!strcmp(ndl->name, ORIGINAL_SYMBOL(s)->identifier())) - { - if(ndl->same_name_next) - { - if(IS_BY_USE(s)) - { - node = SearchOriginalSymbolNode(s, ndl); - return (node); - } - if( s->attributes() & EXTERNAL_BIT || getInterface(s)) - { - node = SearchExternalProcedureName(ndl); - return (node); - } - if (cur_func->controlParent()->variant() == GLOBAL) - node = SearchInternalProcedureName(s, cur_func, ndl); - else if (cur_func->controlParent()->variant() == MODULE_STMT) - { - node = SearchInternalProcedureName(s, cur_func, ndl); - if (!node) - node = SearchInternalProcedureName(s, cur_func->controlParent(), ndl); - } - if (!node) - node = SearchExternalProcedureName(ndl); - } - else - node = ndl; - - return(node); - } - } - return(NULL); -} - -graph_node *SameNameNode(char *name) -{ - graph_node *ndl; - for (ndl = node_list->next; ndl; ndl = ndl->next) - if (!strcmp(ndl->name, name)) - return(ndl); - return (NULL); -} - -graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st) -{ - graph_node * gnode; - - gnode = new graph_node; - gnode->id = ++gcount; - gnode->next = node_list; - node_list = gnode; - gnode->same_name_next = SameNameNode(s->identifier()); - if (gnode->same_name_next) - gnode->samenamed = gnode->same_name_next->samenamed = 1; - gnode->file = header_st ? current_file : NULL; - gnode->file_id = header_st ? current_file_id : -1; - gnode->st_header = header_st; - gnode->symb = s; - gnode->name = new char[strlen(s->identifier()) + 1]; -#if __SPF - addToCollection(__LINE__, __FILE__, gnode->name, 2); -#endif - strcpy(gnode->name, s->identifier()); - gnode->to_called = NULL; - gnode->from_calling = NULL; - if (header_st && (header_st->variant() == FUNC_HEDR || header_st->variant() == PROC_HEDR)) - { - if (header_st->controlParent()->variant() == MODULE_STMT) - gnode->type = 3; - else if (header_st->controlParent()->variant() == GLOBAL) - gnode->type = 1; - else - gnode->type = 2; - } - else - gnode->type = 0; - if (header_st && header_st->expr(2)) - { - if (header_st->expr(2)->variant() == PURE_OP) - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | PURE_BIT; - else if (header_st->expr(2)->variant() == ELEMENTAL_OP) - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | ELEMENTAL_BIT; - } - gnode->split = 0; - gnode->tmplt = 0; - gnode->clone = 0; - gnode->count = 0; - gnode->is_routine = 0; - gnode->st_interface = NULL; - gnode->arg_numbs = NULL; - //printf("%s --- %d %d\n",gnode->name,gnode->id,gnode->type); - return(gnode); -} - -edge *CreateOutcomingEdge(graph_node *gnode, int inlined) -{ - edge *out_edge, *edgl; - //SgSymbol *sunit; - //sunit = cur_func->symbol(); - - // testing outcoming edge list of current (calling) routine graph-node: cur_node - for (edgl = cur_node->to_called; edgl; edgl = edgl->next) - if ((edgl->to->symb == gnode->symb) && (edgl->inlined == inlined)) //there is outcoming edge: [cur_node]->gnode - return(edgl); - // creating new edge: [cur_node]->gnode - out_edge = NewEdge(NULL, gnode, inlined); //NULL -> cur_node - out_edge->next = cur_node->to_called; - cur_node->to_called = out_edge; - return(out_edge); -} - -edge *CreateIncomingEdge(graph_node *gnode, int inlined) -{ - edge *in_edge, *edgl; - //SgSymbol *sunit; - //sunit = cur_func->symbol(); - - // testing incoming edge list of called routine graph-node: gnode - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - if ((edgl->from->symb == cur_node->symb) && (edgl->inlined == inlined)) //there is incoming edge: : cur_node->[gnode] - return(edgl); - // creating new edge: cur_node->[gnode] - in_edge = NewEdge(cur_node, NULL, inlined); //NULL -> gnode - in_edge->next = gnode->from_calling; - gnode->from_calling = in_edge; - return(in_edge); -} - -edge *NewEdge(graph_node *from, graph_node *to, int inlined) -{ - edge *nedg; - nedg = new edge; - nedg->from = from; - nedg->to = to; - nedg->inlined = inlined; - return(nedg); -} - -/**********************************************************************/ - -/* Testing and Help Functions */ - -/**********************************************************************/ - - -int isDummyArgument(SgSymbol *s) -{ - if (s->thesymb->entry.var_decl.local == IO) // is dummy argument - return(1); - else - return(0); -} - -int isHeaderStmtSymbol(SgSymbol *s) -{ - return(DECL(s) == 1 && (s->variant() == FUNCTION_NAME || s->variant() == PROCEDURE_NAME || s->variant() == PROGRAM_NAME)); -} - -int isStatementFunction(SgSymbol *s) -{ - if (DECL(s) == 2) - //if(s->scope() == cur_func && s->variant()==FUNCTION_NAME) - return (1); //is statement function symbol - else return (0); -} - -int isHeaderNode(graph_node *gnode) -{ - //header node represent a "top level" routine: - //main program, or any subprogram which was called - //without inline expansion somewhere in the original program - edge * edgl; - if (gnode->symb->variant() == PROGRAM_NAME) - return(1); - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - if (!edgl->inlined) return(1); - return(0); -} - -int isDeadNode(graph_node *gnode) -{ - // dead node represent a "dead" routine: - // a subprogram which was not called - if (gnode->from_calling || gnode->symb->variant() == PROGRAM_NAME) - return(0); - else - return(1); -} - -int isNoBodyNode(graph_node *gnode) -{ - // nobody node represent a "nobody" routine: intrinsic or absent - - if (gnode->st_header) - return(0); - else - return(1); -} - - -graph_node_list *addToNodeList(graph_node_list *pnode, graph_node *gnode) -{ - // adding the node to the beginning of node list - // pnode-> gnode -> gnode-> ... -> gnode - graph_node_list * ndl; - if (!pnode) { - pnode = new graph_node_list; - pnode->node = gnode; - pnode->next = NULL; - } - else { - ndl = new graph_node_list; - ndl->node = gnode; - ndl->next = pnode; - pnode = ndl; - } - return (pnode); -} - -graph_node_list *delFromNodeList(graph_node_list *pnode, graph_node *gnode) -{ - // deleting the node from the node list - - graph_node_list * ndl, *l; - if (!pnode) return (NULL); - if (pnode->node == gnode) return(pnode->next); - l = pnode; - for (ndl = pnode->next; ndl; ndl = ndl->next) - { - if (ndl->node == gnode) - { - l->next = ndl->next; - return(pnode); - } - else - l = ndl; - } - return (pnode); -} - -graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode) -{ - // testing: is there node in the node list - - graph_node_list * ndl; - if (!pnode) return (NULL); - for (ndl = pnode; ndl; ndl = ndl->next) - { - if (ndl->node == gnode) - return(ndl); - } - return (NULL); -} - -void addArgumentNumber(int i, SgSymbol *s) -{ - if (!ATTR_NODE(s)) - return; - graph_node *gnode = GRAPHNODE(s); - argument_numbers *nl; - for (nl=gnode->arg_numbs; nl; nl=nl->next) - if(i == nl->number) return; - nl = new argument_numbers; - nl->number = i; - if (gnode->arg_numbs) - { - nl->next = gnode->arg_numbs; - gnode->arg_numbs = nl; - } - else - gnode->arg_numbs = nl; -} - -void PrintGraphNode(graph_node *gnode) -{ - edge * edgl; - printf("\n%s(%d)[%d] -> ", gnode->name, gnode->symb->id(), gnode->id); - for (edgl = gnode->to_called; edgl; edgl = edgl->next) - printf(" %s(%d)", edgl->to->name, edgl->to->symb->id()); -} - -void PrintGraphNodeWithAllEdges(graph_node *gnode) -{ - edge * edgl; - printf("\n"); - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - printf(" %s(%d)", edgl->from->name, edgl->from->symb->id()); - if (!gnode->from_calling) - printf(" "); - printf(" ->%s(%d)-> ", gnode->name, gnode->symb->id()); - for (edgl = gnode->to_called; edgl; edgl = edgl->next) - printf(" %s(%d)", edgl->to->name, edgl->to->symb->id()); -} - -void PrintWholeGraph() -{ - graph_node *ndl; - printf("\n%s\n", "C a l l G r a p h"); - for (ndl = node_list; ndl; ndl = ndl->next) - PrintGraphNode(ndl); - printf("\n"); -} - -void PrintWholeGraph_kind_2() -{ - graph_node *ndl; - printf("\n%s\n", "C a l l G r a p h 2"); - for (ndl = node_list; ndl; ndl = ndl->next) - PrintGraphNodeWithAllEdges(ndl); - printf("\n"); -} - - -void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from) -{ - // deleting edge that is incoming to node 'gnode' from node 'from' - edge *edgl, *ledge; - ledge = NULL; - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) { - if (edgl->from == from) { - if (deb_reg > 1) - printf("\n%s(%d)-%s(%d) edge dead ", from->name, from->symb->id(), gnode->name, gnode->symb->id()); - - if (ledge) - ledge->next = edgl->next; - else - gnode->from_calling = edgl->next; - } - else - ledge = edgl; - } -} - -void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto) -{ - // deleting edge that is outcoming from node 'gnode' to node 'gto' - edge *edgl, *ledge; - ledge = NULL; - for (edgl = gnode->to_called; edgl; edgl = edgl->next) { - if (edgl->to == gto) { - if (deb_reg > 1) - printf("\n%s(%d)-%s(%d) edge empty ", gnode->name, gnode->symb->id(), gto->name, gto->symb->id()); - - if (ledge) - ledge->next = edgl->next; - else - gnode->to_called = edgl->next; - } - else - ledge = edgl; - } -} - -void ScanSymbolTable(SgFile *f) -{ - SgSymbol *s; - for (s = f->firstSymbol(); s; s = s->next()) - //if(isHeaderStmtSymbol(s)) - printSymb(s); -} - -void ScanTypeTable(SgFile *f) -{ - SgType *t; - for (t = f->firstType(); t; t = t->next()) - { // printf("TYPE[%d] : ", t->id()); - printType(t); - } -} - -void ReseatEdges(graph_node *gnode, graph_node *newnode) -{//reseat all edges representing inlined calls to gnode to point to newnode - edge *edgl, *tol, *ledge, *curedg; - graph_node *from; - ledge = NULL; - // for(edgl=gnode->from_calling; edgl; edgl=edgl->next) - // looking through the incoming edge list of gnode - edgl = gnode->from_calling; - while (edgl) - { - if (edgl->inlined) - { - from = edgl->from; - // reseating outcoming edge to 'gnode' to point to 'newnode' - for (tol = from->to_called; tol; tol = tol->next) - if (tol->to == gnode && tol->inlined) - { - tol->to = newnode; break; - } - // removing "inlined" incoming edge of gnode - if (ledge) - ledge->next = edgl->next; - else - gnode->from_calling = edgl->next; - - curedg = edgl; // set curedg to point at removed edge - edgl = edgl->next; // to next node of list - - // adding removed edge to 'newnode' - curedg->next = newnode->from_calling; - newnode->from_calling = curedg; - - } - else - { - ledge = edgl; - edgl = edgl->next; - } - } //end while -} - -void CopyOutcomingEdges(graph_node *gnode, graph_node *gnew) -{ - edge *out_edge, *in_edge, *edgl; - graph_node *s; - // looking through the outcoming edge list of gnode - for (edgl = gnode->to_called; edgl; edgl = edgl->next) - { - s = edgl->to; // successor of gnode - // creating new edge of gnew (copy of edgl) - out_edge = NewEdge(NULL, edgl->to, edgl->inlined); - out_edge->next = gnew->to_called; - gnew->to_called = out_edge; - // creating new edge of s (successor of gnode) - in_edge = NewEdge(gnew, NULL, edgl->inlined); - in_edge->next = s->from_calling; - s->from_calling = in_edge; - } - return; -} - -void CopyIncomingEdges(graph_node *gnode, graph_node *gnew) -{ - edge *in_edge, *out_edge, *edgl; - graph_node *p; - // looking through the incoming edge list of gnode - for (edgl = gnode->from_calling; edgl; edgl = edgl->next) - { - p = edgl->from; // predecessor of gnode - // creating new edge of gnew (copy of edgl) - in_edge = NewEdge(edgl->from, NULL, edgl->inlined); - in_edge->next = gnew->from_calling; - gnew->from_calling = in_edge; - // creating new edge of p (predecessor of gnode) - out_edge = NewEdge(NULL, gnew, edgl->inlined); - out_edge->next = p->to_called; - p->to_called = out_edge; - - } - return; -} - -void printSymb(SgSymbol *s) -{ - const char *head; - head = isHeaderStmtSymbol(s) ? "HEADER " : " "; - printf("SYMB[%3d] scope=STMT[%3d] : %s %s", s->id(), (s->scope()) ? (s->scope())->id() : -1, s->identifier(), head); - printType(s->type()); - if(s->variant() == CONST_NAME) - { - printf(" CONST_NAME "); - if(IS_BY_USE(s)) - printf(" BY_USE"); - printf("\n"); - return; - } - if(IS_BY_USE(s)) - printf(" BY_USE %s", ORIGINAL_SYMBOL(s)->scope()->symbol()->identifier()); - if(ATTR_NODE(s)) - printf(" GRAPHNODE %d", GRAPHNODE(s)->id); - printf("\n"); -} - -void printType(SgType *t) -{ - SgArrayType *arrayt; - - if (!t) { - printf("no type "); return; - } - else printf("TYPE[%d]:", t->id()); - if ((arrayt = isSgArrayType(t)) != 0) - { - SgExpression *e = arrayt->getDimList(); - if (!e) - printf(" dimension() "); - else - printf(" dimension(%s) ", UnparseExpr(arrayt->getDimList())); - /* - int i; - int n = arrayt->dimension(); - printf("dimension("); - for(i = 0; i < n; i++) - { if(arrayt->sizeInDim(i)) - { printf("%s", UnparseExpr(arrayt->sizeInDim(i))); //(arrayt->sizeInDim(i))->unparsestdout(); - if(i < n-1) printf(", "); - } - } - printf(") "); - */ - } - else - { - switch (t->variant()) - { - case T_INT: printf("integer "); break; - case T_FLOAT: printf("real "); break; - case T_DOUBLE: printf("double precision "); break; - case T_CHAR: printf("character "); break; - case T_STRING: printf("Character "); - UnparseLLND(TYPE_RANGES(t->thetype)); - /*if(t->length()) printf("[%d]",t->length()->variant());*/ - /*((SgArrayType *) t)->getDimList()->unparsestdout();*/ - break; - case T_BOOL: printf("logical "); break; - case T_COMPLEX: printf("complex "); break; - case T_DCOMPLEX: printf("double complex "); break; - - default: break; - } - } - - if (t->hasBaseType()) - { - printf("of "); - printType(t->baseType()); - } -} - -#undef NEW \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/checkpoint.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/checkpoint.cpp deleted file mode 100644 index 2cc19dc..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/checkpoint.cpp +++ /dev/null @@ -1,552 +0,0 @@ -#include "dvm.h" -#include - -class Checkpoint { - char *cpName; // checkpoint name - char *serviceFilename; // service file name - std::vector filenames; // filenames used for checkpointing - SgExprListExp *variables; // variables list - char defaultIOMode[5]; - - static const char SERVICE_FILE_SUFFIX[10]; - - SgSymbol *serviceUnitSymbol; - SgSymbol *writeUnitSymbol; - SgSymbol *currentFileSymbol; - SgSymbol *lastFileSymbol; - - SgLabel *emptyServiceFileLabel; - SgLabel *notExistingServiceFileLabel; - -public: - Checkpoint(char *cpName, std::vector filenames, SgExprListExp *variables, SgExpression *cpMode) { - defaultIOMode[0] = 0; - this->cpName = new char[strlen(cpName) + 1]; - strcpy(this->cpName, cpName); - this->serviceFilename = new char[strlen(cpName) + strlen(SERVICE_FILE_SUFFIX) + 1]; - strcpy(this->serviceFilename, cpName); - strcat(this->serviceFilename, SERVICE_FILE_SUFFIX); - this->filenames = filenames; - this->variables = variables; - - if (cpMode) { - if (cpMode->variant() == ACC_LOCAL_OP) strcpy(defaultIOMode, "l"); - else if (cpMode->variant() == PARALLEL_OP) strcpy(defaultIOMode, "p"); - else throw new std::runtime_error("Unknown type of checkpoint mode"); - } - else strcpy(defaultIOMode, "p"); - } - - void getNewLabels(int variant) { - this->emptyServiceFileLabel = GetLabel(); - if (variant == WRITE_STAT) this->notExistingServiceFileLabel = GetLabel(); - } - - SgSymbol *getServiceUnitSymbol() { - return this->serviceUnitSymbol; - } - - SgSymbol *getWriteUnitSymbol() { - return this->writeUnitSymbol; - } - - SgSymbol *getCurrentFileSymbol() { - return this->currentFileSymbol; - } - - SgSymbol *getLastFileSymbol() { - return this->lastFileSymbol; - } - - void defineVariables(); - void createEmptyLastFilenameAssign(); - void createSaveFilenamesStatement(); - void createOpenServiceFileBeforeCp(int variant); - void createReadServiceFileStatement(int variant); - void createCloseServiceFileStatement(bool useLabel); - void createCloseWriteFileStatement(); - void createOpenWriteFileStatement(bool isAsync); - void createWriteOrReadStatement(int variant); - void createWriteServiceFileStatement(); - void createOpenReadFileStatement(); - void createCheckFilenameStatement(); - void createOpenServiceFileAfterCp(); - void getNextFileStmt(); - void createSaveAsyncUnitStatement(); - void createCpWaitStatement(SgVarRefExp *statusVarRef); - -}; - -const char Checkpoint::SERVICE_FILE_SUFFIX[10] = ".info.dat"; - -struct stringLessComparator { - bool operator()(const char *a, const char *b) const { - return strcmp(a, b) < 0; - } -}; - -std::map checkpointMap; - -void insertContinueStatement() { - SgContinueStmt &continueStatement = *new SgContinueStmt(); - cur_st->lastNodeOfStmt()->insertStmtAfter(continueStatement, *cur_st->controlParent()); - cur_st = &continueStatement; -} - -/* adds new checkpoint to checkpointMap - example: !DVM$ CP_CREATE CP1, VARLIST(IT, B), FILES('jac_%02d.cp0','jac_%02d.cp1') [PARALLEL | LOCAL] - */ -void CP_Create_Statement(SgStatement *stmt, int error_msg) -{ - if (!options.isOn(IO_RTS)) { - if (error_msg) warn("Checkpoints aren't supported without iO_RTS option", 462, stmt); - } - SgVarRefExp *cpNameExpr = isSgVarRefExp(stmt->expr(0)); - if (!cpNameExpr) return; - char *cpName = cpNameExpr->symbol()->identifier(); - - SgExprListExp *variablesExpr = isSgExprListExp(stmt->expr(1)); - - SgExpression *filenamesAndCpModeExpr = stmt->expr(2); - SgExprListExp *filenamesExpr = NULL; - SgExpression *cpMode = NULL; - std::vector filenames; - if (isSgExprListExp(filenamesAndCpModeExpr)) { - filenamesExpr = isSgExprListExp(filenamesAndCpModeExpr); - } - else if (filenamesAndCpModeExpr->variant() == ARRAY_OP) { - filenamesExpr = isSgExprListExp(filenamesAndCpModeExpr->lhs()); - cpMode = filenamesAndCpModeExpr->rhs(); - } - // else syntax error, no need to check - - for (int i = 0; i < filenamesExpr->length(); ++i) { - SgValueExp *filename = isSgValueExp(filenamesExpr->elem(i)); - if (!filename) { - if (error_msg) { - err("Every filename in CP_CREATE statement should be character constant value", 463, stmt); - } - return; - } - size_t currentFilenameLength = strlen(filename->stringValue()); - if (currentFilenameLength >= 99) { - if (error_msg) { - err("Filename in CP_CREATE cannot be longer than 100 characters", 464, stmt); - } - return; - } - filenames.push_back(filenamesExpr->elem(i)); - } - try { - Checkpoint *checkpoint = new Checkpoint(cpName, filenames, variablesExpr, cpMode); - checkpoint->defineVariables(); - if (checkpointMap.find(cpName) != checkpointMap.end()) { - if (error_msg) { - Error("Checkpoint with name %s already exists", cpName, 465, stmt); - } - return; - } - checkpointMap[cpName] = checkpoint; - checkpoint->createSaveFilenamesStatement(); - checkpoint->createEmptyLastFilenameAssign(); - } - catch(std::runtime_error error) { - if (error_msg) { - err(error.what(), 0, stmt); - } - return; - } - -} - -/* fixme: delete from here! use the only enum for io.cpp and checkpoint.cpp */ -enum {UNIT_IO, ACCESS_IO, ACTION_IO, ASYNC_IO, BLANK_IO, DECIMAL_IO, DELIM_IO, ENCODING_IO, ERR_IO, FILE_IO, - FORM_IO, IOSTAT_IO, IOMSG_IO, NEWUNIT_IO, PAD_IO, POSITION_IO, RECL_IO, ROUND_IO, SIGN_IO, STATUS_IO, DVM_MODE_IO, NUMB__CL }; -enum { UNIT_RW, FMT_RW, NML_RW, ADVANCE_RW, ASYNC_RW, BLANK_RW, DECIMAL_RW, DELIM_RW, END_RW, EOR_RW, ERR_RW, ID_RW, - IOMSG_RW, IOSTAT_RW, PAD_RW, POS_RW, REC_RW, ROUND_RW, SIGN_RW, SIZE_RW, NUMB__RW }; - -void Checkpoint::defineVariables() { - - const int varLength = 300; //(int) (20 + strlen(this->cpName)); - char serviceUnitVarName[varLength]; - strcpy(serviceUnitVarName, "dvmh_service_unit_"); - strcat(serviceUnitVarName, this->cpName); - - char writeUnitVarName[varLength]; - strcpy(writeUnitVarName, "dvmh_write_unit_"); - strcat(writeUnitVarName, this->cpName); - - char currentFileVarName[varLength]; - strcpy(currentFileVarName, "dvmh_current_file_"); - strcat(currentFileVarName, this->cpName); - - char lastFileVarName[varLength]; - strcpy(lastFileVarName, "dvmh_last_file_"); - strcat(lastFileVarName, this->cpName); - - this->serviceUnitSymbol = new SgSymbol(VARIABLE_NAME, serviceUnitVarName); - this->serviceUnitSymbol->setType(SgTypeInt()); - this->writeUnitSymbol = new SgSymbol(VARIABLE_NAME, writeUnitVarName); - this->writeUnitSymbol->setType(SgTypeInt()); - - SgStringLengthExp *lengthExpr = new SgStringLengthExp(*new SgValueExp(100)); - SgType *stringType = new SgType(T_STRING, lengthExpr, SgTypeChar()); - - this->currentFileSymbol = new SgSymbol(VARIABLE_NAME, currentFileVarName); - this->currentFileSymbol->setType(stringType); - - this->lastFileSymbol = new SgSymbol(VARIABLE_NAME, lastFileVarName); - this->lastFileSymbol->setType(stringType); - - /* declare these variables for testing */ - cur_func->insertStmtAfter(*serviceUnitSymbol->makeVarDeclStmt()); - cur_func->insertStmtAfter(*writeUnitSymbol->makeVarDeclStmt()); - cur_func->insertStmtAfter(*currentFileSymbol->makeVarDeclStmt()); - cur_func->insertStmtAfter(*lastFileSymbol->makeVarDeclStmt()); - -} - -void Checkpoint::createSaveFilenamesStatement() { - - /* generates dvmh_cp_save_filenames call: - dvmh_cp_save_filenames(checkpoint_name, files_count, filename1, filename2, ...) - */ - - SgStatement *stmt = SaveCheckpointFilenames(new SgValueExp(this->cpName), this->filenames); - SgStatement *cpCreateDir = cur_st; - cur_st->insertStmtAfter(*stmt, *cur_st->controlParent()); - cur_st = stmt; - cpCreateDir->extractStmt(); -} - -void Checkpoint::createEmptyLastFilenameAssign() { - /* - initialization dvmh_last_file variable. generating dvmh_last_file = ''& - */ - SgVarRefExp *lastFilename = new SgVarRefExp(this->lastFileSymbol); - SgValueExp *emptyString = new SgValueExp(""); - doAssignTo_After(lastFilename, emptyString); -} - -void Checkpoint::createOpenServiceFileBeforeCp(int variant) { - /* statement to be generated: - open(newunit=service_unt, file=service_filename, - access='stream', status='old', err=err_label, position='rewind', action='read') - */ - - SgExpression *ioc[NUMB__CL]; - for (int i = 0; i < NUMB__CL; ++i) { - ioc[i] = NULL; - } - - ioc[NEWUNIT_IO] = new SgVarRefExp(this->serviceUnitSymbol); - ioc[ACCESS_IO] = new SgValueExp("STREAM"); - ioc[ACTION_IO] = new SgValueExp("READ"); - ioc[FILE_IO] = new SgValueExp(serviceFilename); - ioc[POSITION_IO] = new SgValueExp("REWIND"); // for reading file - ioc[STATUS_IO] = new SgValueExp("OLD"); - - // if service file is opened for reading, error should occur. - // if it is opened for saving checkpoint, not existing file is normal - if (variant == WRITE_STAT) ioc[ERR_IO] = new SgLabelRefExp(*this->notExistingServiceFileLabel); - - insertContinueStatement(); - Dvmh_Open(ioc, defaultIOMode); -} - -void Checkpoint::createOpenServiceFileAfterCp() { - /* statement to be generated: - open(newunit=service_unt, file=serviceFileName, access='stream', position='rewind', action='write') - */ - - SgExpression *ioc[NUMB__CL]; - for (int i = 0; i < NUMB__CL; ++i) { - ioc[i] = NULL; - } - - ioc[NEWUNIT_IO] = new SgVarRefExp(this->serviceUnitSymbol); - ioc[ACCESS_IO] = new SgValueExp("STREAM"); - ioc[ACTION_IO] = new SgValueExp("WRITE"); - ioc[FILE_IO] = new SgValueExp(this->serviceFilename); - ioc[POSITION_IO] = new SgValueExp("REWIND"); - ioc[STATUS_IO] = new SgValueExp("OLD"); - - insertContinueStatement(); - Dvmh_Open(ioc, defaultIOMode); -} - -void Checkpoint::createReadServiceFileStatement(int variant) { - /* statement to be generated: - read(unit = service_unt, end=200) last_filename - end argument is used only for writing checkpoint. - */ - - SgExpression *ioc[NUMB__RW]; - for (int i = 0; i < NUMB__RW; ++i) { - ioc[i] = NULL; - } - - ioc[UNIT_RW] = new SgVarRefExp(this->serviceUnitSymbol); - SgLabelRefExp *endLabelRef = new SgLabelRefExp(*this->emptyServiceFileLabel); - ioc[END_RW] = endLabelRef; - - SgVarRefExp &lastFilenameExpr = *new SgVarRefExp(this->lastFileSymbol); - SgExprListExp &itemsToRead = *new SgExprListExp(lastFilenameExpr); - - SgExprListExp &specList = *new SgExprListExp(); - - SgSpecPairExp &specPairUnit = *new SgSpecPairExp(*new SgValueExp("unit"), *new SgVarRefExp(this->serviceUnitSymbol)); - specList.append(specPairUnit); - if (variant == WRITE_STAT) { - SgSpecPairExp &specPairEnd = *new SgSpecPairExp(*new SgValueExp("end"), *endLabelRef); - specList.append(specPairEnd); - } - - SgInputOutputStmt *ioStatement = new SgInputOutputStmt(READ_STAT, specList, itemsToRead); - - insertContinueStatement(); - Dvmh_ReadWrite(ioc, ioStatement); - -} - -void Checkpoint::createWriteServiceFileStatement() { - /* statement to be generated: - write(unit = service_unt) current_filename - */ - SgExpression *ioc[NUMB__RW]; - for (int i = 0; i < NUMB__RW; ++i) { - ioc[i] = NULL; - } - - ioc[UNIT_RW] = new SgVarRefExp(this->serviceUnitSymbol); - - SgVarRefExp ¤tFileExpr = *new SgVarRefExp(this->currentFileSymbol); - SgExprListExp &itemsToWrite = *new SgExprListExp(currentFileExpr); - - SgSpecPairExp &specPairUnit = *new SgSpecPairExp(*new SgValueExp("unit"), *new SgVarRefExp(this->serviceUnitSymbol)); - SgExprListExp &specList = *new SgExprListExp(); - specList.append(specPairUnit); - SgInputOutputStmt *ioStatement = new SgInputOutputStmt(WRITE_STAT, specList, itemsToWrite); - - insertContinueStatement(); - Dvmh_ReadWrite(ioc, ioStatement); - -} - -void Checkpoint::createCloseServiceFileStatement(bool useLabel) { - /* statement to generate: - [label] close(unit = service_unit) - */ - - SgExpression *ioc[NUMB__CL]; - for (int i = 0; i < NUMB__CL; ++i) - ioc[i] = NULL; - ioc[UNIT_IO] = new SgVarRefExp(this->serviceUnitSymbol); - - insertContinueStatement(); - Dvmh_Close(ioc); - - if (useLabel) cur_st->setLabel(*this->emptyServiceFileLabel); - -} - -void Checkpoint::getNextFileStmt() { - - SgStatement *getNextFilenameStmt = - GetNextFilename(new SgValueExp(this->cpName), - new SgVarRefExp(this->lastFileSymbol), - new SgVarRefExp(this->currentFileSymbol)); - doCallAfter(getNextFilenameStmt); - cur_st->setLabel(*this->notExistingServiceFileLabel); -} - -void Checkpoint::createCloseWriteFileStatement() { - /* statement to generate: - close(unit = write_unit) - */ - - SgExpression *ioc[NUMB__CL]; - for (int i = 0; i < NUMB__CL; ++i) - ioc[i] = NULL; - ioc[UNIT_IO] = new SgVarRefExp(this->writeUnitSymbol); - - insertContinueStatement(); - Dvmh_Close(ioc); - -} - -void Checkpoint::createOpenReadFileStatement() { - /* statement to be generated: - open(newunit = write_unt, file=last_filename, access='stream', status='old') - */ - SgExpression *ioc[NUMB__CL]; - for (int i = 0; i < NUMB__CL; ++i) { - ioc[i] = NULL; - } - - ioc[NEWUNIT_IO] = new SgVarRefExp(this->writeUnitSymbol); - ioc[FILE_IO] = new SgVarRefExp(this->lastFileSymbol); - ioc[ACCESS_IO] = new SgValueExp("STREAM"); - ioc[STATUS_IO] = new SgValueExp("OLD"); - - insertContinueStatement(); - Dvmh_Open(ioc, defaultIOMode); - -} - -void Checkpoint::createOpenWriteFileStatement(bool isAsync) { - /* statement to be generated: - open(newunit = write_unt, file=current_filename, access='stream', status='replace', dvmIoMode = defaultIOMode[+s]) - */ - SgExpression *ioc[NUMB__CL]; - for (int i = 0; i < NUMB__CL; ++i) { - ioc[i] = NULL; - } - - ioc[NEWUNIT_IO] = new SgVarRefExp(this->writeUnitSymbol); - ioc[FILE_IO] = new SgVarRefExp(this->currentFileSymbol); - ioc[ACCESS_IO] = new SgValueExp("STREAM"); - ioc[STATUS_IO] = new SgValueExp("REPLACE"); - ioc[ACTION_IO] = new SgValueExp("WRITE"); - - insertContinueStatement(); - char *ioMode = new char[5]; - strcpy(ioMode, defaultIOMode); - if (isAsync) strcat(ioMode, "s"); - Dvmh_Open(ioc, ioMode); - -} - -void Checkpoint::createWriteOrReadStatement(int variant) { - SgExpression *ioc[NUMB__RW]; - for (int i = 0; i < NUMB__RW; ++i) { - ioc[i] = NULL; - } - - ioc[UNIT_RW] = new SgVarRefExp(this->writeUnitSymbol); - - SgSpecPairExp &specPairUnit = *new SgSpecPairExp(*new SgValueExp("unit"), *new SgVarRefExp(this->writeUnitSymbol)); - SgExprListExp &specList = *new SgExprListExp(); - specList.append(specPairUnit); - SgInputOutputStmt *ioStatement = new SgInputOutputStmt(variant, specList, *this->variables); - - insertContinueStatement(); - Dvmh_ReadWrite(ioc, ioStatement); - -} - -void Checkpoint::createCheckFilenameStatement() { - /* checks that filename was in current checkpoint declaration. - generates dvmh_cp_check_filename(checkpoint_name, filename) - */ - SgValueExp *cpNameExpr = new SgValueExp(this->cpName); - SgVarRefExp *lastFileExpr = new SgVarRefExp(this->lastFileSymbol); - SgStatement *checkFileStatement = CheckFilename(cpNameExpr, lastFileExpr); - cur_st->insertStmtAfter(*checkFileStatement, *cur_st->controlParent()); - cur_st = checkFileStatement; - -} - -void Checkpoint::createSaveAsyncUnitStatement() { - /* saves unit when cp_save is used in async mode - generates dvmh_cp_save_async_unit(checkpoint_name, filename, unit) - */ - SgValueExp *cpName = new SgValueExp(this->cpName); - SgVarRefExp *currentFileExpr = new SgVarRefExp(this->currentFileSymbol); - SgVarRefExp *writeUnitRef = new SgVarRefExp(this->writeUnitSymbol); - - SgStatement *cpSaveAsyncUnit = CpSaveAsyncUnit(cpName, currentFileExpr, writeUnitRef); - cur_st->insertStmtAfter(*cpSaveAsyncUnit, *cur_st->controlParent()); - cur_st = cpSaveAsyncUnit; - -} - -void Checkpoint::createCpWaitStatement(SgVarRefExp *statusVarRef) { - /* wait for all files to finish async saving and closing them - generates dvmh_cp_wait(checkpoint_name, status_var) - */ - SgStatement *initialCpWait = cur_st; - SgStatement *cpWaitStmt = CpWait(new SgValueExp(this->cpName), statusVarRef); - cur_st->insertStmtAfter(*cpWaitStmt); - cur_st = cpWaitStmt; - initialCpWait->extractStmt(); -} - -Checkpoint *getCheckpoint(SgStatement *stmt, int error_msg) { - SgVarRefExp *checkpointVarRef = isSgVarRefExp(stmt->expr(0)); - char *checkpointName = new char[strlen(checkpointVarRef->symbol()->identifier()) + 1]; - strcpy(checkpointName, checkpointVarRef->symbol()->identifier()); - std::map::iterator checkpointIt = checkpointMap.find(checkpointName); - if (checkpointIt == checkpointMap.end()) { - if (error_msg) { - Error("No created checkpoint with name %s found", checkpointName, 466, stmt); - } - return NULL; - } - return checkpointIt->second; -} - -void CP_Save_Statement(SgStatement *stmt, int error_msg) { - - /* - stmt->variant() == DVM_CP_SAVE_DIR - stmt->expr(0) – имя-контр-точки - stmt->expr(1) – NULL или variant == ACC_ASYNC_OP - */ - Checkpoint *checkpoint = getCheckpoint(stmt, error_msg); - if (!checkpoint) return; - - bool isAsync = (stmt->expr(1) != NULL && stmt->expr(1)->variant() == ACC_ASYNC_OP); - - checkpoint->getNewLabels(WRITE_STAT); - - checkpoint->createOpenServiceFileBeforeCp(WRITE_STAT); - checkpoint->createReadServiceFileStatement(WRITE_STAT); - checkpoint->createCloseServiceFileStatement(true); - - checkpoint->getNextFileStmt(); - - checkpoint->createOpenWriteFileStatement(isAsync); - if (isAsync) checkpoint->createSaveAsyncUnitStatement(); - checkpoint->createWriteOrReadStatement(WRITE_STAT); - if (!isAsync) checkpoint->createCloseWriteFileStatement(); - - checkpoint->createOpenServiceFileAfterCp(); - checkpoint->createWriteServiceFileStatement(); - checkpoint->createCloseServiceFileStatement(false); - -} - -void CP_Load_Statement(SgStatement *stmt, int error_msg) { - Checkpoint *checkpoint = getCheckpoint(stmt, error_msg); - if (!checkpoint) return; - - checkpoint->getNewLabels(READ_STAT); - - checkpoint->createOpenServiceFileBeforeCp(READ_STAT); - checkpoint->createReadServiceFileStatement(READ_STAT); - checkpoint->createCloseServiceFileStatement(true); - - checkpoint->createCheckFilenameStatement(); - - checkpoint->createOpenReadFileStatement(); - checkpoint->createWriteOrReadStatement(READ_STAT); - checkpoint->createCloseWriteFileStatement(); - -} - -void CP_Wait(SgStatement *stmt, int error_msg) { - Checkpoint *checkpoint = getCheckpoint(stmt, error_msg); - if (!checkpoint) return; - - SgVarRefExp *statusVarRef = isSgVarRefExp(stmt->expr(1)); - if (!statusVarRef || !(statusVarRef->symbol()->type()->variant() == T_INT)) { - if (error_msg) - err("Wrong type of STATUS argument in CP_WAIT-statement", 467, stmt); - return; - } - - checkpoint->createCpWaitStatement(statusVarRef); - -} - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/debug.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/debug.cpp deleted file mode 100644 index e5ebf57..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/debug.cpp +++ /dev/null @@ -1,1181 +0,0 @@ -/**************************************************************\ -* Fortran DVM * -* * -* Generating statements and restructuring program for * -* Debugger and Performance Analyzer * -\**************************************************************/ - -#include "dvm.h" -extern int is_heap_ref; - -/***************************************************************\ - * Debugging mode functions * -\***************************************************************/ -void D_AddToDoList (int Nloop, int Nline, SgLabel *lab, SgSymbol *var) -{D_do_list *doel; -//adding element to D_do_list correcponding current loop - if(!cur_do) { //list is empty - cur_do = new D_do_list; - cur_do->No = Nloop; - cur_do->num_line = Nline; - cur_do->end_lab = lab; - cur_do->do_var = var; - cur_do->next = NULL; - } else if (!free_list) { //list of free elements is empty, creating new element - doel = new D_do_list; - doel->No = Nloop; - doel->num_line = Nline; - doel->end_lab = lab; - doel->do_var = var; - doel->next = cur_do; - cur_do = doel; - } - else { // taking free element - doel = free_list; - free_list = free_list->next; - doel->No = Nloop; - doel->num_line = Nline; - doel->end_lab = lab; - doel->do_var = var; - doel->next = cur_do; - cur_do = doel; - } -} - -void D_DelFromDoList () -{D_do_list *doel; - if(!cur_do) //list is empty - return; - doel = cur_do; - cur_do = cur_do->next; - doel->next = free_list; - free_list = doel; -} - -void ArrayRegistration () -{ symb_list *sl; - SgSymbol *ar; - int count; - count = 0; - registration_array = CreateRegistrationArraySymbol(); - for(sl=registration; sl; sl=sl->next) { - ar = sl->symb; - if(IN_MODULE){ - int *index = new int; - count_reg++; - *index = count_reg; - ar->addAttribute(DEBUG_AR_INDEX,(void*) index, sizeof(int)); - } - Registrate_Ar(ar); - - } -} - -void AllocatableArrayRegistration (SgStatement *stmt) -{SgExpression *alce,*al; - //SgSymbol *ar; - - LINE_NUMBER_AFTER(stmt,stmt); - - for(al=stmt->expr(0); al; al=al->rhs()) { - alce = al->lhs(); //allocation - if(isSgRecordRefExp(alce)) - alce = RightMostField(alce); - //ar = alce->symbol(); - Registrate_Allocatable(alce,stmt); - } -} - -void Registrate_Ar(SgSymbol *ar) -{ SgExpression *ehead, *size_array; - SgStatement *if_st,*savest; - int ia,idvm; - idvm=ndvm; - savest = where; - ia = ar->attributes(); - if(!VarType(ar) || (ia & INHERIT_BIT) || (ia & HEAP_BIT) || IS_POINTER(ar) || IS_DUMMY(ar) || (ia & ALLOCATABLE_BIT) || (ia & POINTER_BIT) || (IN_COMMON(ar) && (ar->scope()->variant() != PROG_HEDR)) || (!strcmp(ar->identifier(),"heap")) ) - return; - if(ALIGN_RULE_INDEX(ar)) return; - - if(ORIGINAL_SYMBOL(ar)->scope()->variant() == MODULE_STMT) { - if_st = doIfThenConstrWithArElem (registration_array,DEBUG_INDEX(ar)); - where = if_st->lexNext(); // reffer to ENDIF statement - } - ehead = HEADER(ar) ? GetAddresDVM(HeaderRefInd(ar,1)) : GetAddresMem(FirstArrayElement(ar)); - size_array = doSizeArray(ar, NULL); - InsertNewStatementBefore( D_RegistrateArray(Rank(ar),VarType(ar), ehead, size_array, - new SgArrayRefExp(*ar)),where); - SET_DVM(idvm); - where = savest; - return; -} - -void Registrate_Allocatable(SgExpression *alce, SgStatement *stmt) -{SgSymbol *ar; - SgExpression *ehead, *size_array; - SgStatement *savest; - int idvm; - - idvm=ndvm; - savest = where; - ar = alce->symbol(); - - if(VarType(ar)) { - ehead = GetAddresMem(FirstArrayElement(ar)); - size_array = dvm_array_ref(); // SizeArray reference - InsertNewStatementAfter( D_RegistrateArray(Rank(ar),VarType(ar), ehead, size_array, new SgArrayRefExp(*ar)),cur_st,stmt->controlParent()); - where = cur_st; - doSizeAllocArray(ar,alce,stmt,RTS1); - cur_st=cur_st->lexNext(); // call registration function drarr() - } - SET_DVM(idvm); - where = savest; - return; -} - -void AllocArrayRegistration( SgStatement *stmt) -{SgSymbol *p; - SgStatement *stat; - SgExpression *size_array,*array_adr,*desc,*heap; - int rank,type,idvm; - stat = where; //store value of where - idvm = ndvm; - where = stmt; - p = stmt->expr(0)->symbol(); - if(!IS_POINTER(p)) - return; - - if(!stmt->expr(1)->lhs()) {// empty argument list of allocate function call - err("Wrong argument list of ALLOCATE function call", 262, stmt); - return; - } - if(!stmt->expr(1)->lhs()->rhs()) {// argument list length < 2 - //err("Wrong argument list of ALLOCATE function call", 262, stmt); - return; - } - heap = stmt->expr(1)->lhs()->rhs()->lhs(); //heap array reference - if(!heap || !isSgArrayRefExp(heap) || heap->lhs()) - return; - rank = PointerRank(p); - - desc = stmt->expr(1)->lhs()->lhs(); //descriptor array reference - array_adr = new SgArrayRefExp(*heap->symbol(),*(stmt->expr(0))); - size_array = ReverseDim(desc,rank); - type = TestType(PointerType(p)); - if(type) { - InsertNewStatementAfter(D_RegistrateArray(rank, type, GetAddresMem(array_adr),size_array,stmt->expr(0) ) ,where,where->controlParent()); - LINE_NUMBER_AFTER(where,where); - } - SET_DVM(idvm); - where = stat; //restore where -} - - -void RegistrateAllocArray( stmt_list *alloc_st) -{SgSymbol *p,*heap; - SgStatement *stmt,*stat; - stmt_list *stl; - SgExpression *size_array,*array_adr,*desc; - int rank,type,idvm; - stat = where; //store value of where - SET_DVM(ndvm); - idvm = ndvm = maxdvm+1; - for (stl=alloc_st; stl; stl=stl->next) { - stmt = stl->st; - where = stmt; - p = stmt->expr(0)->symbol(); - if(!IS_POINTER(p)) - continue; - heap = HeapForPointer(p); - if(!heap) - continue; - rank = PointerRank(p); - desc = stmt->expr(1)->lhs()->lhs(); //descriptor array reference - array_adr = new SgArrayRefExp(*heap,*(stmt->expr(0))); - size_array = ReverseDim(desc,rank); - type = TestType(PointerType(p)); - if(type) - InsertNewStatementAfter(D_RegistrateArray(rank, type, GetAddresMem(array_adr),size_array,stmt->expr(0) ) ,where,where->controlParent()); - SET_DVM(idvm); - } - where = stat; //restore where -} - - -int isDoVar(SgSymbol *s) -{ - return(SYMB_ATTR(s->thesymb) & DO_VAR_BIT); -} - -void SetDoVar(SgSymbol *s) -{ - SYMB_ATTR(s->thesymb)=SYMB_ATTR(s->thesymb) | DO_VAR_BIT; -} - -void OffDoVar(SgSymbol *s) -{ - SYMB_ATTR(s->thesymb)=SYMB_ATTR(s->thesymb) & (~ DO_VAR_BIT); -} - -void D_ReplaceDoLab(SgLabel *lab, SgLabel *newlab) -{D_do_list *dol; - dol = cur_do; - while(LABEL_STMTNO(dol->end_lab->thelabel) == LABEL_STMTNO(lab->thelabel)) { - dol->end_lab = newlab; - dol = dol->next; - } -} - -void DebugVarArrayRef(SgExpression *e,SgStatement *stmt) -{ SgSymbol *ar; - //int ind; - SgExpression *el, *ehead, *rme, *ea; - //int *h; - - if(!e) - return; - - if(isSgVarRefExp(e)) { - if(isDoVar(e->symbol())) //do variable is not traced - return; - if(level_debug == 4) - if(e->symbol()->variant()==VARIABLE_NAME && VarType(e->symbol())) //&& e->symbol()->type()->variant() != T_STRING && e->symbol()->type()->variant() != T_DERIVED_TYPE) - InsertNewStatementBefore(D_LoadVar(e,VarType(e->symbol()), ConstRef(0),e),stmt); - return; - } - - if(isSgArrayRefExp(e)) { // array element, array section, whole array - ea = & (e->copy()); - for(el=e->lhs(); el; el=el->rhs()) - DebugVarArrayRef(el->lhs(),stmt); - - if(isSgArrayType(e->type())) // array section, whole array - return; - - ar = e -> symbol(); - if(HEADER(ar)) { //distributed array reference - //ind = *h; - if((rme=isRemAccessRef(e))){ //is remote data - rem_var * rv; - rv = (rem_var *)rme->attributeValue(0,REMOTE_VARIABLE); - if((rv->ncolon == 0) && (rv->amv == -1 )) - ehead = ConstRef(0); - else - ehead = GetAddresDVM((rv->amv != 1 ) ? DVM000(rv->index) : HeaderRefInd(ar,rv->index )); - } else - ehead = GetAddresDVM(HeaderRefInd(ar,1)); - // ea = & (e->copy()); - DistArrayRef(e,0,stmt); - if(level_debug == 4 || level_debug == 2) - if(ar->variant()==VARIABLE_NAME && VarType(ar)){ - if(hpf_ind) - InsertNewStatementBefore(D_LoadVar(e,VarType(ar), HPF000(hpf_ind), ea),stmt); - else - InsertNewStatementBefore(D_LoadVar(e,VarType(ar), ehead, ea),stmt); - } - } - else - if(level_debug == 4 || level_debug == 2 && IS_DVM_ARRAY(ar)) - if(ar->variant()==VARIABLE_NAME && VarType(ar)){ - //InsertNewStatementBefore(D_LoadVar(e,VarType(ar), ConstRef(0), ea),stmt); - ehead = GetAddresMem(FirstArrayElement(ar)); - InsertNewStatementBefore(D_LoadVar(e,VarType(ar), ehead, ea),stmt); - } - return; - } - - if(isSgFunctionCallExp(e)) { - //if(!e->lhs()) - //argument list is absent - ReplaceFuncCall(e); - for(el=e->lhs(); el; el=el->rhs()) - DebugArg_VarArrayRef(el,stmt); - return; - } - if(isSgRecordRefExp(e) && !only_debug){ - ChangeDistArrayRef(e); - return; - } - DebugVarArrayRef(e->lhs(),stmt); - DebugVarArrayRef(e->rhs(),stmt); - return; -} - -void DebugVarArrayRef_Left(SgExpression *e,SgStatement *stmt,SgStatement *stcur) -{ SgExpression *el,*ea; - SgSymbol *ar; - - if(isSgVarRefExp(e)) { //variable - if(isDoVar(e->symbol())) //do variable is not traced - return; - if(level_debug > 2) - /*if(e->symbol()->type()->variant() != T_STRING && e->symbol()->type()->variant() != T_COMPLEX && e->symbol()->type()->variant() != T_DCOMPLEX) { */ - //if(e->symbol()->type()->variant() != T_STRING) { - //variant of scalar variable reference, that has type T_STRING, is ARRAY_REF - if(e->symbol()->variant()==VARIABLE_NAME && VarType(e->symbol())) { - //InsertNewStatementBefore(D_PrStorVar(e,VarType(e->symbol()), ConstRef(0), e),stmt); /*28.03.03*/ - InsertNewStatementAfter (D_PrStorVar(e,VarType(e->symbol()), ConstRef(0), e),stcur,stmt->controlParent()); - InsertNewStatementAfter (D_StorVar(),stmt,stmt->controlParent()); - InsertNewStatementAfter (Addres(e),stmt,stmt->controlParent()); - } //inserting before and after assignment statement - - //stmt->insertStmtAfter (*D_StorVar(e,VarType(e->symbol()), new SgValueExp(0))); - //InsertNewStatementBefore(D_StorVar(e,VarType(e->symbol()), new SgValueExp(0)),stmt); - return; - } - - if(isSgArrayRefExp(e)) { // array element, array section, whole array - ea = &e->copy(); - for(el=e->lhs(); el; el=el->rhs()) //looking through the subscript list - DebugVarArrayRef(el->lhs(),stmt); - if(isSgArrayType(e->type())) // array section, whole array - return; - ar = e->symbol(); //array symbol - if(HEADER(ar)) { - //ea = &e->copy(); - DistArrayRef(e,1,stmt); // 1 - modified variable - /*if(ar->variant()==VARIABLE_NAME && e->type()->variant() != T_STRING && e->type()->variant() != T_COMPLEX && e->type()->variant() != T_DCOMPLEX){*/ - //!!! variant of scalar variable reference, that has type T_STRING, is ARRAY_REF - if(ar->variant()==VARIABLE_NAME && VarType(ar)) { - InsertNewStatementAfter(D_PrStorVar(e,VarType(ar),GetAddresDVM(HeaderRefInd(ar,1)), ea),stcur,stmt->controlParent()); - InsertNewStatementAfter(D_StorVar(),stmt,stmt->controlParent()); - } //inserting before and after assignment statement - } - else - if(level_debug > 2 || level_debug > 0 && IS_DVM_ARRAY(ar)) - if(ar->variant()==VARIABLE_NAME && VarType(ar)) { - InsertNewStatementAfter(D_PrStorVar(e,VarType(ar),GetAddresMem(FirstArrayElement(ar)), ea),stcur,stmt->controlParent()); - InsertNewStatementAfter(D_StorVar(),stmt,stmt->controlParent()); - } //inserting before and after assignment statement - - - return; - } - - if(e->variant()==ARRAY_OP){ //substring - DebugVarArrayRef(e->lhs()->lhs(),stmt); - DebugVarArrayRef(e->rhs(),stmt); - return; - } - if(!only_debug) ChangeDistArrayRef_Left(e); - return; -} - -void CheckVarArrayRef(SgExpression *e, SgStatement *stmt, SgExpression *epr) -{ - if(isSgVarRefExp(e) || isSgArrayRefExp(e) ) { //variable - - if(e->symbol()->type()->variant() != T_STRING) { - InsertNewStatementAfter(D_PrStorVar(e,VarType(e->symbol()), ConstRef(0), epr),stmt,stmt->controlParent()); - InsertNewStatementAfter (D_StorVar(),cur_st,stmt->controlParent()); - - //InsertNewStatementAfter (Addres(e),stmt,stmt->controlParent()); - } //inserting before and after assignment statement - - return; - } - //f(isSgArrayRefExp(e)) return; - return; -} - -void DebugArg_VarArrayRef(SgExpression *ele,SgStatement *stmt) -{ SgSymbol *ar; - SgExpression *el, *e; - e = ele->lhs(); - if(!e) - return; - if(isSgKeywordArgExp(e)) - e = e->rhs(); - if(isSgVarRefExp(e)) { - if(isDoVar(e->symbol())) //do variable is not traced - return; - if(e->symbol()->variant()!=VARIABLE_NAME) //argument is function name - return; - //if((stmt->variant() == LOGIF_NODE) || (stmt->variant() == IF_NODE) || (stmt->variant() == ELSEIF_NODE) || (stmt->variant() == ARITHIF_NODE)) - // return; - // InsertNewStatementBefore(D_InOutVar(e,VarType(e->symbol()), new SgValueExp(0)),stmt); - // InsertNewStatementAfter (D_InOutVar(e,VarType(e->symbol()), new SgValueExp(0)),stmt,stmt->controlParent()); - - return; - } - if(e->variant()==ARRAY_OP){ //substring - DebugVarArrayRef(e->lhs()->lhs(),stmt); - DebugVarArrayRef(e->rhs(),stmt); - } - if(isSgArrayRefExp(e)) { - if(!(e->lhs())) // argument is whole array (array name) - return; - el=e->lhs()->lhs(); //first subscript of argument - //testing: is first subscript of ArrayRef a POINTER - if((isSgVarRefExp(el) || isSgArrayRefExp(el)) && IS_POINTER(el->symbol())){ - DebugVarArrayRef(el->lhs(),stmt); - if(!only_debug) { - if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) - is_heap_ref = 1; - else - Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,stmt); - if(e->lhs()->rhs()) //there are other subscripts - Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,stmt); - if(HEADER(e->symbol())) - Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,stmt); - - e->setSymbol(*heapdvm); //replace ArrayRef: A(P)=>HEAP00(P) or A(P(I))=>HEAP00(P(I)) - //ele->setLhs(PointerHeaderRef(el,1)); - //replace ArrayRef by PointerRef: A(P)=>P(1) orA(P(I))=>P(1,I) - } - /* - else { //only_debug - if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) - heap_point = HeapList(heap_point,e->symbol(),el->symbol()); - } - */ - return; - } - - for(el=e->lhs(); el; el=el->rhs()) - DebugVarArrayRef(el->lhs(),stmt); - ar = e->symbol(); - if(HEADER(ar)) { - DistArrayRef(e,0,stmt); - // if((stmt->variant() == LOGIF_NODE) || (stmt->variant() == IF_NODE) || (stmt->variant() == ELSEIF_NODE) || (stmt->variant() == ARITHIF_NODE)) - // return; - //!!! insert test for remote data as in DebugVarArrayRef - // InsertNewStatementBefore(D_InOutVar(e,VarType(ar), HeaderRef(ar)),stmt); - // InsertNewStatementAfter (D_InOutVar(e,VarType(ar), HeaderRef(ar)),stmt,stmt->controlParent()); - } - // else { - // if((stmt->variant() == LOGIF_NODE) || (stmt->variant() == IF_NODE) || (stmt->variant() == ELSEIF_NODE) || (stmt->variant() == ARITHIF_NODE)) - // return; - // InsertNewStatementBefore(D_InOutVar(e,VarType(ar), new SgValueExp(0)),stmt); - // InsertNewStatementAfter (D_InOutVar(e,VarType(ar), new SgValueExp(0)),stmt,stmt->controlParent()); - // } - return; - } - DebugVarArrayRef(e,stmt); - return; -} - -void DebugExpression(SgExpression *e, SgStatement *stmt) -{ - SgStatement *stif,*st1; - SgExpression *el; - st1=stmt->lexPrev(); - if(isSgCallStmt(stmt)) - // looking through the arguments list - for(el=stmt->expr(0); el; el=el->rhs()) - DebugArg_VarArrayRef(el,stmt); // argument - else - DebugVarArrayRef(e,stmt); - st1 = st1->lexNext() ; - if(st1 != stmt){ - if(dbg_if_regim){ - InsertNewStatementBefore(stif=CreateIfThenConstr(DebugIfCondition(), NULL),st1); - TransferBlockIntoIfConstr(stif,stif->lexNext()->lexNext(),stmt); - } - LINE_NUMBER_BEFORE(stmt,st1); - } -} - -void DebugAssignStatement(SgStatement *stmt) -{ - SgStatement *stcur, *after_st = NULL, *stmt1; - if(dbg_if_regim) - after_st=ReplaceStmt_By_IfThenConstr(stmt, DebugIfCondition()); - - LINE_NUMBER_STL_BEFORE(stcur,stmt,stmt); - DebugVarArrayRef_Left(stmt->expr(0),stmt,stcur); // left part - DebugVarArrayRef(stmt->expr(1),stmt); // right part - - if(dbg_if_regim){ - stmt1 = stmt->lexNext(); - if(stmt1->variant() != CONTROL_END) { - TransferStmtAfter(stmt1,after_st); - ReplaceStmt_By_IfThenConstr(stmt1, DebugIfCondition()); - while( stmt->lexNext()->variant() != CONTROL_END ) - TransferStmtAfter(stmt->lexNext(),stmt1); - } - TransferStmtAfter(stmt,after_st); - cur_st = stmt1->lexNext(); - } -} - -void DebugLoop(SgStatement *stmt) -{int No; - SetDoVar(stmt->symbol()); - LINE_NUMBER_BEFORE(stmt,stmt); - DebugVarArrayRef(stmt->expr(0),stmt); - DebugVarArrayRef(stmt->expr(1),stmt); - No =++Dloop_No; - AddAttrLoopNumber(No,stmt); - InsertNewStatementBefore(D_Begsl(No),stmt); - - if(dbg_if_regim) { - SgStatement *stnew,*if_stmt; - stnew = D_Iter(stmt->symbol(),LoopVarType(stmt->symbol(),stmt)); - if_stmt = new SgLogIfStmt(*DebugIfCondition(),*stnew); - InsertNewStatementAfter(if_stmt,stmt,stmt); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF - } else - InsertNewStatementAfter(D_Iter(stmt->symbol(),LoopVarType(stmt->symbol(),stmt)),stmt,stmt); - - /* - SetDoVar(stmt->symbol()); - InsertNewStatementBefore(D_Lnumb(stmt->lineNumber()),stmt); - No =++Dloop_No; - AddAttrLoopNumber(No,stmt); - InsertNewStatementBefore(D_Begsl(No),stmt); - InsertNewStatementAfter(D_Iter(stmt->symbol()),stmt,stmt); - */ - - /** - // generating Logical IF statement: - // begin_lab IF (dosl(No,Init,Last,Step) .EQ. 0) GO TO end_lab - // and inserting it before loop - stn = stmt->lexPrev(); - LINE_NUMBER_AFTER(stmt,stn); - begin_lab = GetLabel(); - stn->lexNext()-> setLabel(*begin_lab); - end_lab = GetLabel(); - dopl = (dvm_debug && dbg_if_regim) ? doPLmb(iplp) : doLoop(iplp); - if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); - - cur_st->insertStmtAfter(*if_stmt); - - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF - // (error Sage) - **/ - if(dbg_if_regim) - {SgStatement *stwhile; - SgForStmt *stdo; - int iout; - stdo = (SgForStmt *) stmt; - iout=ndvm; - doAssignStmtBefore(stdo->start(),stmt); - doAssignStmtBefore(stdo->end(), stmt); - doAssignStmtBefore((stdo->step()) ? stdo->step() : new SgValueExp(1),stmt); - stwhile = new SgWhileStmt(WHILE_NODE); - stwhile->setExpression(0,SgEqOp(*doSL(No,iout) , *new SgValueExp(1)) );//0->1 - stmt->insertStmtBefore(*stwhile); - stdo->setStart(*DVM000(iout)); - stdo->setEnd(*DVM000(iout+1)); - } - -} - -void DebugTaskRegion(SgStatement *stmt) -{int ino; - taskreg_No =++Dloop_No; - //AddAttrLoopNumber(No,stmt); - LINE_NUMBER_AFTER(stmt,stmt); - ino = ndvm; - doAssignStmtAfter(new SgValueExp(taskreg_No)); FREE_DVM(1); - InsertNewStatementAfter(D_Begtr(ino),cur_st,stmt->controlParent()); -} - -void CloseTaskRegion(SgStatement *tr_st,SgStatement *stmt) -{ - if(!tr_st) return; - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter( D_Endl(taskreg_No,tr_st->lineNumber()),cur_st,stmt->controlParent()); -} - -void DebugParLoop(SgStatement *stmt,int rank, int iinit) -{ - pardo_No = ++Dloop_No; - LINE_NUMBER_AFTER_WITH_CP(par_do,stmt,par_do->controlParent()); - InsertNewStatementAfter(D_Begpl(pardo_No,rank,iinit),cur_st,cur_st->controlParent()); - -} - -SgStatement *CloseLoop(SgStatement *stmt) -{//generates and insertes debugging statements for closing all sequential loops of nest: - // call dendl(...) - //stmt is last statement of loop nest (DO statements with the same label) - //returns last statement of outer most sequential loop of resturtured loop nest - SgStatement *stat, *parent, *lst, *dst, *est; - //SgForStmt *do_st; - int No,Ni; - - parent=stmt->controlParent(); - cur_st = lst = stmt; - if(parent->symbol()) - OffDoVar(parent->symbol()); - if(parent->variant()==WHILE_NODE) { - if(stmt->lineNumber()) { - LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,parent->controlParent()); - } - seq_loop_nest=1; - stat = new SgStatement(CONT_STAT); - InsertNewStatementAfter(stat,cur_st,parent->controlParent()); - } - else if((No=LoopNumber(parent)) != 0){ - if(stmt->lineNumber()) { - LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,parent->controlParent()); - } - seq_loop_nest=1; - stat = D_Endl(No,parent->lineNumber()); - InsertNewStatementAfter(stat,cur_st,parent->controlParent()); - dst = cur_st; - est = NULL; - if( perf_analysis && (Ni = IntervalNumber(parent)) != 0){ - close_loop_interval = close_loop_interval - 1; - InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),cur_st,parent->controlParent()); - est = cur_st; - } - - ReplaceGoToInsideLoop(parent,lst,dst,est); - - if(dbg_if_regim){ - SgWhileStmt *stwhile; - stwhile=(SgWhileStmt *) parent->lexPrev(); - parent->extractStmt(); - stwhile->replaceBody(*parent); - //cur_st=stmt->lexNext(); //ENDDO - lst=stmt->lexNext(); //ENDDO - parent=stwhile; - } - } - if(!stmt->label()) //DO construct without label - return(lst); - //looking through the loop nest with the same label - parent = parent->controlParent(); - while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif) && ( LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))==LABEL_STMTNO(stmt->label()->thelabel))) -//while((do_st=isSgForStmt(parent)) && do_st->endOfLoop() && ( LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(stmt->label()->thelabel))) - { - if(parent->variant()==WHILE_NODE) { - seq_loop_nest=1; - cur_st=ReplaceDoLabel(cur_st,GetLabel()); - lst = cur_st; - stat = new SgStatement(CONT_STAT); - InsertNewStatementAfter(stat,cur_st,parent->controlParent()); - parent = parent->controlParent(); - continue; - } - else if((No=LoopNumber(parent)) != 0){ - seq_loop_nest=1; - OffDoVar(parent->symbol()); - ReplaceDoLabel(cur_st,GetLabel()); - lst = cur_st->lexNext(); - stat = D_Endl(No,parent->lineNumber()); - dst = lst; - InsertNewStatementAfter(stat,cur_st->lexNext(),parent->controlParent()); - dst = dst->lexNext(); - est = NULL; - if(perf_analysis && (Ni=IntervalNumber(parent)) != 0){ - close_loop_interval = close_loop_interval - 1; - InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),cur_st,parent->controlParent()); - est = cur_st; - } - ReplaceGoToInsideLoop(parent,lst,dst,est); - - } - else - break; - - if(dbg_if_regim){ - SgWhileStmt *stwhile; - stwhile=(SgWhileStmt *) parent->lexPrev(); - parent->extractStmt(); - stwhile->replaceBody(*parent); - //cur_st=stmt->lexNext(); //ENDDO - lst=stmt->lexNext(); //ENDDO - parent=stwhile; - } - parent = parent->controlParent(); - } - - /* - for(parent = parent->controlParent(); - ((do_st=isSgForStmt(parent)) && LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(stmt->label()->thelabel)); - parent = parent->controlParent()) { - OffDoVar(parent->symbol()); - if(No=LoopNumber(parent)){ - ReplaceDoLabel(cur_st,GetLabel()); - stat = D_Endl(No,parent->lineNumber()); - InsertNewStatementAfter(stat,cur_st->lexNext(),parent->controlParent()); - } - } - */ - - return (lst); -} - -void FreeDoList() -{int Numlab; - Numlab =LABEL_STMTNO(cur_do->end_lab->thelabel); - while(cur_do && LABEL_STMTNO(cur_do->end_lab->thelabel) == Numlab) - D_DelFromDoList (); -} - -void OpenParLoop(SgStatement *dost) -{SgStatement *st; - st = cur_st;//save cur_st - SetDoVar(dost->symbol()); - InsertNewStatementAfter(D_Iter(dost->symbol(),LoopVarType(dost->symbol(),dost)),dost,dost); - cur_st = st; //resave cur_st -} - -void OpenParLoop_Inter(SgStatement *dost, int ind, int indtp, SgSymbol *do_var[],int ndo) -{SgStatement *st; - int i; - st = cur_st;//save cur_st - cur_st = dost; - - if(dbg_if_regim) { - SgStatement *stnew; - stnew = CreateIfThenConstr(DebugIfCondition(),D_Iter_I(ind,indtp)); - InsertNewStatementAfter(stnew,dost,dost); - for(i=0; ilineNumber(); - if (end_line_num) - { - LINE_NUMBER_AFTER_WITH_CP(end_stmt, stmt, par_do->controlParent()); - } - - InsertNewStatementAfter( D_Endl(pardo_No,par_do->lineNumber()),cur_st,par_do->controlParent()); - OffDoVar(dostmt->symbol()); - do_lab=((SgForStmt *)dostmt)->endOfLoop(); - if(!do_lab) //DO statement 'dostmt' without label - return; - //looking through the loop nest with the same label - for(st = dostmt->controlParent(); - ((do_st=isSgForStmt(st)) && do_st->endOfLoop() && LABEL_STMTNO(do_st->endOfLoop()->thelabel) == LABEL_STMTNO(do_lab->thelabel)); - st = st->controlParent()) - OffDoVar(st->symbol()); - //DeleteGoToFromList(par_do); -} - -void CloseDoInParLoop(SgStatement *end_stmt) -{ //on debug regim end_stmt may not be logical IF - SgStatement *lst; - if(LoopNumber(end_stmt->controlParent()) || end_stmt->controlParent()->variant()==WHILE_NODE) { - //most inner loop in parallel loop nest is not parallel - seq_loop_nest=0; - lst=CloseLoop(end_stmt); //close all inner non-parallel loops - //ReplaceDoNestLabel_Above(cur_st,cur_st->lexPrev()->controlParent(),GetLabel()); - if(seq_loop_nest) - ReplaceParDoNestLabel(cur_st,lst->controlParent(),GetLabel()); - //replace label and insert CONTINUE with new label for parallel nest - cur_st = cur_st->lexNext(); //last inserted statement == last statement of parallel nest - } -} - -void AddAttrLoopNumber(int No,SgStatement *stmt) -{int *loop_No = new int; - *loop_No = No; - stmt->addAttribute(LOOP_NUMBER, (void*) loop_No, sizeof(int)); -} - -int LoopNumber(SgStatement *stmt) -{int *no; - no=(int*)(stmt)->attributeValue(0,LOOP_NUMBER); - if(no) - return(*no); - else - return(0); -} - -int hasGoToIn(SgStatement *parent,SgLabel *lab_after) -{ //stmt_list *gotol; - - for (; goto_list && goto_list->st->lineNumber() > parent->lineNumber() ; goto_list = delFromStmtList(goto_list)) - if( ToThisLabel(goto_list->st,lab_after)) - return(1); - return(0); -} - -int ToThisLabel(SgStatement *gost, SgLabel *lab_after) -{ - return (LABEL_STMTNO(((SgGotoStmt *)gost)->branchLabel()->thelabel) == LABEL_STMTNO(lab_after->thelabel) ); -} - -/* -void ReplaceGoToLabelInsideLoop(SgStatement *parent,SgLabel *lab_after,SgLabel *new_lab) - -{ for (; goto_list && goto_list->st->lineNumber() > parent->lineNumber() ; goto_list = delFromStmtList(goto_list)) - if( ToThisLabel(goto_list->st,lab_after)) - NODE_LABEL(goto_list->st->expr(2)->thellnd)= new_lab->thelabel; - //replace the label in GOTO statement -} -*/ - -void ReplaceGoToLabelInsideLoop(SgStatement *parent,SgStatement *lst, SgLabel *lab_after) -{ printf("replace label\n"); - if(lab_after && hasGoToIn(parent,lab_after)){ - SgLabel *new_lab; - new_lab = GetLabel(); - (lst->lexNext())->setLabel(*new_lab); - for (; goto_list && goto_list->st->lineNumber() > parent->lineNumber() ; goto_list = delFromStmtList(goto_list)) - if( ToThisLabel(goto_list->st,lab_after)) - NODE_LABEL(goto_list->st->expr(2)->thellnd)= new_lab->thelabel; - //replace the label in GOTO statement - } -} - -void ReplaceGoToInsideLoop(SgStatement *dost,SgStatement *endst, SgStatement *dst, SgStatement *est) -{ //dost - do-statement, endst - last statement of do-loop - stmt_list *gol, *prevl; - SgLabel *golab; - int branch_line_num; //line number of statement to that goto points - - for (gol= goto_list, prevl = NULL; gol && gol->st->lineNumber() > dost->lineNumber() ; gol = gol->next) - { - if(gol->st->variant() == ARITHIF_NODE) - { ReplaceArithIF(gol); goto DELETE_; } - if(gol->st->variant() == COMGOTO_NODE) - { ReplaceComputedGoTo(gol); goto DELETE_; } - - if(gol->st->variant() == GOTO_NODE) - { - golab=((SgGotoStmt *)(gol->st))->branchLabel(); - branch_line_num=LineNumberOfStmtWithLabel(golab); - } else - branch_line_num = 0; //for case gol->st is RETURN or EXIT - if(branch_line_num <= dost->lineNumber() || branch_line_num > endst->lineNumber()) //label outside loop - { //inserting statements for end of loop (call of dendl,eloop) before goto - InsertStmtsBeforeGoTo(gol->st,dst,est); - if(gol->st->variant()!=EXIT_STMT) - { prevl = gol; - continue; - } - } -DELETE_: - {//deleting current element (gol) from goto_list - if(prevl) - prevl->next = gol->next; - else - goto_list = goto_list->next; - } - } -} - -void AddDebugGotoAttribute(SgStatement *gotost,SgStatement *lnumst) -{ SgStatement **dbgst = new (SgStatement *); - *dbgst = lnumst; - gotost->addAttribute(DEBUG_GOTO, (void *) dbgst, sizeof(SgStatement *)); -} - - -void InsertStmtsBeforeGoTo(SgStatement *gotost, SgStatement *dst, SgStatement *est) -{SgStatement *lnumst, *save; - SgStatement **st; - save=cur_st; - if(!(st=DEBUG_STMTS_FOR_GOTO(gotost))) //goto has not attribute (LINE_NUMBER is not yet inserted ) - { - LINE_NUMBER_STL_BEFORE(lnumst,gotost,gotost); - AddDebugGotoAttribute(gotost,lnumst); - cur_st = lnumst; - } else - cur_st = *st; - - if(dst) - InsertNewStatementAfter( &(dst->copy()),cur_st,cur_st->controlParent()); - - if(est) - InsertNewStatementAfter( &(est->copy()),cur_st,cur_st->controlParent()); - - *DEBUG_STMTS_FOR_GOTO(gotost) = cur_st; - cur_st = save; -} - -SgStatement *StmtWithLabel(SgLabel *lab) -{return (BfndMapping(LABEL_BODY(lab->thelabel))); -} - -int LineNumberOfStmtWithLabel(SgLabel *lab) -{return (BIF_LINE(LABEL_BODY(lab->thelabel))); -} - -void DeleteGoToFromList(SgStatement *stmt) -{ - for(; goto_list && goto_list->st->lineNumber() > stmt->lineNumber() ; goto_list = delFromStmtList(goto_list)) //deleting from list goto statements appearing inside parallel loop - ; -} -/***************************************************************\ - * Performance analyzing mode functions * -\***************************************************************/ -int OpenInterval(SgStatement *stmt) -{ - interval_list *fr = new interval_list; - fr->prev = NULL; - fr->No = ++nfrag; - fr->begin_st = stmt; - if(!St_frag) - St_frag = fr; - else { - fr->prev = St_frag; - St_frag = fr; - } - return (nfrag); -} - -int CloseInterval() -{int nline; - if(!St_frag) - return(0); - //DeleteGoToFromList( St_frag->begin_st); - nline = St_frag->begin_st->lineNumber(); - St_frag = St_frag->prev; - return (nline); - -} - -void ExitInterval(SgStatement *stmt) -{ - interval_list *current_interval = St_frag; - SgExpression *el; - LINE_NUMBER_AFTER(stmt,stmt); - for(el=stmt->expr(0); el; el=el->rhs()) - { - if(ExpCompare(el->lhs(),current_interval->begin_st->expr(0))) - { - InsertNewStatementAfter(St_Einter(current_interval->No,current_interval->begin_st->lineNumber()), cur_st, stmt->controlParent()); - current_interval = current_interval->prev; - } - else - { - err("Illegal interval number", 635, stmt); - break; - } - } -} - -void OverLoopAnalyse(SgStatement *func) -{SgStatement *st; -//St_loop_first = NULL; -//St_loop_last = NULL; - for(st=par_do->controlParent(); st!=func; st=st->controlParent()) { - if(st->variant() == FOR_NODE || st->variant() == WHILE_NODE ) - SeqLoopBegin(st); - else - continue; - } - //St_loop_first->prev = St_frag; - //St_frag = St_loop_last; - //close_loop_interval = 1; -} - -void FormLoopIntList(SgStatement *st) -{ - interval_list *fr = new interval_list; - fr->prev = NULL; - fr->No = ++nfrag; - fr->begin_st = st; - if(!St_loop_last){ - St_loop_last = fr; - St_loop_first = fr; - } - else { - St_loop_first->prev = fr; - St_loop_first = fr; - } -} - -int IntervalNumber(SgStatement *stmt) -{int *no; - no=(int*)(stmt)->attributeValue(0,LOOP_INTERVAL_NUMBER); - if(no) - return(*no); - else - return(0); -} - -void SeqLoopBegin(SgStatement *st) -{ - if( !IntervalNumber(st)){ - AddAttrIntervalNumber(st); - close_loop_interval = close_loop_interval + 1; - LINE_NUMBER_BEFORE(st,st); - InsertNewStatementBefore(St_Bsloop(nfrag),st); - } -} - -void AddAttrIntervalNumber(SgStatement *stmt) -{int *int_No = new int; - *int_No = ++nfrag; - stmt->addAttribute(LOOP_INTERVAL_NUMBER, (void*) int_No, sizeof(int)); -} - -SgStatement *SeqLoopEnd(SgStatement *end_stmt,SgStatement *stmt) -{int Ni,ind; - SgStatement *parent,*lst, *est; - //SgLabel *lab_after; - parent = end_stmt->controlParent(); - cur_st = lst = stmt; - //lab_after = stmt->lexNext()->lineNumber() ? stmt->lexNext()->label() : stmt->lexNext()->lexNext()->label(); //there is (not) inserted CONTINUE statement by ReplaceDoNestLabel_Above - if( (Ni = IntervalNumber(parent)) != 0){ - close_loop_interval = close_loop_interval - 1; - InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),stmt,parent->controlParent()); - est = cur_st; - //ReplaceGoToLabelInsideLoop(parent,lst,lab_after); - ReplaceGoToInsideLoop(parent,end_stmt,NULL,est); - } - else - InsertNewStatementAfter(new SgStatement(CONT_STAT),stmt,parent->controlParent()); - - if(!end_stmt->label()) // ENDDO is end of DO constuct - return(lst); - parent = parent->controlParent(); - while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) - && BIF_LABEL_USE(parent->thebif) - && ( LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))==LABEL_STMTNO(end_stmt->label()->thelabel))) { - - if(parent->variant()==WHILE_NODE) { - cur_st=ReplaceDoLabel(cur_st,GetLabel()); - lst = cur_st; - InsertNewStatementAfter(new SgStatement(CONT_STAT),cur_st,parent->controlParent()); - parent = parent->controlParent(); - continue; - } - - else if((Ni=IntervalNumber(parent)) != 0){ - close_loop_interval = close_loop_interval - 1; - ReplaceDoLabel(cur_st,GetLabel()); - lst = cur_st->lexNext(); - InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),lst, parent->controlParent()); - est = cur_st; - ReplaceGoToInsideLoop(parent,lst,NULL,est); - } - else - break; - parent = parent->controlParent(); - } - return (lst); -} - -SgExpression *Value(SgExpression *e) -{int val = FICT_INT; - return(e ? e : new SgValueExp(val)); -} - -SgExpression *Value_F95(SgExpression *e) -{ - if(!e) - return(ConstRef_F95(FICT_INT)); - else if(e && e->variant()==INT_VAL) - return(ConstRef_F95(e->valueInteger())); - else - return(TypeFunction(SgTypeInt(),e,len_DvmType ? new SgValueExp(len_DvmType) : NULL)); - -} - -void SeqLoopEndInParLoop(SgStatement *end_stmt,SgStatement *stmt) -{ // closing sequential loop intervals in parallel loop nest - //and restructuring loop nest - SgStatement *lst; - if(IntervalNumber(end_stmt->controlParent()) || end_stmt->controlParent()->variant()==WHILE_NODE) { - //most inner loop in parallel loop nest is not parallel - lst=SeqLoopEnd(end_stmt,stmt); //close all inner non-parallel loop intervals - ReplaceDoNestLabel_Above(cur_st,lst->controlParent(),GetLabel()); - //replace label and insert CONTINUE with new label for parallel nest - cur_st = cur_st->lexNext(); //last inserted statement == last statement of parallel nest - } -} - -void SkipParLoopNest(SgStatement *stmt) -{ SgExpression *dovar; - int i,nloop; - SgStatement *st,*stl; - stl = stmt; - i = nloop = 0; - // looking through the do_variables list - for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) - nloop++; - // looking through the loop nest - for(st=par_do; ilexNext(),i++) - stl = st; - cur_st = stl; -} - -heap_pointer_list *HeapList(heap_pointer_list *heap_point, SgSymbol *sheap,SgSymbol *sp) -{ heap_pointer_list *l; - if(!heap_point) { - heap_point = new heap_pointer_list; - heap_point->symb_p = sp; - heap_point->symb_heap = sheap; - heap_point->next = NULL; - } else { - for(l=heap_point; l; l=l->next) - if(l->symb_p == sp) - return(heap_point); - l = new heap_pointer_list; - l->symb_p = sp; - l->symb_heap = sheap; - l->next = heap_point; - heap_point = l; - } - return(heap_point); -} - -SgSymbol *HeapForPointer(SgSymbol *p) -{heap_pointer_list *l; - SgSymbol *heap = NULL; - for(l=heap_point; l; l=l->next) - if(l->symb_p == p){ - heap = l->symb_heap; - break; - } - return(heap); -} - -SgStatement *Check(SgStatement *stmt) -{ SgExpression *cl, *vl, *en, *esym,*eop; - SgSymbol *s; - //int level; - cl = stmt->expr(1); //control list - vl = stmt->expr(0); //variable list - en = cl ? cl->lhs() : new SgValueExp(stmt->lineNumber()); - en = (en->rhs()) ? en->rhs() : en; // variant is KEYWORD_ARG - LINE_NUMBER_NEXP_AFTER(en,stmt,stmt->controlParent()); - //for(; cl; cl=cl->rhs()) - - for(; vl; vl=vl->rhs()) { - s = vl->lhs()->symbol(); - eop = vl->lhs(); - if(s->type()->variant() == T_ARRAY && eop->type()->variant() == T_ARRAY) { //!!!calculating SUMMA - if(!isSgArrayRefExp(eop) || eop->lhs()) { - Error("Illegal argument: %s",s->identifier(),334,stmt); - continue; - } - if(!check_sum) - check_sum = CheckSummaSymbol(); - eop = new SgVarRefExp(check_sum); - if(HEADER(s)){ - doAssignStmtAfter(SummaOfDistrArray(HeaderRef(s), eop)); - FREE_DVM(1); - } - else { - SgExpression *size_array; - SgStatement *save_st; - int ind; - ind = ndvm; - doAssignStmtAfter(SummaOfArray(FirstArrayElement(s),Rank(s),DVM000(ind+1),VarType_RTS(s), eop)); - save_st = cur_st; where = cur_st; - size_array = doSizeArray(s,stmt); - cur_st = save_st; - SET_DVM(ind); - } - } - esym = vl->lhs(); //variable reference - CheckVarArrayRef(eop,cur_st,esym); - } - return(cur_st); -} - - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/dvm.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/dvm.cpp deleted file mode 100644 index edab431..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/dvm.cpp +++ /dev/null @@ -1,14930 +0,0 @@ - -/*********************************************************************/ -/* Fortran DVM V.5 2011 (DVM+OpenMP+ACC) */ -/*********************************************************************/ - -#include -#include - -#define IN_DVM_ -#include "dvm.h" -#undef IN_DVM_ - -#include "libSageOMP.h" - - -const char *name_loop_var[MAX_DIMS+1] = {"idvm00","idvm01","idvm02","idvm03", "idvm04","idvm05","idvm06","idvm07","idvm08","idvm09","idvm10","idvm11","idvm12","idvm13","idvm14","idvm15"}; -const char *name_bufIO[Ntp] = {"i000io","r000io", "d000io","c000io","l000io","dc00io","ch00io","i100io","i200io","i800io","l100io","l200io","l800io"}; -SgSymbol *rmbuf[Ntp]; -const char *name_rmbuf[Ntp] = {"i000bf","r000bf", "d000bf","c000bf","l000bf","dc00bf","ch00bf","i100bf","i200bf","i800bf","l100bf","l200bf","l800bf"}; -SgSymbol *dvmcommon, *dvmcommon_ch; -SgSymbol *heapcommon; -SgSymbol *redcommon; -SgSymbol *dbgcommon; -int lineno; // number of line in file -SgStatement *first_exec; // first executable statement in procedure -int nproc,ndis,nblock,ndim, nblock_all; -SgVariableSymb *mem_symb[Ntp]; -int mem_use[Ntp]; - -int lab; // current label -//SgExpression * size_array, *array_handle, *align_template; -//SgExpression * axis_array, *coeff_array, *const_array; -//SgExpression *rml; //remote-variable list of REMOTE_ACCESS directive - -int inasynchr; //set to 1 in the range of ASYNCHRONOUS -symb_list *dsym; //distributed array symbol list -group_name_list *grname; //shadow/reduction group name list -int v_print = 0; //set to 1 by -v flag -int warn_all = 0; //set to 1 by -w flag -int own_exe; -symb_list *redvar_list; -int pointer_in_tree; //set to 1 if there is a POINTER in alignment tree - //used by GenDistArray and GenAlignArray -symb_list *proc_symb;//processor array symbol list -symb_list *task_symb;//task array symbol list -symb_list * consistent_symb;// consistent array symbol list -symb_list *async_symb;// ASYNCID symbol list -symb_list *loc_templ_symb;// local TEMPLATE symbol list -symb_list *index_symb;// INDEX_DELTA variable list (code optimization) -int in_task_region;//set to 1 in the range of TASK_REGION -int task_ind; //current task index is storing in dvm000(task_ind) -int in_task; //set to 1 in the range of ON directive -SgSymbol *task_array;// current task array symbol pointer -SgLabel *task_lab; -SgStatement *task_do; -SgStatement * task_region_st; -fragment_list *cur_fragment = NULL; //current fragment number (used in debuging directives) -SgExpression *heap_ar_decl; -int is_heap_ref; -int heap_size; //calculated size of array HEAP(volume of memory for all pointer headers) -stmt_list * pref_st; //list of PREFETCH directive in procedure -int maxbuf = 5; //maximal number of remote group buffers for given array -int gen_block, mult_block; -SgExpression *async_id; -SgExpression *struct_component; -SgSymbol *file_var_s; -int nloopred; //counter of parallel loops with reduction group -int nloopcons; //counter of parallel loops with consistent group -stmt_list *wait_list; // list of REDUCTION_WAIT directives -int task_ps = 0; -int opt_base, opt_loop_range; //set on by compiler options (code optimization options) -SgExpression *sum_dvm = NULL; -int dvm_const_ref; -int unparse_functions; -int privateall = 0; - -extern SgStatement *parallel_dir; -extern int iacross; - -extern "C" int out_free_form; -extern "C" int out_upper_case; -extern "C" int out_line_unlimit; -extern "C" int out_line_length; -extern "C" PTR_SYMB last_file_symbol; - -Options options; - -// -//----------------------------------------------------------------------- -// FOR DEBUGGING -//#include "dump_info.C" -//----------------------------------------------------------------------- - -#if __SPF_BUILT_IN_FDVM -int convert_file(int argc, char* argv[], const char* proj_name) -#else -int main(int argc, char *argv[]) -#endif -{ - FILE *fout = NULL; - FILE *fout_cuf = NULL, *fout_C_cu = NULL, *fout_info = NULL; /*ACC*/ - const char *fout_name = NULL; - char *fout_name_cuf; /*ACC*/ - char *fout_name_C_cu; /*ACC*/ - char *fout_name_info_C; /*ACC*/ - -#ifndef __SPF_BUILT_IN_FDVM - const char *proj_name = "dvm.proj"; -#endif - char *source_name; - int level, hpf, openmp, isz, dvm_type_size; - int a_mode = 0; - - // initialisation - initialize(); - - openmp = hpf = 0; dvm_type_size = 0; - - argv++; - while ((argc > 1) && (*argv)[0] == '-') - { - if ((*argv)[1] == 'o' && ((*argv)[2] == '\0')) { - fout_name = argv[1]; - argv++; - argc--; - } - else if ((*argv)[1] == 'a' && ((*argv)[2] == '\0')) { - proj_name = argv[1]; - argv++; - argc--; - a_mode = 1; - } - else if (!strcmp(argv[0], "-dc")) - check_regim = 1; - else if (!strcmp(argv[0], "-dbif1")) - dbg_if_regim = 1; - else if (!strcmp(argv[0], "-dbif2")) - dbg_if_regim = 2; - else if (!strcmp(argv[0], "-speedL0")) /* for dedugging ACROSS-scheme */ - options.setOn(SPEED_TEST_L0); /*ACC*/ - else if (!strcmp(argv[0], "-speedL1")) /* for dedugging ACROSS-scheme */ - options.setOn(SPEED_TEST_L1); /*ACC*/ - else if (!strcmp(argv[0], "-dmpi")) - deb_mpi = 1; - else if (!strcmp(argv[0], "-dnoind")) - d_no_index = 1; - else if (!strcmp(argv[0], "-dperf")) { - debug_regim = 1; - omp_debug = DPERF; - } - else if (!strcmp(argv[0], "-dvmLoopAnalysisEC")) /*ACC*/ - { - options.setOn(LOOP_ANALYSIS); - options.setOn(OPT_EXP_COMP); - } - else if (!strcmp(argv[0], "-dvmIrregAnalysis")) /*ACC*/ - { - options.setOn(LOOP_ANALYSIS); - options.setOn(OPT_EXP_COMP); - options.setOn(GPU_IRR_ACC); - } - else if (!strcmp(argv[0], "-dvmLoopAnalysis")) /*ACC*/ - options.setOn(LOOP_ANALYSIS); - else if (!strcmp(argv[0], "-dvmPrivateAnalysis")) /*ACC*/ - options.setOn(PRIVATE_ANALYSIS); - else if ((*argv)[1] == 'd') { - switch ((*argv)[2]) { - case '0': level = 0; break; - case '1': level = 1; omp_debug = D1; /*OMP*/ break; - case '2': level = 2; omp_debug = D2; /*OMP*/ break; - case '3': level = 3; omp_debug = D3; /*OMP*/ break; - case '4': level = 4; omp_debug = D4; /*OMP*/ break; - case '5': level = 5; omp_debug = D5; /*OMP*/ break; - /* case '5': level = -1; many_files=1; break;*/ - default: level = -1; - } - if (level > 0) - debug_regim = 1; - if ((*argv)[3] == '\0') - AddToFragmentList(0, 0, level, -1); - else if ((*argv)[3] == ':') - FragmentList(*argv + 4, level, -1); - } - else if ((*argv)[1] == 'e') { - switch ((*argv)[2]) { - case '0': level = 0; break; - case '1': level = 1; break; - case '2': level = 2; break; - case '3': level = 3; break; - case '4': level = 4; break; - case 'm': omp_perf = 1; break; - default: level = -1; - } - if ((*argv)[3] == '\0') - AddToFragmentList(0, 0, -1, level); - else if ((*argv)[3] == ':') - FragmentList(*argv + 4, -1, level); - } - else if (!strcmp(argv[0], "-spf")) - { - (void)fprintf(stderr, "Illegal option -spf \n"); - return 1; - } - else if (!strcmp(argv[0], "-p")) { - only_debug = 0; hpf = 0; - } - else if (!strcmp(argv[0], "-s")) { - only_debug = 1; hpf = 0; - } - else if (!strcmp(argv[0], "-v")) - v_print = 1; - else if (!strcmp(argv[0], "-w")) - warn_all = 1; - else if (!strcmp(argv[0], "-bind0")) - bind_ = 0; - else if (!strcmp(argv[0], "-bind1")) - bind_ = 1; - else if (!strcmp(argv[0], "-t8")) - dvm_type_size = 8; - else if (!strcmp(argv[0], "-t4")) - dvm_type_size = 4; - else if (!strcmp(argv[0], "-r8")) - default_real_size = 8; - else if (!strcmp(argv[0], "-i8")) - default_integer_size = 8; - else if (!strcmp(argv[0], "-hpf") || !strcmp(argv[0], "-hpf1") || !strcmp(argv[0], "-hpf2")) - hpf = 1; - else if (!strcmp(argv[0], "-mp")) { - OMP_program = 1; /*OMP*/ - openmp = 1; - } - //else if (!strcmp(argv[0],"-ta")) - // ACC_program = 1; - else if (!strcmp(argv[0], "-noH")) - ACC_program = 0; - else if (!strcmp(argv[0], "-noCudaType")) /*ACC*/ - undefined_Tcuda = 1; - else if (!strcmp(argv[0], "-noCuda")) - options.setOn(NO_CUDA); /*ACC*/ - else if (!strcmp(argv[0], "-noPureFunc")) - options.setOn(NO_PURE_FUNC); /*ACC*/ - else if (!strcmp(argv[0], "-C_Cuda")) /*ACC*/ - options.setOn(C_CUDA); - else if (!strcmp(argv[0], "-FTN_Cuda") || !strcmp(argv[0], "-F_Cuda")) /*ACC*/ - options.setOff(C_CUDA); - else if (!strcmp(argv[0], "-no_blocks_info") || !strcmp(argv[0], "-noBI")) - options.setOn(NO_BL_INFO); /*ACC*/ - else if (!strcmp(argv[0], "-cacheIdx")) - options.setOff(NO_BL_INFO); /*ACC*/ - else if (!strcmp(argv[0], "-Ohost")) /*ACC*/ - options.setOn(O_HOST); - else if (!strcmp(argv[0], "-noOhost")) /*ACC*/ - options.setOff(O_HOST); - else if (!strcmp(argv[0], "-Opl2")) /*ACC*/ - { - parloop_by_handler = 2; - options.setOn(O_HOST); - options.setOn(O_PL2); - // options.setOn(NO_CUDA); - } - else if (!strcmp(argv[0], "-Opl")) /*ACC*/ - { - parloop_by_handler = 1; - options.setOn(O_PL); - } - else if (!strcmp(argv[0], "-oneThread")) /*ACC*/ - options.setOn(ONE_THREAD); - else if (!strcmp(argv[0], "-noTfm")) /*ACC*/ - options.setOff(AUTO_TFM); - else if (!strcmp(argv[0], "-autoTfm")) /*ACC*/ - options.setOn(AUTO_TFM); - else if (!strcmp(argv[0], "-gpuO0")) /*ACC*/ - options.setOn(GPU_O0); - else if (!strcmp(argv[0], "-gpuO1")) /*ACC*/ - options.setOn(GPU_O1); - else if (!strcmp(argv[0], "-rtc")) /*ACC*/ - options.setOn(RTC); //for NVRTC compilation and execution - else if (!strcmp(argv[0], "-ffo")) - out_free_form = 1; - else if (!strcmp(argv[0], "-upcase")) - out_upper_case = 1; - else if (!strcmp(argv[0], "-noLimitLine")) - out_line_unlimit = 1; - else if (!strcmp(argv[0], "-uniForm")) - { - out_free_form = 1; - out_line_length = 72; - } - else if (!strcmp(argv[0], "-noRemote")) - options.setOn(NO_REMOTE); - else if (!strcmp(argv[0], "-lgstd")) - { - (void)fprintf(stderr, "Illegal option -lgstd \n"); - return 1; - } - else if (!strcmp(argv[0], "-byFunUnparse")) - unparse_functions = 1; - else if (!strncmp(argv[0], "-bufio", 6)) { - if ((*argv)[6] != '\0' && (isz = is_integer_value(*argv + 6))) - IOBufSize = isz; - } - else if (!strncmp(argv[0], "-bufUnparser", 12)) { - if ((*argv)[12] != '\0' && (isz = is_integer_value(*argv + 12))) - UnparserBufSize = isz * 1024 * 1024; - } - else if (!strcmp(argv[0], "-bigPrivates")) /*ACC*/ - options.setOn(BIG_PRIVATES); - else if (!strcmp(argv[0], "-ioRTS")) - options.setOn(IO_RTS); - else if (!strcmp(argv[0], "-read_all")) - options.setOn(READ_ALL); - else if (!strcmp(argv[0], "-Obase")) - opt_base = 1; - else if (!strcmp(argv[0], "-Oloop_range")) - opt_loop_range = 1; - else if ((*argv)[1] == 'H') { - if ((*argv)[2] == 's' && (*argv)[3] == 'h' && (*argv)[4] == 'w') { - if ((*argv)[5] != '\0' && (all_sh_width = is_integer_value(*argv + 5))) - ; - } - else if (!strcmp(*argv + 2, "nora")) - no_rma = 1; - else if (!strcmp(*argv + 2, "oneq")) - one_inquiry = 1; - else if (!strcmp(*argv + 2, "onlyl")) - only_local = 1; - } - else if (!strncmp(argv[0], "-collapse", 9)) - if ((*argv)[9] != '\0' && (collapse_loop_count = is_integer_value(*argv + 9))); - argc--; - argv++; - } - - // Check options combinations - options.checkCombinations(); - - if (isHPFprogram(source_name = *argv)) { - HPF_program = 1; - hpf = 0; - } - if (hpf) - return 0; - - // definition of DvmType size: len_DvmType - // len_DvmType==0, if DvmType-size == default_integer_size == 4 - if (bind_ == 1) - len_DvmType = 8; //sizeof(long) == 8 - if (dvm_type_size) - len_DvmType = dvm_type_size; - if (len_DvmType == 0 && default_integer_size == 8) - len_DvmType = 4; - - if (ACC_program && debug_regim && !only_debug) - { - (void)fprintf(stderr, "Warning: -noH option is set to debug mode\n"); - ACC_program = 0; - } - if (parloop_by_handler>0 && debug_regim) - { - (void)fprintf(stderr, "Warning: -Opl/Opl2 option is ignored in debug mode\n"); - parloop_by_handler = 0; - options.setOff(O_PL); - options.setOff(O_PL2); - } - - if (openmp && ACC_program) - { - (void)fprintf(stderr, "Warning: -noH option is set to -mp mode\n"); - ACC_program = 0; - } - if (parloop_by_handler == 2 && !options.isOn(O_HOST)) - { - (void)fprintf(stderr, "Warning: -Ohost option is set to -Opl2 mode\n"); - options.setOn(O_HOST); - } - if(out_free_form == 1 && out_line_length == 72 && out_line_unlimit == 1) - { - (void)fprintf(stderr, "Warning: -noLimitLine and -uniForm options are incompatible; -noLimitLine option is ignored\n"); - out_line_unlimit = 0; - } - if (v_print) - (void)fprintf(stderr, "<<<<< Translating >>>>>\n"); - - //------------------------------------------------------------------------------ - - SgProject project(proj_name); - SgFile *file; - addNumberOfFileToAttribute(&project); - - //---------------------------- - ProjectStructure(project); - Private_Vars_Project_Analyzer(); - //---------------------------- - - initVariantNames(); //for project - initIntrinsicFunctionNames(); //for project - initSupportedVars(); // for project, acc_f2c.cpp - initF2C_FunctionCalls(); // for project, acc_f2c.cpp - for(int id=project.numberOfFiles()-1; id >= 0; id--) - { - file = &(project.file(id)); //file->unparsestdout(); - fin_name = new char[strlen(project.fileName(id))+2]; - sprintf(fin_name, "%s%s", project.fileName(id), " "); - //fin_name = strcat(project.fileName(0)," "); - // for call of function 'tpoint' - //added one symbol to input-file name - //printf("%s",fin_name); //!!! debug - if(!fout_name) - fout_name = doOutFileName(file->filename()); - else if (fout_name && source_name && !strcmp(source_name, fout_name)) - { - (void)fprintf(stderr, "Output file has the same name as source file\n"); - return 1; - } - - //printf("%s\n", fout_name);///!!! debug - fout_name_cuf = ChangeFtoCuf(fout_name); /*ACC*/ - fout_name_C_cu = ChangeFto_C_Cu(fout_name); /*ACC*/ - fout_name_info_C = ChangeFto_info_C(fout_name); /*ACC*/ - - //set the last symbol of file - last_file_symbol = file->filept->cur_symb; //for low_level.c and not only - initLibNames(); //for every file - InitDVM(file); //for every file - current_file = file; // global variable (used in SgTypeComplex) - max_lab = getLastLabelId(); - - if (dbg_if_regim) - GetLabel(); //set maxlabval=90000 - /* - printf("Labels:\n"); - printf("first:%d max: %d \n",firstLabel(file)->thelabel->stateno, getLastLabelId()); - for(int num=1; num<=getLastLabelId(); num++) - if(isLabel(num)) - printf("%d is label\n",num); - else - printf("%d isn't label\n",num); - - */ - - if (openmp) { /*OMP*/ - if (debug_regim > 0) /*OMP*/ - InstrumentForOpenMPDebug(file); /*OMP*/ - else /*OMP*/ - TranslateFileOpenMPDVM(file); /*OMP*/ - } - else - TranslateFileDVM(file); - /* DEBUG */ - /* {FILE *fout; fout = fopen("out.out","w"); file->unparse(fout);} */ - /* classifyStatements(file); - printf("**************************************************\n"); - printf("**** Expression Table ****************************\n"); - printf("**************************************************\n"); - classifyExpressions(file); - printf("**************************************************\n"); - printf("**** Symbol Table *******************************\n"); - printf("**************************************************\n"); - classifySymbols(file); - printf("**************************************************\n"); - */ - /* end DEBUG */ - - // file->unparsestdout(); - - if (err_cnt) { - (void)fprintf(stderr, "%d error(s)\n", err_cnt); - //!!! exit(1); - return 1; - } - //file->saveDepFile("dvm.dep"); - //DVMFileUnparse(file); - //file->saveDepFile("f.dep"); - - if (!fout_name) { //outfile is not specified, output result to stdout - file->unparsestdout(); - return 0; - } - - //writing result of converting into file - if ((fout = fopen(fout_name, "w")) == NULL) { - (void)fprintf(stderr, "Can't open file %s for write\n", fout_name); - return 1; - } - - if (GeneratedForCuda()) /*ACC*/ - { - if ((fout_C_cu = fopen(fout_name_C_cu, "w")) == NULL) { - (void)fprintf(stderr, "Can't open file %s for write\n", fout_name_C_cu); - return 1; - } - - if (!options.isOn(C_CUDA)) - { - if ((fout_cuf = fopen(fout_name_cuf, "w")) == NULL) { - (void)fprintf(stderr, "Can't open file %s for write\n", fout_name_cuf); - return 1; - } - } - - if ((fout_info = fopen(fout_name_info_C, "w")) == NULL) { - (void)fprintf(stderr, "Can't open file %s for write\n", fout_name_info_C); - return 1; - } - } - - - if (v_print) - (void)fprintf(stderr, "<<<<< Unparsing %s >>>>>\n", fout_name); - if (mod_gpu) /*ACC*/ - UnparseTo_CufAndCu_Files(file, fout_cuf, fout_C_cu, fout_info); - - if (unparse_functions) - UnparseFunctionsOfFile(file, fout); - else if (UnparserBufSize) - //UnparseProgram_ThroughAllocBuf(fout,file->filept,UnparserBufSize); - file->unparseS(fout, UnparserBufSize); - else - file->unparse(fout); - - if ((fclose(fout)) < 0) { - (void)fprintf(stderr, "Could not close %s\n", fout_name); - return 1; - } - - if (GeneratedForCuda()) /*ACC*/ - { - if ((fclose(fout_C_cu)) < 0) { - (void)fprintf(stderr, "Could not close %s\n", fout_name_C_cu); - return 1; - } - - if (!options.isOn(C_CUDA)) - { - if ((fclose(fout_cuf)) < 0) { - (void)fprintf(stderr, "Could not close %s\n", fout_name_cuf); - return 1; - } - } - - if ((fclose(fout_info)) < 0) { - (void)fprintf(stderr, "Could not close %s\n", fout_name_info_C); - return 1; - } - } - - fout_name = NULL; - } - - if (v_print) - (void)fprintf(stderr, "\n***** Done *****\n"); - return 0; -} - -void initialize() -{ - int i; - Dloop_No = 0; - nfrag = 0; //counter of intervals for performance analizer - St_frag = 0; - St_loop_first = 0; - St_loop_last = 0; - close_loop_interval = 0; - len_int = 0; - len_DvmType = 0; - if (sizeof(long) == 8) //default rule for bind, set by options -bind0,-bind1 - bind_ = 1; - else - bind_ = 0; - perf_analysis = 0; //set to 1 by -e1 - omp_perf = 0; //set to 1 by -emp - dvm_debug = 0; //set to 1 by -d1 or -d2 or -d3 or -d4 flag - only_debug = 0; //set to 1 by -s flag - level_debug = 0; //set to 1 by -d1, to 2 by -d2, ... - debug_fragment = NULL; - perf_fragment = NULL; - debug_regim = 0; - dbg_if_regim = 0; - check_regim = 0; //set by option -dc - deb_mpi = 0; //set by option -dmpi - d_no_index = 0; //set by option -dnoind - IOBufSize = SIZE_IO_BUF; - HPF_program = 0; - many_files = 1; /*29.06.01*/ - iacross = 0; //for HPF_program - irg = 0; //for HPF_program - redgref = NULL; //for HPF_program - idebrg = 0; //for HPF_program - iconsg = 0; - consgref = NULL; - idebcg = 0; - all_sh_width = no_rma = one_inquiry = only_local = 0; - opt_base = 0; - opt_loop_range = 0; - in_interface = 0; - out_free_form = 0; - out_upper_case = 0; - out_line_unlimit = 0; - out_line_length = 132; - default_integer_size = 4; - default_real_size = 4; - unparse_functions = 0; //set to 1 by option -byFunUnparse - for (i = 0; i < Ndev; i++) /*ACC*/ - device_flag[i] = 0; // set by option and by TARGETS clause of REGION directive - ACC_program = 1; /*ACC*/ - region_debug = 0; /*ACC*/ - region_compare = 0; /*ACC*/ - undefined_Tcuda = 0; /*ACC*/ - options.setOn(C_CUDA); /*ACC*/ - options.setOn(NO_BL_INFO); /*ACC*/ - options.setOn(O_HOST); /*ACC*/ - parloop_by_handler = 0; /*ACC*/ - collapse_loop_count = 0; /*ACC*/ - cuda_functions = 0; /*ACC*/ - err_cnt = 0; -} - -SgSymbol *LastSymbolOfFile(SgFile *f) -{ SgSymbol *s; - s = f->firstSymbol(); - while(s->next()) - s = s->next(); - - return s; -} - -char *doOutFileName(const char *fdeb_name) -{ - char *name; - int i; - - name = (char *)malloc((unsigned)(strlen(fdeb_name) + 5 + 2 + 1)); - strcpy(name, fdeb_name); - for (i = strlen(name) - 1; i >= 0; i--) - { - if (name[i] == '.') - break; - } - strcpy(name + i, ".DVMH.f"); - return(name); -} - -int isHPFprogram(char *filename) -{ - int i; - - if (!filename) - return (0); - - for (i = strlen(filename)-1 ; i >= 0 ; i --) - { - if ( filename[i] == '.' ) - break; - } - - //if (i>=0 && !strcmp(&(filename[i+1]),"hpf")) - if(i>=0 && (filename[i+1] == 'h' || filename[i+1] =='H') && (filename[i+2] == 'p' || filename[i+2] =='P') && (filename[i+3] == 'f' || filename[i+3] =='F')) - return(1); - else - return(0); -} - -void initVariantNames(){ - for(int i = 0; i < MAXTAGS; i++) tag[i] = NULL; -/*!!!*/ -#include "tag.h" -} - -void initLibNames(){ - for(int i = 0; i < MAX_LIBFUN_NUM; i++) { - fdvm[i] = NULL; - name_dvm[i] = NULL; - } -#include "libdvm.h" -} - -void initMask(){ - for(int i = 0; i < MAX_LIBFUN_NUM; i++) { - fmask[i] = 0; - } -} - -void InitDVM( SgFile *f) { - SgStatement *fst; - int i; - fst = f->firstStatement(); //fst -> File header - // Initialize COMMON names - dvmcommon = new SgSymbol(VARIABLE_NAME,"mem000",*fst);//DEFAULT variant is right for COMMON - //but Sage don't want to create such symbol - dvmcommon_ch = new SgSymbol(VARIABLE_NAME,"mch000",*fst); - heapcommon = new SgSymbol(VARIABLE_NAME,"heap00",*fst); - dbgcommon = new SgSymbol(VARIABLE_NAME,"dbg000",*fst); - -// Initialize the functions symbols (for LibDVM functions) - for (i=0; name_dvm[i] && ifirstType(); t; t=t->next()) - if(t->variant()==T_COMPLEX) - return(t); - - return(new SgType(T_COMPLEX)); -} - -SgType * SgTypeDoubleComplex(SgFile *f) -{ - SgType *t; - for(t=f->firstType(); t; t=t->next()) - if(t->variant()==T_DCOMPLEX) - return(t); - - return(new SgType(T_DCOMPLEX)); -} - -int MemoryUse() -{ - int i; - for(i=0; i addRange(*M00); - Rmem = mem_symb[Real] = new SgVariableSymb("r0000m", *typearray, *func); - //Rmem-> declareTheSymbol(*func); - typearray = new SgArrayType(*SgTypeDouble()); - typearray-> addRange(*M00); - Dmem = mem_symb[Double] = new SgVariableSymb("d0000m", *typearray, *func); - //Dmem-> declareTheSymbol(*func); - typearray = new SgArrayType(*SgTypeInt()); - typearray-> addRange(*M00); - Imem = mem_symb[Integer] = new SgVariableSymb("i0000m", *typearray, *func); - //Imem-> declareTheSymbol(*func); - typearray = new SgArrayType(*SgTypeBool()); - typearray-> addRange(*M00); - Lmem = mem_symb[Logical] = new SgVariableSymb("l0000m", *typearray, *func); - //Lmem-> declareTheSymbol(*func); -//!!!!!!! - typearray = new SgArrayType(* SgTypeComplex(current_file)); - typearray-> addRange(*M00); - Cmem = mem_symb[Complex] = new SgVariableSymb("c0000m", *typearray, *func); - typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); - typearray-> addRange(*M00); - DCmem = mem_symb[DComplex] = new SgVariableSymb("dc000m", *typearray, *func); - typearray = new SgArrayType(*SgTypeChar()); - typearray-> addRange(*M00); - Chmem = mem_symb[Character] = new SgVariableSymb("ch000m", *typearray, *func); -//--------- - le= new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(1)); - SgType *tint1 = new SgType(T_INT, le, NULL); - le= new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(2)); - SgType *tint2 = new SgType(T_INT, le, NULL); - le= new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - SgType *tint8 = new SgType(T_INT, le, NULL); -//---------- - typearray = new SgArrayType(*tint1); - typearray-> addRange(*M00); - mem_symb[Integer_1] = new SgVariableSymb("i000m1", *typearray, *func); - typearray = new SgArrayType(*tint2); - typearray-> addRange(*M00); - mem_symb[Integer_2] = new SgVariableSymb("i000m2", *typearray, *func); - typearray = new SgArrayType(*tint8); - typearray-> addRange(*M00); - mem_symb[Integer_8] = new SgVariableSymb("i000m8", *typearray, *func); -//--------- - le= new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(1)); - SgType *tlog1 = new SgType(T_BOOL, le, NULL); - le= new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(2)); - SgType *tlog2 = new SgType(T_BOOL, le, NULL); - le= new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - SgType *tlog8 = new SgType(T_BOOL, le, NULL); -//---------- - typearray = new SgArrayType(*tlog1); - typearray-> addRange(*M00); - mem_symb[Logical_1] = new SgVariableSymb("l000m1", *typearray, *func); - typearray = new SgArrayType(*tlog2); - typearray-> addRange(*M00); - mem_symb[Logical_2] = new SgVariableSymb("l000m2", *typearray, *func); - typearray = new SgArrayType(*tlog8); - typearray-> addRange(*M00); - mem_symb[Logical_8] = new SgVariableSymb("l000m8", *typearray, *func); - - for(i=0; i<8; i++) - loop_var[i] = new SgVariableSymb(name_loop_var[i], *SgTypeInt(), *func); - - MS = new SgValueExp(IOBufSize); - typearray = new SgArrayType(*SgTypeInt()); - typearray-> addRange(*MS); - bufIO[Integer] = new SgVariableSymb(name_bufIO[Integer], *typearray, *func); - typearray = new SgArrayType(*SgTypeFloat()); - typearray-> addRange(*MS); - bufIO[Real] = new SgVariableSymb(name_bufIO[Real], *typearray, *func); - typearray = new SgArrayType(*SgTypeDouble()); - typearray-> addRange(*MS); - bufIO[Double] = new SgVariableSymb(name_bufIO[Double], *typearray, *func); - typearray = new SgArrayType(* SgTypeComplex(current_file)); - typearray-> addRange(*MS); - bufIO[Complex] = new SgVariableSymb(name_bufIO[Complex], *typearray, *func); - typearray = new SgArrayType(*SgTypeBool()); - typearray-> addRange(*MS); - bufIO[Logical] = new SgVariableSymb(name_bufIO[Logical], *typearray, *func); - typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); - typearray-> addRange(*MS); - bufIO[DComplex] = new SgVariableSymb(name_bufIO[DComplex], *typearray, *func); - typearray = new SgArrayType(* new SgType(T_STRING)); - typearray-> addRange(*MS); - bufIO[Character] = new SgVariableSymb(name_bufIO[Character], *typearray, *func); - typearray = new SgArrayType(*tint1); - typearray-> addRange(*MS); - bufIO[Integer_1] = new SgVariableSymb(name_bufIO[Integer_1], *typearray, *func); - typearray = new SgArrayType(*tint2); - typearray-> addRange(*MS); - bufIO[Integer_2] = new SgVariableSymb(name_bufIO[Integer_2], *typearray, *func); - typearray = new SgArrayType(*tint8); - typearray-> addRange(*MS); - bufIO[Integer_8] = new SgVariableSymb(name_bufIO[Integer_8], *typearray, *func); - typearray = new SgArrayType(*tlog1); - typearray-> addRange(*MS); - bufIO[Logical_1] = new SgVariableSymb(name_bufIO[Logical_1], *typearray, *func); - typearray = new SgArrayType(*tlog2); - typearray-> addRange(*MS); - bufIO[Logical_2] = new SgVariableSymb(name_bufIO[Logical_2], *typearray, *func); - typearray = new SgArrayType(*tlog8); - typearray-> addRange(*MS); - bufIO[Logical_8] = new SgVariableSymb(name_bufIO[Logical_8], *typearray, *func); - - typearray = new SgArrayType(*SgTypeInt()); - rmbuf[Integer] = new SgVariableSymb(name_rmbuf[Integer], *typearray, *func); - typearray = new SgArrayType(*SgTypeFloat()); - rmbuf[Real] = new SgVariableSymb(name_rmbuf[Real], *typearray, *func); - typearray = new SgArrayType(*SgTypeDouble()); - rmbuf[Double] = new SgVariableSymb(name_rmbuf[Double], *typearray, *func); - typearray = new SgArrayType(* SgTypeComplex(current_file)); - rmbuf[Complex] = new SgVariableSymb(name_rmbuf[Complex], *typearray, *func); - typearray = new SgArrayType(*SgTypeBool()); - rmbuf[Logical] = new SgVariableSymb(name_rmbuf[Logical], *typearray, *func); - typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); - rmbuf[DComplex] = new SgVariableSymb(name_rmbuf[DComplex], *typearray, *func); - typearray = new SgArrayType(* new SgType(T_STRING)); - rmbuf[Character] = new SgVariableSymb(name_rmbuf[Character], *typearray, *func); - typearray = new SgArrayType(*tint1); - rmbuf[Integer_1] = new SgVariableSymb(name_rmbuf[Integer_1], *typearray, *func); - typearray = new SgArrayType(*tint2); - rmbuf[Integer_2] = new SgVariableSymb(name_rmbuf[Integer_2], *typearray, *func); - typearray = new SgArrayType(*tint8); - rmbuf[Integer_8] = new SgVariableSymb(name_rmbuf[Integer_8], *typearray, *func); - typearray = new SgArrayType(*tlog1); - rmbuf[Logical_1] = new SgVariableSymb(name_rmbuf[Logical_1], *typearray, *func); - typearray = new SgArrayType(*tlog2); - rmbuf[Logical_2] = new SgVariableSymb(name_rmbuf[Logical_2], *typearray, *func); - typearray = new SgArrayType(*tlog8); - rmbuf[Logical_8] = new SgVariableSymb(name_rmbuf[Logical_8], *typearray, *func); - - typearray = new SgArrayType(*SgTypeInt()); - heapdvm = new SgVariableSymb("heap00", *typearray, *func); - - Pipe = new SgVariableSymb("pipe00", *SgTypeDouble(), *func); - - return; -} - -char* FileNameVar(int i) -{ char *name; - name = new char[80]; - sprintf(name,"%s%d","filenm00",i); - return(name); -} - -char* RedGroupVarName(SgSymbol *gr) -{ char *name; - name = new char[80]; - sprintf(name,"%s%s",gr->identifier(),"00"); - return(name); -} - -char* ModuleProcName(SgSymbol *smod) -{ char *name; - name = new char[80]; - sprintf(name,"dvm_%s",smod->identifier()); - return(name); -} - -SgSymbol* BaseSymbol(SgSymbol *ar) -{ char *name; - SgSymbol *sbs, *base; - SgArrayType *typearray; - SgValueExp M0(0), MB(64); - SgExpression *M00 = new SgExpression(DDOT,&M0.copy(),&MB.copy(),NULL); - name = new char[80]; - base = baseMemory(ar->type()->baseType()); - //strncpy(name,base->identifier(),5); - //strcat (name,ar->identifier()); - sprintf(name,"%.4s_%s",base->identifier(),ar->identifier()); - typearray = new SgArrayType(*ar->type()->baseType()); - typearray-> addRange(*M00); - sbs = new SgVariableSymb(name, *typearray, *cur_func); - return(sbs); -} - -SgSymbol* IndexSymbol(SgSymbol *si) -{ char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name,"%s__d",si->identifier()); - sn = new SgVariableSymb(name, *si->type(), *cur_func); - return(sn); -} - -SgSymbol* InitLoopSymbol(SgSymbol *si,SgType *t) -{ char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name,"%s__init",si->identifier()); - sn = new SgVariableSymb(name, *t, *cur_func); - return(sn); -} - -SgSymbol* DerivedTypeBaseSymbol(SgSymbol *stype,SgType *t) -{ - char *name; - SgSymbol *sn; - SgArrayType *typearray; - SgValueExp M0(0), MB(64); - SgExpression *M00 = new SgExpression(DDOT,&M0.copy(),&MB.copy(),NULL); - name = new char[80]; - sprintf(name,"%s0000m",stype->identifier()); - typearray = new SgArrayType(*t); - typearray-> addRange(*M00); - sn = new SgVariableSymb(name, *typearray, *cur_func); - return(sn); -} - -SgSymbol* CommonSymbol(SgSymbol *stype) -{ char *name; - name = new char[80]; - sprintf(name,"mem000%s",stype->identifier()); - return(new SgSymbol(VARIABLE_NAME,name,*cur_func->controlParent())); -} - -SgSymbol *CheckSummaSymbol() -{ - return(new SgVariableSymb("check_sum00",*SgTypeDouble(),*cur_func)); -} - -SgSymbol *DebugGoToSymbol(SgType *t) -{char *name; - SgSymbol *sn; - name = new char[80]; - sprintf(name,"dbv_goto00%d",++nifvar); - sn = new SgVariableSymb(name,*t,*cur_func); - if_goto = AddToSymbList(if_goto, sn); - return(sn); -} - - -SgSymbol *TaskAMVSymbol(SgSymbol *s) -{ char *name; - name = (char *) malloc((unsigned)(strlen(s->identifier())+5)); - sprintf(name,"%s_amv",s->identifier()); - return(new SgSymbol(VARIABLE_NAME,name,*cur_func)); -} - -SgSymbol *TaskIndSymbol(SgSymbol *s) -{ char *name; - name = (char *) malloc((unsigned)(strlen(s->identifier())+3)); - sprintf(name,"i_%s",s->identifier()); - return(new SgVariableSymb(name,*SgTypeInt(),*cur_func)); -} - -SgSymbol *TaskRenumArraySymbol(SgSymbol *s) -{ char *name; - name = (char *) malloc((unsigned)(strlen(s->identifier())+7)); - sprintf(name,"renum_%s",s->identifier()); - return(new SgVariableSymb(name,*(s->type()),*cur_func)); -} - -SgSymbol *TaskLPsArraySymbol(SgSymbol *s) -{ char *name; - name = (char *) malloc((unsigned)(strlen(s->identifier())+5)); - sprintf(name,"lps_%s",s->identifier()); - return(new SgVariableSymb(name,*(s->type()),*cur_func)); -} - -SgSymbol *TaskHPsArraySymbol(SgSymbol *s) -{ char *name; - name = (char *) malloc((unsigned)(strlen(s->identifier())+5)); - sprintf(name,"hps_%s",s->identifier()); - return(new SgVariableSymb(name,*(s->type()),*cur_func)); -} - -SgSymbol * CreateRegistrationArraySymbol() -{ - SgSymbol *sn; - SgArrayType *typearray; - char *ident = cur_func->symbol()->identifier(); //Module identifier - char *name = new char[10+strlen(ident)]; - sprintf(name,"deb_%s_dvm",ident); - typearray = new SgArrayType(*SgTypeInt()); - sn = new SgVariableSymb(name, *typearray, *cur_func); - return(sn); -} - -void CreateCoeffs(coeffs* scoef,SgSymbol *ar) -{int i,r,i0; - char *name; - r=Rank(ar); - i0 = opt_base ? 1 : 2; - if(opt_loop_range) i0=0; - for(i=i0;i<=r+2;i++){ - name = new char[strlen(ar->identifier()) + 6]; - sprintf(name,"%s%s%d", ar->identifier(),"000",i); - scoef->sc[i] = new SgVariableSymb(name, *SgTypeInt(), *cur_func); - //printf("%s",(scoef->sc[i])->identifier()); - } - scoef->use = 0; - if(IN_MODULE && !IS_TEMPLATE(ar)) - scoef->use = 1; -} - -SgSymbol *CreateConsistentHeaderSymb(SgSymbol *ar) -{ - char *name; - name = new char[80]; - SgArrayType *typearray; - //SgValueExp M1(1); - name = new char[80]; - sprintf(name,"%s%s",ar->identifier(),"000"); - typearray = new SgArrayType(*SgTypeInt()); - //typearray-> addRange(M1); - return( new SgVariableSymb(name, *typearray, *cur_func)); -} - -SgSymbol *IOstatSymbol() -{ - if(!IOstat) - IOstat = new SgSymbol(VARIABLE_NAME, "iostat_dvm", *SgTypeInt(), *cur_func); - return (IOstat); -} - -SgStatement *doPublicStmtForDvmModuleProcedure(SgSymbol *smod) -{ - mod_attr *attrm; - SgStatement *st = NULL; - - if((attrm=DVM_PROC_IN_MODULE(smod)) && attrm->symb){ - st = new SgStatement(PUBLIC_STMT); - st->setExpression(0, *new SgExprListExp(*new SgVarRefExp(*attrm->symb))); - } - return (st); -} - -void DeclareVariableWithInitialization (SgSymbol *sym, SgType *type, SgStatement *lstat) -{ - if(!sym) return; - SgStatement *decl_st = sym->makeVarDeclStmt(); - SgExpression *eeq = DVMVarInitialization(decl_st->expr(0)->lhs()); - decl_st->expr(0)->setLhs(eeq); - if (type) - decl_st->expr(1)->setType(type); - decl_st->setVariant(VAR_DECL_90); - lstat -> insertStmtAfter(*decl_st); -} - -void DeclareVarDVM(SgStatement *lstat, SgStatement *lstat2) -{ -//lstat is not equal lstat2 only for MODULE: -//lstat2 is header of generated module procedure dvm_ -//some generated specification statements are inserted in specification part -//of module and other are inserted in module procedure - - SgArrayType *typearray; - SgStatement *equiv, *st,*st1,*com, *st_next; - SgExpression *em[Ntp], *eeq, *ed; - SgValueExp c1(1),c0(0); - SgExprListExp *el, *eel; - int i=0; - int j; - SgType *tlen = NULL; - if(len_DvmType) { - SgExpression *le; - le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(len_DvmType)); - tlen = new SgType(T_INT, le, SgTypeInt()); - } - - st_next = lstat->lexNext(); - - if(in_interface) goto HEADERS_; //only array header declaration is created in interface body of interface block - - // create DATA statement for SAVE groups: DATA gref(1)/0/ gred/0/... - if(grname && !IN_MODULE) { //group name list is not empty - group_name_list *sl; - char *data_str= new char[4000]; - int i =0; - sprintf(data_str,"data "); - for(sl=grname; sl; sl=sl->next) - if(IS_SAVE(sl->symb)) { - i++; - if (sl->symb->variant() == REF_GROUP_NAME){ - strcat(data_str,sl->symb->identifier()); - strcat(data_str,"(1)/0/ "); - } else { - strcat(data_str,sl->symb->identifier()); - strcat(data_str,"/0/ "); - } - } - if(i) { - st = new SgStatement(DATA_DECL);// creates DATA statement - SgExpression *es = new SgExpression(STMT_STR); - NODE_STR(es->thellnd) = data_str; //e->thellnd->entry.string_val = data_str; - st -> setExpression(0,*es); - lstat -> insertStmtAfter(*st); - } - } - - - // inserting in main program SAVE statement (without list): for OpenMP translation - if(IN_MAIN_PROGRAM && !saveall) - lstat -> insertStmtAfter(*new SgStatement(SAVE_DECL)); - - if (!only_debug) { - // declare array bases for DVM-arrays - if(opt_base && !HPF_program && dsym) { - symb_list *sl; - coeffs *c; - for(sl=dsym; sl; sl=sl->next) { - if(IS_TEMPLATE(sl->symb)) - continue; - c = ((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); - if(!c->use) - continue; - st = (*ARRAY_BASE_SYMBOL(sl->symb))->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - } - - // create DATA statement for SAVE array headers: DATA a(1)/0/ b(1)/0/... - if(dsym && !IN_MODULE) { //distributed objects list is not empty - symb_list *sl; - char *data_str= new char[4000]; - int i =0; - sprintf(data_str,"data "); - for(sl=dsym; sl; sl=sl->next) { - if(IS_SAVE(sl->symb)) { - i++; - /* if (i==5) { - strcat(data_str, "\n + "); - i=1; - } - */ - strcat(data_str,sl->symb->identifier()); - strcat(data_str,"(1)/0/ "); - // sprintf(data_str, "%s%s(1)/0/",data_str,sl->symb->identifier()); - } - } - // strcat(data_str,"\n"); - if(i) { - st = new SgStatement(DATA_DECL);// creates DATA statement - SgExpression *es = new SgExpression(STMT_STR); - // e = new SgValueExp(data_str); - // NODE_STR(es->thellnd) = NODE_STR(e->thellnd); - NODE_STR(es->thellnd) = data_str; //e->thellnd->entry.string_val = data_str; - st -> setExpression(0,*es); - lstat -> insertStmtAfter(*st); - } - } - - // declaring DVM do-variables - for(j=0; j declareTheSymbol(*func); - st = loop_var[j] ->makeVarDeclStmt(); - - lstat2 -> insertStmtAfter(*st); - } - - // declaring DVM memory variables - st1 = lstat2->lexNext(); - - if(MemoryUse()) - //if (mem_use[Integer] || mem_use[Real] || mem_use[Double] || mem_use[Complex] || mem_use[Logical] || mem_use[DComplex] || mem_use[Character]) - mem_use[Integer] = mem_use[Double] = 1; //DVM-COMMON-blocks must have the same length - else - if(IN_MAIN_PROGRAM) - mem_use[Integer] = mem_use[Double] = 1; //in MAIN-program DVM-COMMON must be always - - for(j=0,i=0; jmakeVarDeclStmt(); - lstat2 -> insertStmtAfter(*st); - em[j] = new SgArrayRefExp(*mem_symb[j]); - i++; - } - - if(i>1) { - // generating EQUIVALENCE statement - // EQUIVALENCE (Imem(0), Rmem(0),...,Lmem(0)) - - j=0; - while (!mem_use[j]) - j++; - el = new SgExprListExp(*em[j]); - for(j=j+1; jappend(*em[j]); - eel = new SgExprListExp(*em[j]); - eel->setRhs(*el); - el = eel; - } - } - eeq = new SgExpression (EQUI_LIST); - eeq -> setLhs(*el); - equiv = new SgStatement(EQUI_STAT); - equiv->setExpression(0,*eeq); - st1->insertStmtBefore(*equiv); - } - - // declaring DVM memory variable of type CHARACTER in MAIN-program - // in MAIN-program DVM-COMMON must be always declared character array ch000m(0:1) - if(IN_MAIN_PROGRAM && !mem_use[Character]) { - st = Chmem ->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - - - // declaring COMMON block for DVM memory variables - if(i) { - el = new SgExprListExp(* new SgArrayRefExp(*Imem)); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*dvmcommon); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - st1->insertStmtBefore(*com); - } -/* if(mem_use[Character]) { - el = new SgExprListExp(* new SgArrayRefExp(*Chmem)); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*dvmcommon_ch); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - st1->insertStmtBefore(*com); - } -*/ - // declaring DVM memory variable of derived type - if(mem_use_structure){ - base_list *el; - SgExpression *e; - for(el=mem_use_structure;el;el=el->next) { - st = el->base_symbol ->makeVarDeclStmt(); - lstat2 -> insertStmtAfter(*st); - - // declaring COMMON block for DVM memory variables of derived type - - e = new SgExprListExp(* new SgArrayRefExp(*el->base_symbol)); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*CommonSymbol(el->type_symbol)); - eeq -> setLhs(*e); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - st1->insertStmtBefore(*com); - } - } - - - // declaring buffer variables for remote access - for(i=0; itype()); - typearray-> addRange(* new SgValueExp(rmbuf_size[i])); - //rmbuf[i]-> declareTheSymbol(*func); - st = rmbuf[i] ->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - - // declaring DVM buffer variables for Input/Output - st1 = lstat->lexNext(); - i=0; - for (j=0; j declareTheSymbol(*func); - st = bufIO[j] ->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - em[j] = new SgArrayRefExp(*bufIO[j]); - i++; - } - - if(i && !buf_use[0]) { //declare integer I/O buffer always - buf_use[0] = 1; - st = bufIO[0] ->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - em[0] = new SgArrayRefExp(*bufIO[0]); - i++; - } - - if(i>1) { - // generating EQUIVALENCE statement - // EQUIVALENCE (i000io(1), r000io(1),...,l000io(1)) - // bufIO[0] bufIO[1] bufIO[4] - j=0; - while (!buf_use[j]) - j++; - el = new SgExprListExp(*em[j]); - for(j=j+1; jsetRhs(*el); - el = eel; - // el->append(*em[j]); - } - } - eeq = new SgExpression (EQUI_LIST); - eeq -> setLhs(*el); - equiv = new SgStatement(EQUI_STAT); - equiv->setExpression(0,*eeq); - st1->insertStmtBefore(*equiv); - } - -// declaring buffer HEAP for headers of dynamic arrays - if(heap_ar_decl && heap_size){ - typearray = isSgArrayType(heapdvm->type()); - typearray-> addRange(* new SgValueExp(heap_size)); - st = heapdvm ->makeVarDeclStmt(); - //st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - //heap_ar_decl->setLhs(new SgExprListExp(new SgValueExp(heap_size))); - //(heap_ar_decl->lhs())->setRhs(NULL); - //st -> setExpression(0,*new SgExprListExp(*heap_ar_decl)); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat -> insertStmtAfter(*st); -// declaring COMMON block for headers of dynamic arrays - el = new SgExprListExp(* new SgArrayRefExp(*heapdvm)); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*heapcommon); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - lstat->insertStmtAfter(*com); - } -// declaring SAVE variables for SAVE-arrays used in REGION - DeclareDataRegionSaveVariables(lstat, tlen); /*ACC*/ - -} //endif !only_debug - -// declaring dvm-procedure for module as public - if(IN_MODULE && privateall && (st=doPublicStmtForDvmModuleProcedure(cur_func->symbol()))) - lstat->insertStmtAfter(*st); - -// declaring variable for new IOSTAT specifier of Input/Output statement (if END=,ERR=,EOR= are replaced with IOSTAT=) - if(IOstat) - { - st = IOstat ->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - -// declare mask for registration (only in module) - if(debug_regim && count_reg ) { - typearray = isSgArrayType(registration_array->type()); - typearray-> addRange(* new SgValueExp(count_reg)); - st = registration_array ->makeVarDeclStmt(); - eeq = DVMVarInitialization(st->expr(0)->lhs()); - st->expr(0)->setLhs(eeq); - if(len_DvmType) - st->expr(1)->setType(tlen); - st->setVariant(VAR_DECL_90); - lstat -> insertStmtAfter(*st); - } - -// generate PARAMETER statement - - if(dvm_const_ref == 1) { - st= new SgStatement(PARAM_DECL); - el = NULL; - for(j=0; j<10; j++) { - eel = new SgExprListExp(* new SgRefExp(CONST_REF, *Iconst[j])); - eel->setRhs(el); - el = eel; - } - st->setExpression(0,*el); - lstat2 -> insertStmtAfter(*st); - -// declare constants as INTEGER - st = fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - - for(j=0; j<10; j++) { - eel = new SgExprListExp(* new SgVarRefExp(Iconst[j])); - eel->setRhs(el); - el = eel; - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat2 -> insertStmtAfter(*st); - } - -// declare group names as INTEGER - if(grname) { - group_name_list *sl; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=grname; sl; sl=sl->next) { - if (sl->symb->variant() == REF_GROUP_NAME) - eeq = new SgArrayRefExp(*(sl->symb),*new SgValueExp(3)); - else - eeq = new SgVarRefExp(*(sl->symb)); - if(IN_MODULE) - eeq = DVMVarInitialization(eeq); - eel = new SgExprListExp(* eeq); - eel->setRhs(el); - el = eel; - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - if(IN_MODULE) - st->setVariant(VAR_DECL_90); - lstat -> insertStmtAfter(*st); - - -// declare common blocks for remote references groups - for(sl=grname; sl; sl=sl->next) - if (sl->symb->variant() == REF_GROUP_NAME) { - el = new SgExprListExp(* new SgArrayRefExp(*(sl->symb))); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*(sl->symb)); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - st->insertStmtAfter(*com); - } - -// declare variables for reduction groups and consistent groups - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=grname; sl; sl=sl->next) { - if (sl->symb->variant() == REDUCTION_GROUP_NAME || sl->symb->variant() == CONSISTENT_GROUP_NAME) { - SgSymbol *rgv; - int nl; - nl = sl->symb->variant() == REDUCTION_GROUP_NAME ? nloopred : nloopcons; - rgv = * ((SgSymbol **) (sl->symb)-> attributeValue(0,RED_GROUP_VAR)); - ed = new SgExpression(DDOT,new SgValueExp(0),new SgValueExp(nl),NULL); - eeq = new SgArrayRefExp(*rgv,*ed); - if(IN_MODULE) - eeq = DVMVarInitialization(eeq); - //eeq = new SgArrayRefExp(*rgv,*new SgValueExp(nloopred)); - eel = new SgExprListExp(* eeq); - eel->setRhs(el); - el = eel; - } - } - if(el) { - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - if(IN_MODULE) - st->setVariant(VAR_DECL_90); - lstat -> insertStmtAfter(*st); - } -} -// declare common block for reduction variables - if(redvar_list && !only_debug) { - symb_list *sl; - char * ncom = new char[100]; - char * f_name; - el = NULL; - redvar_list = SortingBySize(redvar_list); - for(sl=redvar_list; sl; sl=sl->next) - if (CURRENT_SCOPE(sl->symb) && !IS_ARRAY(sl->symb) && !IN_COMMON(sl->symb) && !IN_DATA(sl->symb) && !IS_DUMMY(sl->symb) && !IS_SAVE(sl->symb) && !IN_EQUIVALENCE(sl->symb) && strcmp(sl->symb->identifier(),cur_func->symbol()->identifier()) && (cur_func->expr(0) ? sl->symb != cur_func->expr(0)->symbol() : 1)) { - eel = new SgExprListExp(* new SgVarRefExp(*(sl->symb))); - el = (SgExprListExp*) AddListToList(el,eel); - } - if (el){ - f_name = cur_func->symbol()->identifier(); - if(f_name[0]=='_') //main program unit without name: sage-name == _MAIN - f_name=f_name+1; - sprintf(ncom,"%s%s", f_name,"dvm"); - st = cur_func->symbol()->scope(); - redcommon = new SgSymbol(VARIABLE_NAME,ncom,*st); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*redcommon); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - lstat->insertStmtAfter(*com); - } - } - -// declare processor array names as INTEGER - if(proc_symb) { - symb_list *sl; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=proc_symb; sl; sl=sl->next) { - eel = new SgExprListExp(* new SgVarRefExp(*(sl->symb))); - eel->setRhs(el); - el = eel; - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat -> insertStmtAfter(*st); - } - -// declare index variables (optimization code) - if(index_symb) { - symb_list *sl; - for(sl=index_symb; sl; sl=sl->next) { - st = sl->symb->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - } - -// declare task arrays as INTEGER - if(task_symb){ - symb_list *sl; - SgArrayType *artype; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=task_symb; sl; sl=sl->next) { - artype = isSgArrayType(sl->symb->type()); - eel = new SgExprListExp(* new SgArrayRefExp(*(sl->symb),*new SgValueExp(2),*artype->sizeInDim(0))); - eel->setRhs(el); - el = eel; - eel = new SgExprListExp(*new SgVarRefExp(TASK_SYMBOL(sl->symb))); // symbol for TASK AMview - eel->setRhs(el); - el = eel; - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat -> insertStmtAfter(*st); - //SgSymbol *s= TASK_IND_VAR(task_symb->symb); - st = fdvm[0]->makeVarDeclStmt(); - el = NULL; - for(sl=task_symb; sl; sl=sl->next) { - artype = isSgArrayType(sl->symb->type()); - eel = new SgExprListExp(* new SgArrayRefExp(*TASK_RENUM_ARRAY(sl->symb),*artype->sizeInDim(0))); - eel->setRhs(el); - el = eel; - if(TASK_AUTO(sl->symb)) - { - eel = new SgExprListExp(* new SgArrayRefExp(*TASK_HPS_ARRAY(sl->symb),*artype->sizeInDim(0))); - eel->setRhs(el); - el = eel; - eel = new SgExprListExp(* new SgArrayRefExp(*TASK_LPS_ARRAY(sl->symb),*artype->sizeInDim(0))); - eel->setRhs(el); - el = eel; - } - //eel = new SgExprListExp(*new SgVarRefExp(TASK_IND_VAR(sl->symb))); // symbol for TASK index variable - //eel->setRhs(el); - //el = eel; - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat -> insertStmtAfter(*st); - - } - -// declare ASYNCID as INTEGER - if(async_symb){ - symb_list *sl; - SgArrayType *artype; - //SgArrayRefExp *ae; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=async_symb; sl; sl=sl->next) { - //eel = new SgExprListExp(* new SgArrayRefExp(*(sl->symb),*new SgValueExp(ASYNCID_NUMB))); - //eeq = new SgArrayRefExp(*(sl->symb),*new SgValueExp(ASYNCID_NUMB)); - eeq = new SgArrayRefExp(*(sl->symb)); - artype = isSgArrayType(sl->symb->type()); - if(artype) - eeq->setLhs(artype->getDimList()); //add dimensions of array - else - eeq->setLhs(new SgValueExp(ASYNCID_NUMB)); - if(IN_MODULE) - eeq = DVMVarInitialization(eeq); - eel = new SgExprListExp(*eeq); - eel->setRhs(el); - el = eel; - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - if(IN_MODULE) - st->setVariant(VAR_DECL_90); - lstat -> insertStmtAfter(*st); - - -// declare common blocks for ASYNCID variables - for(sl=async_symb; sl; sl=sl->next) { - if(IN_COMMON(sl->symb)) { - el = new SgExprListExp(* new SgArrayRefExp(*(sl->symb))); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*(sl->symb)); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - st->insertStmtAfter(*com); - } - } - } - -// declare scalar variables for copying array header elements used for referencing array - if(!HPF_program && dsym ) { - symb_list *sl; - coeffs * c; - int i,rank,i0; - SgExpression *eepub, *lpub=NULL; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=dsym; sl; sl=sl->next) { - c = ((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); - if(IS_TEMPLATE(sl->symb) || !c->use) - continue; - int flag_public = IN_MODULE && privateall && sl->symb->attributes() & PUBLIC_BIT ? 1 : 0; - rank=Rank(sl->symb); - i0 = opt_base ? 1 : 2; - if(opt_loop_range) i0=0; - for(i=i0;i<=rank;i++){ - eel = new SgExprListExp(* new SgVarRefExp(*(c->sc[i]))); - eepub = flag_public ? &eel->copy() : NULL; - eel->setRhs(el); - el = eel; - if(flag_public) - { - eepub->setRhs(lpub); - lpub = eepub; - } - } - eel = new SgExprListExp(* new SgVarRefExp(*(c->sc[rank+2]))); - eepub = flag_public ? &eel->copy() : NULL; - eel->setRhs(el); - el = eel; - if(flag_public) - { - eepub->setRhs(lpub); - lpub = eepub; - } - - } - if(el){ - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat -> insertStmtAfter(*st); - } - if(lpub){ - st = new SgStatement(PUBLIC_STMT); - st->setExpression(0,*lpub); - lstat -> insertStmtAfter(*st); - } - } - - -// declare Pipeline variable for ACROSS implementation - if(pipeline){ - st = Pipe->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - -// declare Debug variable for -dbif regim - if(dbg_if_regim && dbg_var && !IN_MODULE) { - st = dbg_var->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - -// declaring COMMON block for Debug variable - - el = new SgExprListExp(* new SgVarRefExp(*dbg_var)); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*dbgcommon); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - lstat->insertStmtAfter(*com); - } - - -// declare CheckSumma variable for -dc regim - if(check_sum){ - st = check_sum->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - -// declare FileNameVariables - if(fnlist){ - filename_list *sl; - for(sl=fnlist; sl; sl=sl->next) { - st =sl->fns->makeVarDeclStmt();//character variables - - st->expr(0)->setLhs(FileNameInitialization(st->expr(0)->lhs(),sl->name)); - st->setVariant(VAR_DECL_90); - - lstat2 -> insertStmtAfter(*st); - } - } - -// declare CONSISTENT array headers as INTEGER - if(consistent_symb) { - symb_list *sl; - SgExpression *ea; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - - el = NULL; - for(sl=consistent_symb; sl; sl=sl->next) { - - /* if(IN_COMMON(sl->symb) && cur_func->variant() != PROG_HEDR) - continue;*/ /*25.03.03*/ - ea = new SgArrayRefExp(*(CONSISTENT_HEADER(sl->symb)),*new SgValueExp(HSIZE(Rank(sl->symb)))); - ea->setType(*SgTypeInt()); - eel = new SgExprListExp(*ea); - eel->setRhs(el); - el = eel; - } - if(el) { - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat -> insertStmtAfter(*st); - } - } - -// declare variables for saving conditional expression for Arithmetic IF and Computed GO TO -// for regim of debugging and performance analysing - if(if_goto) { - symb_list *sl; - for(sl=if_goto; sl; sl=sl->next) - {st = (sl->symb)->makeVarDeclStmt(); - lstat -> insertStmtAfter(*st); - } - } - - HEADERS_: //begin generating for interface block - -// declare array headers as INTEGER - if(dsym) { - symb_list *sl; - SgExpression *ea,*ehs; - st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed - el = NULL; - for(sl=dsym; sl; sl=sl->next) { - if(IS_BY_USE(sl->symb)) continue; - //if(!isSgArrayType(sl->symb->type())) //for POINTER - // sl->symb ->setType(* new SgArrayType(*SgTypeInt())); - ///if(IS_TEMPLATE(sl->symb) && !RTS2_OBJECT(sl->symb)) { - /// ea = new SgVarRefExp(*(sl->symb)); - - ///} else { - ehs = IS_POINTER_F90(sl->symb) ? new SgExpression(DDOT) : new SgValueExp(HEADER_SIZE(sl->symb)); - ea = new SgArrayRefExp(*(sl->symb),*ehs); - if(IS_POINTER(sl->symb) && (sl->symb->attributes() & DIMENSION_BIT)) { //array of POINTER - SgArrayType *artype; - artype = isSgArrayType(sl->symb->type()); - if(artype) - (ea->lhs())->setRhs(artype->getDimList()); //add dimensions of array - } - ///} - //TYPE_BASE(sl->symb->type()->thetype) = SgTypeInt()->thetype; - ea->setType(*SgTypeInt()); - if(IN_MODULE && !IS_POINTER_F90(sl->symb)) - ea = DVMVarInitialization(ea); - eel = new SgExprListExp(*ea); - eel->setRhs(el); - el = eel; - } - if(el) { - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - if(IN_MODULE) - st->setVariant(VAR_DECL_90); - lstat -> insertStmtAfter(*st); - } - - } - -//declare Common-blocks for TEMPLATE with attribute COMMON - { - symb_list *sl; - for(sl=dsym; sl; sl=sl->next) { - if(IS_TEMPLATE(sl->symb) && IN_COMMON(sl->symb)) { - el = new SgExprListExp(* new SgVarRefExp(*(sl->symb))); - eeq = new SgExpression (COMM_LIST); - eeq -> setSymbol(*(sl->symb)); - eeq -> setLhs(*el); - com = new SgStatement(COMM_STAT); - com->setExpression(0,*eeq); - st->insertStmtAfter(*com); - } - } - } -// end of declaration generating for interface block - if(in_interface) return; - -// declare array hpf000(N), N = maxhpf - if(HPF_program && maxhpf != 0) { - typearray = isSgArrayType(hpfbuf->type()); - typearray-> addRange(* new SgValueExp(maxhpf)); - st = hpfbuf ->makeVarDeclStmt(); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat2 -> insertStmtAfter(*st); - } - -// declare array dvm000(N), N = maxdvm - if(cur_func->variant() == PROG_HEDR || !(maxdvm <= 3 && fmask[RTLINI] == 0 && fmask[BEGBL] == 0 && fmask[FNAME] == 0 && fmask[GETVM] == 0 && fmask[GETAM] == 0 && fmask[DVMLF] == 0)) { - typearray = isSgArrayType(dvmbuf->type()); - typearray-> addRange(* new SgValueExp(maxdvm)); - //dvmbuf-> declareTheSymbol(*func); - st = dvmbuf ->makeVarDeclStmt(); - if(len_DvmType) - st->expr(1)->setType(tlen); - lstat2 -> insertStmtAfter(*st); - } - -// declare LibDVM functions as INTEGER - i=0; - while ( (imakeVarDeclStmt(); - el = isSgExprListExp(st->expr(0)); - // el = new SgExprListExp(* new SgVarRefExp(fdvm[0])); - for(j=i+1; fdvm[j] && jsetRhs(*el); - el = eel; - //el->append (* em[0]); - } - } - st -> setExpression(0,*el); - if(len_DvmType) - st->expr(1)->setType(tlen); - - lstat2 -> insertStmtAfter(*st); - -// declare LibDVM subroutines as EXTERNAL -EXTERN_: - i=0; - while ( (isetRhs(*el); - el = eel; - } - } - st -> setExpression(0,*el); - - lstat2 -> insertStmtAfter(*st); - -GPU_: -// declare GPU objects - if(!IN_MODULE) - DeclareVarGPU(lstat,tlen); /*ACC*/ -// add comment - if(lstat->lexNext() != st_next) - (lstat->lexNext())->setComments("! DVMH declarations \n"); -} - -void TranslateFileDVM(SgFile *f) -{ - SgStatement *func,*stat,*end_of_source_file; - SgStatement *end_of_unit; // last node (END or CONTAINS statement) of program unit - - - InitializeACC(); - -// grab the first statement in the file. - stat = f->firstStatement(); // file header -//last statement of file - end_of_source_file = FILE_LAST_STATEMENT(stat) ? *FILE_LAST_STATEMENT(stat) : lastStmtOfFile(f); -// add empty-statement to insert generated procedures at the end of file (after that) - end_of_source_file->insertStmtAfter( *new SgStatement(COMMENT_STAT),*stat); - end_of_source_file = end_of_source_file->lexNext(); - if(ACC_program || parloop_by_handler) - end_of_source_file->addComment("!-----------------------------------------------------------------------\n"); - - //numfun = f->numberOfFunctions(); // number of functions -// function is program unit accept BLOCKDATA and MODULE (F90),i.e. -// PROGRAM, SUBROUTINE, FUNCTION - if(debug_fragment || perf_fragment) // is debugging or performance analizing regime specified ? - BeginDebugFragment(0,NULL);// begin the fragment with number 0 (involving whole file(program) - //for(i = 0; i < numfun; i++) { - // func = f -> functions(i); - - for(stat=stat->lexNext(); stat!=end_of_source_file; stat=end_of_unit->lexNext()) - { - if(stat->variant() == CONTROL_END) { //end of procedure or module with CONTAINS statement - end_of_unit = stat; - continue; - } - - if( stat->variant() == BLOCK_DATA){//BLOCK_DATA header - TransBlockData(stat, end_of_unit); //replacing variant VAR_DECL with VAR_DECL_90 for declaration statement with initialisation - continue; - } - // PROGRAM, SUBROUTINE, FUNCTION header - func = stat; - cur_func = stat; - - //scanning the Symbols Table of the function - // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); - - - // translating the program unit (procedure, module) - if(only_debug) - InsertDebugStat(func, end_of_unit); - else - TransFunc(func, end_of_unit); - - } - - if(ACC_program) - { InsertCalledProcedureCopies(); - AddExternStmtToBlock_C(); - GenerateEndIfDir(); - GenerateDeclarationDir(); - GenerateStmtsForInfoFile(); - } -} - - -void TransFunc(SgStatement *func,SgStatement* &end_of_unit) { - SgStatement *stmt,*last,*rmout, *data_stf, *first, *first_dvm_exec, *last_spec, *stam, *last_dvm_entry, *lentry = NULL; - SgStatement *st_newv = NULL;// for NEW_VALUE directives - SgExpression *e; - SgStatement *task_region_parent = NULL, *on_stmt = NULL, *mod_proc, *begbl = NULL, *dvmh_init_st=NULL; - SgStatement *copy_proc = NULL; - SgStatement *has_contains = NULL; - SgLabel *lab_exec; - - int i; - int begin_block; - distribute_list *distr = NULL; - distribute_list *dsl,*distr_last = NULL; - align *pal = NULL; - align *node, *root = NULL; - stmt_list *pstmt = NULL; - int inherit_is = 0; - int contains[2]; - int in_on = 0; - char io_modes_str[4] = "\0"; - - //initialization - dsym = NULL; - grname = NULL; - saveall = 0; - maxdvm = 0; - maxhpf = 0; - count_reg = 0; - initMask(); - data_stf = NULL; - loc_distr = 0; - begin_block = 0; - goto_list = NULL; - proc_symb = NULL; - task_symb = NULL; - consistent_symb = NULL; - async_symb = NULL; - check_sum = NULL; - loc_templ_symb=NULL; - index_symb = NULL; - nio = 0; - task_do = NULL; - for (i=0; ilexNext(); - //!!!debug - //if(fsymb) - //printf("\n%s %s \n", header(func->variant()),fsymb->identifier()); - //else { - //printf("Function name error \n"); - //return; - //} - //get the last node of the program unit(function) - last = func->lastNodeOfStmt(); - end_of_unit = last; - if(!(last->variant() == CONTROL_END)) - printf(" END Statement is absent\n"); -/* - fsymb = func->symbol(); - if((func->variant() == PROG_HEDR) && !strcmp(fsymb->identifier(),"_MAIN")){ - progsymb = new SgFunctionSymb(PROGRAM_NAME, "MAIN", *SgTypeInt(), *current_file->firstStatement() ); - func->setSymbol(*progsymb); - } -*/ - -//********************************************************************** -// Specification Directives Processing -//********************************************************************** -// follow the statements of the function in lexical order -// until first executable statement - for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { - //printf("statement %d %s\n",stmt->lineNumber(),stmt->fileName()); - - if (!isSgExecutableStatement(stmt)) //is Fortran specification statement -// isSgExecutableStatement: -// FALSE - for specification statement of Fortan 90 -// TRUE - for executable statement of Fortan 90 and -// all directives of F-DVM - { - //!!!debug - //printVariantName(stmt->variant()); //for debug - //printf("\n"); - - //discovering distributed arrays in COMMON-blocks - if(stmt->variant()==COMM_STAT) { - DeleteShapeSpecDAr(stmt); - - if( !DeleteHeapFromList(stmt) ) { //common list is empty - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); //deleting the statement - } - continue; - } - // analizing SAVE statement - if(stmt->variant()==SAVE_DECL) { - if (!stmt->expr(0)) //SAVE without name-list - saveall = 1; - else if(IN_MAIN_PROGRAM) - pstmt = addToStmtList(pstmt, stmt); //for extracting and replacing by SAVE without list - continue; - } - // deleting SAVE-attribute from Type Declaration Statement (for replacing by SAVE without list) - if(IN_MAIN_PROGRAM && isSgVarDeclStmt(stmt)) - DeleteSaveAttribute(stmt); - - if(IN_MODULE && stmt->variant() == PRIVATE_STMT && !stmt->expr(0)) - privateall = 1; - - // deleting distributed arrays from variable list of declaration - // statement and testing are there any group names - if( isSgVarDeclStmt(stmt) || isSgVarListDeclStmt(stmt)) { - - if( !DeleteDArFromList(stmt) ) { //variable list is empty - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); //deleting the statement - } - continue; - } - - if((stmt->variant() == DATA_DECL) || (stmt->variant() == STMTFN_STAT)) { - if(stmt->variant() == STMTFN_STAT && stmt->expr(0) && stmt->expr(0)->symbol() && ((!strcmp(stmt->expr(0)->symbol()->identifier(),"number_of_processors")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_rank")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_size")))){ - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); - //deleting the statement-function declaration named - // NUMBER_OF_PROCESSORS or PROCESSORS_RANK or PROCESSORS_SIZE - continue; - } - if(stmt->variant()==STMTFN_STAT) - DECL(stmt->expr(0)->symbol()) = 2; //flag of statement function name - - if(!data_stf) - data_stf = stmt; //first statement in data-or-function statement part - continue; - } - if (stmt->variant() == ENTRY_STAT) { - //err("ENTRY statement is not permitted in FDVM", stmt); - warn("ENTRY among specification statements", 81,stmt); - continue; - } - if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR){ - stmt = InterfaceBlock(stmt); //stmt->lastNodeOfStmt(); - continue; - } - - if( stmt->variant() == USE_STMT) { - all_replicated=0; - if(stmt->lexPrev() != func && stmt->lexPrev()->variant()!=USE_STMT) - err("Misplaced USE statement", 639, stmt); - UpdateUseListWithDvmArrays(stmt); - continue; - } - - if(stmt->variant() == STRUCT_DECL){ - StructureProcessing(stmt); - stmt=stmt->lastNodeOfStmt(); - continue; - } - - continue; - } - - if ((stmt->variant() == FORMAT_STAT)) // || (stmt->variant() == DATA_DECL)) - {// printf(" "); - // printVariantName(stmt->variant()); //for debug - //printf("\n"); - continue; - } - - -// processing the DVM Specification Directives - - //including the DVM specification directive to list of these directives - pstmt = addToStmtList(pstmt, stmt); - - switch(stmt->variant()) { - case(ACC_ROUTINE_DIR): - ACC_ROUTINE_Directive(stmt); - continue; - case(ACC_DECLARE_DIR): - ACC_DECLARE_Directive(stmt); - continue; - case(HPF_TEMPLATE_STAT): - if(IN_MODULE && stmt->expr(1)) - err("Illegal directive in module",632,stmt); - TemplateDeclarationTest(stmt); - continue; - case(HPF_PROCESSORS_STAT): - //!!!for debug - // printf("CDVM$ "); - // printVariantName(stmt->variant()); - // printf("\n"); - // - continue; - case(DVM_DYNAMIC_DIR): - {SgExpression *el; - SgSymbol *ar; - for(el = stmt->expr(0); el; el=el->rhs()){ // array name list - ar = el->lhs()->symbol(); //array name - //if(!(ar->attributes() & ALIGN_BIT) && !(ar->attributes() & DISTRIBUTE_BIT) && !(ar->attributes() & INHERIT_BIT)) - // SYMB_ATTR(ar->thesymb)= SYMB_ATTR(ar->thesymb) | POSTPONE_BIT; - } - all_replicated = 0; - } - continue; - case(DVM_SHADOW_DIR): - {SgExpression *el; - SgExpression **she = new (SgExpression *); - SgSymbol *ar; - int nw=0; - // calculate lengh of shadow_list - for(el = stmt->expr(1); el; el=el->rhs()) - nw++; - *she = stmt->expr(1); - for(el = stmt->expr(0); el; el=el->rhs()){ // array name list - ar = el->lhs()->symbol(); //array name - ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); - /* if(nwidentifier(), stmt); - */ - if (nw!=Rank(ar)) // wrong shadow width list - Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88, stmt); - } - } -//!!!for debug - //printf("CDVM$ "); - //printVariantName(stmt->variant()); - // printf("\n"); -// - continue; - - case(DVM_TASK_DIR): - {SgExpression * sl; - for(sl=stmt->expr(0); sl; sl = sl->rhs()) - task_symb=AddToSymbList(task_symb, sl->lhs()->symbol()); - } - continue; - - case(DVM_CONSISTENT_DIR): - {SgExpression * sl; - for(sl=stmt->expr(0); sl; sl = sl->rhs()) { - SgSymbol **header = new (SgSymbol *); - consistent_symb=AddToSymbList(consistent_symb, sl->lhs()->symbol()); - *header= CreateConsistentHeaderSymb(sl->lhs()->symbol()); - // adding the attribute (CONSISTENT_ARRAY_HEADER) to distributed array symbol - sl->lhs()->symbol()->addAttribute(CONSISTENT_ARRAY_HEADER, (void*) header, sizeof(SgSymbol *)); - } - } - continue; - - case(DVM_INDIRECT_GROUP_DIR): - case(DVM_REMOTE_GROUP_DIR): - {SgExpression * sl; - if(options.isOn(NO_REMOTE)) - continue; - if(INTERFACE_RTS2) - err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); - for(sl=stmt->expr(0); sl; sl = sl->rhs()){ - SgArrayType *artype; - artype = new SgArrayType(*SgTypeInt()); - artype->addRange(*new SgValueExp(3)); - sl->lhs()->symbol()->setType(artype); - AddToGroupNameList(sl->lhs()->symbol()); - } - } - continue; - - case DVM_CONSISTENT_GROUP_DIR: - case DVM_REDUCTION_GROUP_DIR: - if(INTERFACE_RTS2) - err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); - {SgExpression * sl; - for(sl=stmt->expr(0); sl; sl = sl->rhs()) - AddToGroupNameList(sl->lhs()->symbol()); - } - continue; - - case(DVM_INHERIT_DIR): - {SgExpression * sl; - inherit_is = 1; all_replicated = 0; - for(sl=stmt->expr(0); sl; sl = sl->rhs()){ - if(IS_DUMMY(sl->lhs()->symbol())) - ArrayHeader(sl->lhs()->symbol(),1); - else - Error("Inconsistent declaration of identifier '%s'",sl->lhs()->symbol()->identifier(),16,stmt); - } - } - continue; - - ALIGN: - case(DVM_ALIGN_DIR): // adding the alignees and the align_base to - // the Align_Tree_List - { SgSymbol *base, *alignee; - SgExpression *eal; - algn_attr *attr_base, *attr_alignee; - //dvm = 1; - attr_base = attr_alignee = NULL; - if(stmt->expr(2)){ - base = (stmt->expr(2)->variant()==ARRAY_OP) ? (stmt->expr(2))->rhs()->symbol() : (stmt->expr(2))->symbol(); - // align_base symbol - attr_base = (algn_attr *) base->attributeValue(0,ALIGN_TREE); - } - else - base = NULL; - for(eal=stmt->expr(0); eal; eal=eal->rhs()) { - //scanning the alignees list - // (eal - SgExprListExp) - alignee = (eal->lhs())->symbol(); - if(alignee->attributes() & EQUIVALENCE_BIT) - Error("DVM-array cannot be specified in EQUIVALENCE statement: %s", alignee->identifier(),341,stmt); - if(alignee == base) - { Error("'%s' is aligned with itself", alignee->identifier(), 266,stmt); - continue; - } - if(stmt->expr(1) && IN_MODULE && IS_ALLOCATABLE_POINTER(alignee)) - Error("Inconsistent declaration of identifier '%s'", alignee->identifier(), 16,stmt); - attr_alignee=(algn_attr *) alignee->attributeValue(0,ALIGN_TREE); - if(stmt->expr(2) && (stmt->expr(2)->variant()==ARRAY_OP) && !IS_DUMMY(alignee)) - Error("Inconsistent declaration of identifier '%s'", alignee->identifier(), 16,stmt); - if(!stmt->expr(1) && ! stmt->expr(2)) { - SYMB_ATTR(alignee->thesymb)= SYMB_ATTR(alignee->thesymb) | POSTPONE_BIT; - if(!attr_alignee){ - // creating new node for the alignee - node = new align; - node->symb = alignee; - node->next = pal; - node->alignees = NULL; - node->align_stmt = stmt; - pal = node; - // adding the attribute (ALIGN_TREE) to the alignee symbol - attr_alignee = new algn_attr; - attr_alignee->type = NODE; - attr_alignee->ref = node; - alignee->addAttribute(ALIGN_TREE, (void *) attr_alignee, sizeof(algn_attr)); - } else - if(attr_alignee->type == NODE) { - Err_g("Duplicate aligning of the array '%s'",alignee->identifier(),82); - continue; - } - node= attr_alignee->ref; - node->align_stmt = stmt; - continue; - - } - if (!pal || (!attr_base && !attr_alignee)) { - // creating new tree with root for align_base - node = new align; // creating new node for the alignee - node->symb = alignee; - node->next = NULL; - node->alignees = NULL; - node->align_stmt = stmt; - root = new align; // creating new node for the base (root) - root->symb = base; - root->next = pal; - root->alignees = node; - root->align_stmt = NULL; - pal = root; // pal points to this tree - - // adding the attribute (ALIGN_TREE) to the base symbol - attr_base = new algn_attr; - attr_base->type = ROOT; - attr_base->ref = root; - base->addAttribute(ALIGN_TREE, (void *) attr_base, sizeof(algn_attr)); -//for debug - //printf("Attribute ALIGN_TREE of %s : type = %d\n", base->identifier(), ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->type); - // adding the attribute (ALIGN_TREE) to the alignee symbol - attr_alignee = new algn_attr; - attr_alignee->type = NODE; - attr_alignee->ref = node; - alignee->addAttribute(ALIGN_TREE, (void *) attr_alignee, sizeof(algn_attr)); -//for debug - //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); - } - else if (!attr_alignee && attr_base) { - // creating new node for the alignee and - // adding it to alignees_list of the node for align_base - root = ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->ref; - node = new align; // creating new node for the alignee - node->symb = alignee; - node->next = root->alignees; - node->alignees = NULL; - node->align_stmt = stmt; - root->alignees = node; // adding it to alignees_list of - // the node for align_base - // adding the attribute (ALIGN_TREE) to the alignee symbol - attr_alignee = new algn_attr; - attr_alignee->type = NODE; - attr_alignee->ref = node; - alignee->addAttribute(ALIGN_TREE, (void *) attr_alignee, sizeof(algn_attr)); -//for debug - //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); - } - else if (attr_alignee && !attr_base) { - - if(attr_alignee->type == NODE) { - Err_g("Duplicate aligning of the array '%s'", alignee->identifier(),82); - continue; - } - // creating new node for align_base, - // adding a tree for the alignee to alignees_list of it - - node=((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->ref; - // deleting tree for the alignee from Align_Tree_List - if (pal == node) - pal = node->next; - else - for(root=pal ; root->next != node; root=root->next) - ; - root->next = node->next; - - root = new align; // creating new node for the base (root) - root->symb = base; - root->next = pal; - root->alignees = node; - root->align_stmt = NULL; - node->align_stmt = stmt; // setting the field 'align_stmt' - // of the node for alignee - node->next = NULL; // setting off 'next' field of the node - //for alignee - pal = root; // pal points to new tree - // adding the attribute (ALIGN_TREE) to the base symbol - attr_base = new algn_attr; - attr_base->type = ROOT; - attr_base->ref = root; - base->addAttribute(ALIGN_TREE, (void *) attr_base, sizeof(algn_attr)); -//for debug - //printf("Attribute ALIGN_TREE of %s : type = %d\n", base->identifier(), ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->type); - // changing field 'type'of the attribute (ALIGN_TREE) - // of the alignee symbol - attr_alignee->type = NODE; -//for debug - //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); - - } - else if (attr_alignee && attr_base) { - - if(attr_alignee->type == NODE) { - Err_g("Duplicate aligning of the array '%s'", alignee->identifier(),82); - continue; - } - //testing: is a node for align_base the node of alignee tree - // ... - // adding a tree for the alignee to alignees_list - // of the node for align_base - node=((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->ref; - // deleting tree for the alignee from Align_Tree_List - if (pal == node) - pal = node->next; - else - for(root=pal ; root->next != node; root=root->next) - ; - root->next = node->next; - - root = ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->ref; - node->align_stmt = stmt; - node->next = root->alignees; - root->alignees = node; - - // changing field 'type'of the attribute (ALIGN_TREE) - // of the alignee symbol - attr_alignee->type = NODE; -//for debug - //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); - } - - } - } -//!!!for debug - //printf("CDVM$ "); - //printVariantName(stmt->variant()); - //printf("\n"); -// - continue; - - DISTR: - case(DVM_DISTRIBUTE_DIR): // adding the statement to the Distribute - // directive list - //dvm = 1; - if (!distr) { - distr = new distribute_list; - distr->stdis = stmt; - distr->next = NULL; - distr_last = distr; - } else { - dsl = new distribute_list; - dsl->stdis = stmt; - dsl->next = NULL; - distr_last->next = dsl; - distr_last = dsl; - } -//!!!for debug - //printf("CDVM$ "); - //printVariantName(stmt->variant()); - //printf("\n"); -// - DistributeArrayList(stmt); //adding the attribute DISTRIBUTE_ to distribute-array symbol - continue; - case(DVM_POINTER_DIR): - {SgExpression *el; - SgStatement **pst = new (SgStatement *); - - SgSymbol *sym; - int *index; - *pst = stmt; - for(el = stmt->expr(0); el; el=el->rhs()){ // name list - sym = el->lhs()->symbol(); // name - sym->addAttribute(POINTER_, (void *) pst, sizeof(SgStatement *)); - if((sym->type()->variant() != T_INT) && (sym->type()->variant() != T_ARRAY)) - Error("POINTER '%s' is not integer variable",sym->identifier(),83,stmt); - if( (sym->type()->variant() == T_ARRAY) && (sym->type()->baseType()->variant() != T_INT)) - Error("POINTER '%s' is not integer variable",sym->identifier(),83,stmt); - //if(IS_DUMMY(sym) || IN_COMMON(sym)) - if(IS_DUMMY(sym)) - Error("Inconsistent declaration of identifier '%s' ",sym->identifier(),16,stmt); - if(IS_SAVE(sym)) - Error("POINTER may not have SAVE attribute: %s",sym->identifier(),84,stmt); - /* - if(!IS_DVM_ARRAY(sym)) - Error("POINTER '%s' is not distributed object",sym->identifier(), 85,stmt); - */ - if(!IS_DVM_ARRAY(sym)) - // AddDistSymbList(sym); - ArrayHeader(sym,0); - index = new int; - *index = heap_size+1; - // adding the attribute (HEAP_INDEX) to POINTER symbol - sym->addAttribute(HEAP_INDEX, (void *) index, sizeof(int)); - heap_size = heap_size + HEADER_SIZE(sym)*NumberOfElements(sym,stmt,1); - } - } -//!!!for debug - //printf("CDVM$ "); - //printVariantName(stmt->variant()); - // printf("\n"); -// - continue; - - case (DVM_HEAP_DIR): - heap_ar_decl = new SgArrayRefExp(*heapdvm); - continue; - - case (DVM_ASYNCID_DIR): - {SgExpression * sl; - SgArrayType *artype; - for(sl=stmt->expr(0); sl; sl = sl->rhs()) { - artype = new SgArrayType(*SgTypeInt()); - artype->addRange(*new SgValueExp(ASYNCID_NUMB)); - if(sl->lhs()->lhs()) //array specification - artype->addRange(*(sl->lhs()->lhs())); - sl->lhs()->symbol()->setType(artype); - async_symb=AddToSymbList(async_symb, sl->lhs()->symbol()); - if(stmt->expr(1)) // ASYNCID,COMMON:: name-list - SYMB_ATTR(sl->lhs()->symbol()->thesymb)= SYMB_ATTR(sl->lhs()->symbol()->thesymb) | COMMON_BIT; - } - } - continue; - - case (DVM_VAR_DECL): - { SgExpression *el,*eol,*eda; - SgSymbol *symb; - int i, nattrs[8]; - for(i=0; i<8; i++) - nattrs[i] = 0; - eda = NULL; - //testing obgect list - isListOfArrays(stmt->expr(0),stmt); - - for(el = stmt->expr(2); el; el=el->rhs()) // attribute list - switch(el->lhs()->variant()) { - case (ALIGN_OP): - nattrs[0]++; - eda = el->lhs(); - break; - case (DISTRIBUTE_OP): - nattrs[1]++; - eda = el->lhs(); - break; - case (TEMPLATE_OP): - nattrs[2]++; - TemplateDeclarationTest(stmt); - break; - case (PROCESSORS_OP): - nattrs[3]++; - break; - case (DIMENSION_OP): - nattrs[4]++; - for(eol=stmt->expr(0); eol; eol=eol->rhs()) { //testing object list - symb=eol->lhs()->symbol(); - if(!( (symb->attributes() & TEMPLATE_BIT) || (symb->attributes() & PROCESSORS_BIT))) - Error("Object '%s' has neither TEMPLATE nor PROCESSORS attribute",symb->identifier(), 86,stmt); - } - //testing shape specification (el->lhs()->lhs()) : each expression is specification expression - if((el->lhs()->lhs()) && (! TestShapeSpec(el->lhs()->lhs()))) - err("Illegal shape specification in DIMENSION attribute",87,stmt); - break; - case (DYNAMIC_OP): - nattrs[5]++; - break; - case (SHADOW_OP): - {SgExpression *eln; - SgExpression **she = new (SgExpression *); - SgSymbol *ar; - int nw=0; - - nattrs[6]++; - - // calculate lengh of shadow_list - for(eln = el->lhs()->lhs() ; eln; eln=eln->rhs()) - nw++; - *she = el->lhs()->lhs(); //shadow specification - for(eln = stmt->expr(0); eln; eln=eln->rhs()){ // array name list - ar = eln->lhs()->symbol(); //array name - ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); - /* if(nwidentifier(), stmt); - */ - if (nw!=Rank(ar)) // wrong shadow width list - Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88,stmt); - } - break; - } - case (COMMON_OP): - nattrs[7]++; - break; - } - for(i=0; i<8; i++) - if( nattrs[i]>1) - Error("%s attribute appears more than once in the combined-directive", AttrName(i), 89, stmt); - if(eda) - if(eda->variant() == ALIGN_OP){ - stmt->setVariant(DVM_ALIGN_DIR); - if(! eda->lhs()) - BIF_LL2(stmt->thebif)= NULL; - else - BIF_LL2(stmt->thebif)= eda->lhs()->thellnd; - if(! eda->rhs()) - BIF_LL3(stmt->thebif)= NULL; - else - BIF_LL3(stmt->thebif)= eda->rhs()->thellnd; - //stmt->setExpression(1,*eda->lhs()); - //stmt->setExpression(2,*eda->rhs()); - goto ALIGN; - } - else { - stmt->setVariant(DVM_DISTRIBUTE_DIR); - if(! eda->lhs()) - BIF_LL2(stmt->thebif)=NULL; - else - BIF_LL2(stmt->thebif)= eda->lhs()->thellnd; - if(! eda->rhs()) - BIF_LL3(stmt->thebif)= NULL; - else - BIF_LL3(stmt->thebif)= eda->rhs()->thellnd; - //stmt->setExpression(1,*eda->lhs()); - //stmt->setExpression(2,*eda->rhs()); - if( eda->symbol()) - stmt->setSymbol(*eda->symbol()); - goto DISTR; - } - } - continue; - - } - - -// all declaration statements are processed, -// current statement is executable (F77/DVM) - - break; - } - // checking semantics of DECLARE directives - testDeclareDirectives(stmt); - - if(pstmt && (stmt != last)) - pstmt = pstmt->next; //deleting first executable statement from - // DVM Specification Directive List - -//********************************************************************** -// LibDVM References Generation -// for distributed and aligned arrays -//********************************************************************** - - //TempVarDVM(func); - first_exec = stmt; // first executable statement - -// testing procedure (-dbif2 regim) - if(debug_regim && dbg_if_regim>1 && ((func->variant() == PROC_HEDR) || (func->variant() == FUNC_HEDR)) && !pstmt && !isInternalOrModuleProcedure(func) && !lookForDVMdirectivesInBlock(first_exec,func->lastNodeOfStmt(),contains) && !contains[0] && !contains[1]) - copy_proc = CreateCopyOfExecPartOfProcedure(); - - lab_exec = first_exec->label(); // store the label of first ececutable statement - BIF_LABEL(first_exec->thebif) = NULL; - last_spec = first_exec->lexPrev();//may be extracted after - where = first_exec; //before first executable statement will be inserted new statements - stam = NULL; - if(grname) - CreateRedGroupVars(); - - ndvm = 1; // ndvm is number of first free element of array "dvm000" - nhpf = 1; // nhpf is number of first free element of array "hpf000" - -//generating "dummy" assign statement (always it is deleted) -// dvm000(1) = fname(file_name) -//function 'fname' tells the name of source file to DVM run-time system - InsertNewStatementBefore(D_Fname(),first_exec); - first_dvm_exec = last_spec->lexNext(); //first DVM function call - - if(IN_MODULE){ - if(TestDVMDirectivesInModule(pstmt) || TestUseStmts() || debug_regim) { - mod_proc = CreateModuleProcedure(cur_func,first_exec,has_contains); - where = mod_proc->lexNext(); - end_of_unit = where; - } else { - first_dvm_exec = last_spec->lexNext(); - goto EXEC_PART_; - } - } - - if(HPF_program) - first_hpf_exec = first_dvm_exec; - - if(func->variant() == PROG_HEDR) { // MAIN-program -//generating a call statement: -// call dvmlf(line_number_of_first_executable_statement,source-file-name) - LINE_NUMBER_BEFORE(first_exec,first_exec); -//generating function call ftcntr(...) -//function 'ftcntr' checks Fortran and C data type compatibility - TypeControl_New(); -//generating the function call which initializes the control structures of DVM run-time system, -// it's inserted in MAIN program) -// dvm000(1) = -// call dvmh_init(dvm000(1)) - dvmh_init_st = RTL_GPU_Init(); - if(!task_symb) // !!! added the condition temporarily - { - BeginBlock_H(); - begin_block = 1; - begbl = cur_st; - } - if(dbg_if_regim) - InitDebugVar(); - } - - else if(func->variant() == MODULE_STMT) // Module - ndvm++; - else -// generating assign statement -// dvm000(1) = BegBl() -// ( function BegBl defines the begin of object localisation block) - if(distr || task_symb || TestDVMDirectivesInProcedure(pstmt)) { - BeginBlock_H(); - begin_block = 1; - begbl = cur_st; - } - else - ndvm++; - -//generating assign statement -// dvm000(2) = GetAM() -//(function GetAM creates initial abstract machine) -//and assign statement -// dvm000(3) = GetPS(AMRef) -//(function GetPS returns virtual machine reference, on what abstract -// machine is mapped) - stam = NULL; - - ndvm = 4; // 3 first elements are reserved - -//generating call (module procedure) and/or assign statements for USE statements - GenForUseStmts(func,where); - -//Creating (reconfiguring) processor systems - ReconfPS(pstmt); - -//Creating task arrays - if(task_symb){ - symb_list *tl; - for(tl=task_symb; tl; tl=tl->next) ///looking through the task symbol list - CreateTaskArray(tl->symb); - } -//Initializing groups - if(grname && !IN_MODULE) - InitGroups(); - -//Initializing HEAP counter - if(heap_size != 0 ) //there are declared POINTER variables - if( !heap_ar_decl ) - Err_g("Missing %s declaration", "HEAP", 91); - // else - //generating assign statement: HEAP(1) = 2 - // InitHeap(heap_ar_decl->symbol()); -//Initializing ASYNCID counter - if(!IN_MODULE) - //if(IN_MAIN_PROGRAM) // (27.01.05) - InitAsyncid(); -//Creating CONSISTENT arrays - /* if(consistent_symb){ - symb_list *cl; - for(cl=consistent_symb; cl; cl=cl->next) ///looking through the consistent array symbol list - CreateConsistentArray(cl->symb); - }*/ -//Looking through the Distibute Directive List - for(dsl=distr; dsl; dsl=dsl->next) { - SgExpression *target,*ps = NULL; - int idis; // DisRuleArray index - SgSymbol *das; - int no_rules; - no_rules = 1; - for(e=dsl->stdis->expr(0); e; e=e->rhs()){//are there in dist-name-list array-name - //that is not a dummy, a pointer, and - //a COMMON-block element in procedure - das = (e->lhs())->symbol(); - if( !IS_DUMMY(das) && !IS_POINTER(das) && !(IN_COMMON(das) && (das->scope()->variant() != PROG_HEDR)) && !IS_ALLOCATABLE_POINTER(das)){ - no_rules = 0; ps = NULL; - break; - } - } - - SgExpression *distr_rule_list = doDisRules(dsl->stdis,no_rules,idis); - nproc = 0; - target = hasOntoClause(dsl->stdis); - if( target ) { //is there ONTO_clause - nproc = RankOfSection(target); - if(dsl->stdis->expr(1) && nblock && nproc && (nblock > nproc)) - Error("The number of BLOCK/GENBLOCK elements of dist-format-list is greater than the rank of PROCESSORS '%s' ", target->symbol()->identifier(),90,dsl->stdis); - } - /* if(dsl->stdis->expr(1) && nblock && (nblock != nblock_all)) - err("The number of BLOCK elements of dist-format-list must be the same in all DISTRIBUTE and REDISTRIBUTE directives", dsl->stdis);*/ - - if(!no_rules) - ps = PSReference(dsl->stdis); - -//looking through the dist_name_list - for(e=dsl->stdis->expr(0); e; e=e->rhs()) { - das = (e->lhs())->symbol(); // distribute array symbol - /* if(dsl->stdis->expr(2) && !IS_DUMMY(das)) - Error("'%s' is not a dummy argument", das->identifier(),dsl->stdis); - */ - int is_global_template_in_procedure = IS_TEMPLATE(das) && IN_COMMON(das) && !IN_MAIN_PROGRAM; - if(!dsl->stdis->expr(1) && !is_global_template_in_procedure) - SYMB_ATTR(das->thesymb)= SYMB_ATTR(das->thesymb) | POSTPONE_BIT; - /*if(IS_POINTER(das) && (das->attributes() & DIMENSION_BIT)) - Error("Distributee '%s' with POINTER attribute is not a scalar variable", das->identifier(),dsl->stdis); - */ - - // creating LibDVM function calls for distributed array and its Align Tree - - //GenDistArray(das,idis,dis_rules,ps,dsl->stdis); - GenDistArray(das,idis,distr_rule_list,ps,dsl->stdis); - } - - } - - //Looking through the Align Tree List - for(root=pal; root; root=root->next) { - if(!( root->symb->attributes() & DISTRIBUTE_BIT) && !( root->symb->attributes() & ALIGN_BIT) && !( root->symb->attributes() & INHERIT_BIT) && !( root->symb->attributes() & POSTPONE_BIT)) - Err_g("Alignment tree root '%s' is not distributed", root->symb->identifier(),92); - if(( root->symb->attributes() & POSTPONE_BIT) && !( root->symb->attributes() & DISTRIBUTE_BIT) && CURRENT_SCOPE(root->symb) ) { - GenAlignArray(root,NULL,0,NULL,0); - AlignTree(root); - } - if( (root->symb->attributes() & INHERIT_BIT) || !CURRENT_SCOPE(root->symb) ) - AlignTree(root); - - } - - if(debug_regim && registration) { // registrating arrays for debugger - LINE_NUMBER_BEFORE(func,where); //(first_exec,where); - ArrayRegistration(); - } -// testing procedure -// if(dvm_debug && dbg_if_regim>1 && ((func->variant() == PROC_HEDR) || (func->variant() == FUNC_HEDR)) && !pstmt)// && !hasParallelDir(first_exec,func)) -// copy_proc=1; - - for(;pstmt; pstmt= pstmt->next) - Extract_Stmt(pstmt->st);// extracting DVM Specification Directives - - if(!loc_distr && !task_symb && !proc_symb && !IN_MAIN_PROGRAM) { - //there are no local distributed arrays - //no task array , no asinc and no processor array - if(begin_block){ - begbl->extractStmt(); //extract dvmh_scope_start /*begbl()*/ call - begin_block = 0; - fmask[SCOPE_START] = 0; //fmask[BEGBL] = 0; - } - if(!loc_templ_symb && stam) { - stam->lexNext()->extractStmt(); //extract getps() call - stam->extractStmt(); //extract getam() call - fmask[GETAM] = 0; fmask[GETVM] = 0; - } - } - - if(begin_block && !IN_MAIN_PROGRAM) { - LINE_NUMBER_BEFORE(first_exec,begbl); - } - - if(lab_exec) - first_exec-> setLabel(*lab_exec); //restore label of first executable statement - - last_dvm_entry = first_exec->lexPrev(); - - if(copy_proc) - InsertCopyOfExecPartOfProcedure(copy_proc); - -//********************************************************************** -// Executable Directives Processing -//********************************************************************** - -EXEC_PART_: - for (i=0; ivariant() == CONTAINS_STMT) - end_of_unit = has_contains = first_exec; - //else if(mod_proc) - // mod_proc = MayBeDeleteModuleProc(mod_proc,end_of_unit); - goto END_; - } - -//follow the executable statements in lexical order until last statement -// of the function - for(stmt=first_exec; stmt ; stmt=stmt->lexNext()) { - cur_st = stmt; //printf("executable statement %d %s\n",stmt->lineNumber(),stmt->fileName()); - - while(rma && rma->rmout == stmt)//current statement is out of scope REMOTE_ACCESS directive - RemoteAccessEnd(); - - if(isACCdirective(stmt)) /*ACC*/ - { pstmt = addToStmtList(pstmt, stmt); - stmt = ACC_Directive(stmt); - continue; - } - - if(IN_COMPUTE_REGION && IN_STATEMENT_GROUP(stmt)) /*ACC*/ - { - stmt = ACC_CreateStatementGroup(stmt); - continue; - } - switch(stmt->variant()) { - case CONTROL_END: - if(stmt == last) { - EndOfProgramUnit(stmt, func, begin_block); - goto END_; - } - break; - - case CONTAINS_STMT: - has_contains = end_of_unit = stmt; - EndOfProgramUnit(stmt, func, begin_block); - goto END_; - break; - case RETURN_STAT: - EndOfProgramUnit(stmt, func, begin_block); - if(dvm_debug || perf_analysis ) - { // RETURN statement is added to list for debugging (exit the loop) - goto_list = addToStmtList(goto_list, stmt); - if(begin_block) - AddDebugGotoAttribute(stmt,stmt->lexPrev()->lexPrev()); //to insert statements for debugging before call endbl() inserted before RETURN - } - if(stmt->lexNext() == last) - goto END_; - if(stmt->lexNext()->variant() == CONTAINS_STMT){ - has_contains = end_of_unit = stmt->lexNext(); - goto END_; - } - break; - case STOP_STAT: - if(begin_block && func->variant() != PROG_HEDR) - EndBlock_H(stmt); - if(stmt->expr(0)){ - SgStatement *print_st; - InsertNewStatementBefore(print_st=PrintStat(stmt->expr(0)),stmt); - ReplaceByIfStmt(print_st); - } - RTLExit(stmt); - if(stmt->lexNext() == last) - goto END_; - break; - case PAUSE_NODE: - err("PAUSE statement is not permitted in FDVM", 93,stmt); - break; - case EXIT_STMT: - //if(dvm_debug || perf_analysis ) - // EXIT statement is added to list for debugging (exit the loop) - //goto_list = addToStmtList(goto_list, stmt); - break; - case ENTRY_STAT: - if(distr) { - warn("ENTRY of program unit distributed arrays are in",169,stmt); - // err("ENTRY statement is not permitted in FDVM", stmt); - } - GoRoundEntry(stmt); - //BeginBlockForEntry(stmt); - entry_list=addToStmtList(entry_list,stmt); - - break; - - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case WHILE_NODE: // DO WHILE (...) - if(HPF_program && !inparloop){ - first_time = 1; - SearchDistArrayRef(stmt->expr(0),stmt); - cur_st = stmt; - } - if(dvm_debug) - DebugExpression(stmt->expr(0),stmt); - else - ChangeDistArrayRef(stmt->expr(0)); - - if((dvm_debug || perf_analysis) && stmt->variant()==ARITHIF_NODE ) - goto_list = addToStmtList(goto_list, stmt); - - break; - - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - if(HPF_program && !inparloop){ - first_time = 1; - SearchDistArrayRef(stmt->expr(0),stmt); - cur_st = stmt; - } - ChangeDistArrayRef(stmt->expr(0)); - break; - - case LOGIF_NODE: // Logical IF - if( !stmt->lineNumber()) {//inserted statement - stmt = stmt->lexNext(); - break; - } - if(HPF_program) { - if(!inparloop){ //outside the range of parallel loop - ReplaceContext(stmt); - first_time = 1; - SearchDistArrayRef(stmt->expr(0),stmt); //look for distributed array elements - cur_st = stmt; - } else //inside the range of parallel loop - IsLIFReductionOp(stmt, indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator - } - if(dvm_debug) { - ReplaceContext(stmt); - DebugExpression(stmt->expr(0),stmt); - } else { - ChangeDistArrayRef(stmt->expr(0)); - if(perf_analysis && IsGoToStatement(stmt->lexNext())) - ReplaceContext(stmt); - } - continue; // to next statement - - - case FORALL_STAT: // FORALL statement - {SgSymbol *do_var; - SgExpression *el,*ei,*etriplet,*ec; - el=stmt->expr(0); //list of loop indexes - for(el= stmt->expr(0); el; el=el->rhs()){ - ei=el->lhs(); //expression: i=l:u:s - etriplet= ei->lhs();//l:u:s - do_var=ei->symbol();//do-variable - //printf("%s=",do_var->identifier()); - - //etriplet->unparsestdout(); - //printf(" "); - } - ec=stmt->expr(1); // conditional expression - //ec->unparsestdout(); - - } - stmt=stmt->lexNext();// statement that is a part of FORALL statement - break; - // continue; - case GOTO_NODE: // GO TO - if((dvm_debug || perf_analysis) && stmt->lineNumber() ) - goto_list = addToStmtList(goto_list, stmt); - break; - - case COMGOTO_NODE: // Computed GO TO - if(HPF_program && !inparloop){ - ReplaceContext(stmt); - first_time = 1; - SearchDistArrayRef(stmt->expr(1),stmt); - cur_st = stmt; - } - if(dvm_debug) { - ReplaceContext(stmt); - DebugExpression(stmt->expr(1),stmt); - } else - { ChangeDistArrayRef(stmt->expr(1)); - if (perf_analysis ) - ReplaceContext(stmt); - } - if(dvm_debug || perf_analysis ) - goto_list = addToStmtList(goto_list, stmt); - break; - - case ASSIGN_STAT: // Assign statement - { SgSymbol *s; - if(inasynchr && !INTERFACE_RTS2) { //inside the range of ASYNCHRONOUS construct - if(ArrayAssignment(stmt)) { //Fortran 90 - AsynchronousCopy(stmt); - } - pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements - stmt=cur_st; - break; - } - if( !stmt->lineNumber()) //inserted debug statement - break; - - if((s=stmt->expr(0)->symbol()) && IS_POINTER(s)){ // left part variable is POINTER - if(isSgFunctionCallExp(stmt->expr(1)) && !strcmp(stmt->expr(1)->symbol()->identifier(),"allocate")){ - if(inparloop) - err("Illegal statement in the range of parallel loop", 94, stmt); - AllocateArray(stmt,distr); - if(stmt != cur_st){//stmt == cur_st in error situation - Extract_Stmt(stmt); - stmt=cur_st; - } - - } else if( (isSgVarRefExp(stmt->expr(1)) || isSgArrayRefExp(stmt->expr(1))) && stmt->expr(1)->symbol() && IS_POINTER(stmt->expr(1)->symbol())) { - AssignPointer(stmt); - if(stmt != cur_st){ - Extract_Stmt(stmt); - stmt=cur_st; - } - - } else - err("Only a value of ALLOCATE function or other POINTER may be assigned to a POINTER",95,stmt); - - break; - } - if(HPF_program){ - if(!inparloop){ //outside the range of parallel loop - ReplaceContext(stmt); - first_time = 1; - SearchDistArrayRef(stmt->expr(1),stmt); //look for distributed array elements - cur_st = stmt; - } else //inside the range of parallel loop - IsReductionOp(stmt,indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator - } - /* if(own_exe) { // "owner executes" rule - ReplaceContext(stmt); - ReplaceAssignByIf(stmt); - } else */ - if(!inparloop && isDistObject(stmt->expr(0))){ - if( !isSgArrayType(stmt->expr(0)->type())){ //array element - if(all_replicated == 0){ // not all arrays in procedure are replicated - ReplaceContext(stmt); - - - if(!in_on) { - LINE_NUMBER_BEFORE(stmt,stmt); - ReplaceAssignByIf(stmt); - } - //own_exe = 1; - if(warn_all) - warn("Owner-computes rule", 139, stmt); - //warn("Assignment of distributed array element outside the range of parallel loop: owner executes", stmt); - } - own_exe = 1; - } - else { //array section - if(DistrArrayAssign(stmt)) { - pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements - stmt=cur_st; - break; - } - } - } - - if(!inparloop && AssignDistrArray(stmt)) { - pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements - stmt=cur_st; - break; - } - - // if(inparloop && !TestLeftPart(new_red_var_list, stmt->expr(0))) - // Error("Illegal assignment in the range of parallel loop",stmt); - - - if(dvm_debug) { - SgStatement *where_st, *stmt1, *stparent; - where_st=stmt->lexNext(); - ReplaceContext(stmt); - DebugAssignStatement(stmt); - - if(own_exe && !in_on) { //declaring omitted block - where_st = where_st->lexPrev(); - stmt1 = dbg_if_regim ? CreateIfThenConstr(DebugIfCondition(),D_Skpbl()) : D_Skpbl(); - stparent = (all_replicated == 0) ? stmt->controlParent()->controlParent() : stmt->controlParent(); - InsertNewStatementAfter(stmt1,where_st,stparent); - } - stmt = cur_st; - } else { - ChangeDistArrayRef_Left(stmt->expr(0)); // left part - ChangeDistArrayRef(stmt->expr(1)); // right part - } - own_exe =0; - } - break; - - case PROC_STAT: // CALL - if( !stmt->lineNumber()) //inserted debug statement - break; - if(HPF_program && !inparloop){ - ReplaceContext(stmt); - first_time = 1; - SearchDistArrayRef(stmt->expr(0),stmt); - cur_st = stmt; - } - if(dvm_debug){ - ReplaceContext(stmt); - DebugExpression(NULL,stmt); - } else { - // looking through the arguments list - SgExpression * el; - int i; - for(el=stmt->expr(0),i=0; el; el=el->rhs(),i++) - ChangeArg_DistArrayRef(el,stmt->symbol(),i); // argument - } - break; - case ALLOCATE_STMT: - ALLOCATEf90_arrays(stmt,distr); - if(!stmt->expr(0)){ - cur_st=stmt->lexPrev(); - Extract_Stmt(stmt); - stmt=cur_st; - } else - { cur_st = stmt; - if(debug_regim) - AllocatableArrayRegistration(stmt); - EnterDataRegionForAllocated(stmt); /*ACC*/ - stmt=cur_st; - } - break; - case DEALLOCATE_STMT: - DEALLOCATEf90_arrays(stmt); - if(!stmt->expr(0)){ - Extract_Stmt(stmt); - stmt=cur_st; - } - break; - case DVM_PARALLEL_ON_DIR: - if(!TestParallelWithoutOn(stmt,1)) - { - pstmt = addToStmtList(pstmt, stmt); - break; - } - - if(inparloop){ - err("Nested PARALLEL directives are not permitted", 96, stmt); - break; - } - //!!!acc printf("parallel on %d region %d\n",stmt->lineNumber(), cur_region); - - par_do = stmt->lexNext();// first DO statement of parallel loop - - while(isOmpDir (par_do)) // || isACCdirective(par_do) - { cur_st = par_do; - par_do=par_do->lexNext(); - } - if(!isSgForStmt(par_do)) { - err("PARALLEL directive must be followed by DO statement",97,stmt); //directive is ignored - break; - } - inparloop = 1; - if(!ParallelLoop(stmt))// error in PARALLEL directive - inparloop = 0; - - pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements - //Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - // setting stmt on last DO statement of parallel loop nest - break; - - case HPF_INDEPENDENT_DIR: - if(inparloop){ - //illegal nested INDEPENDENT directive is ignored - pstmt = addToStmtList(pstmt, stmt); //including the HPF directive to list - break; - } - indep_st = stmt; // INDEPENDENT directive - par_do = stmt->lexNext();// first DO statement of parallel loop - if(!isSgForStmt(par_do)) { - err("INDEPENDENT directive must be followed by DO statement",97,stmt); - //directive is ignored - break; - } - inparloop = 1; - IEXLoopAnalyse(func); - if(!IndependentLoop(stmt))// error in INDEPENDENT directive - inparloop = 0; - - - //including the HPF directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; // setting stmt on last DO statement of parallel loop nest - break; - - case DVM_SHADOW_GROUP_DIR: - { - SgSymbol *s; - SgExpression *gref; - if(INTERFACE_RTS2) - err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98, stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - s = stmt->symbol(); - AddToGroupNameList (s); - gref = new SgVarRefExp(s); - CreateBoundGroup(gref); - //s -> addAttribute(SHADOW_GROUP_IND, (void *) index, sizeof(int)); - ShadowList(stmt->expr(0), stmt, gref); - } - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st;//setting stmt on last inserted statement - break; - - case DVM_SHADOW_START_DIR: - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - if(ACC_program) /*ACC*/ - // generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - doCallAfter(ShadowRenew_H(new SgVarRefExp(stmt->symbol()) )); - - doCallAfter(StartBound(new SgVarRefExp(stmt->symbol()))); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st;//setting stmt on inserted statement - break; - - case DVM_SHADOW_WAIT_DIR: - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - doCallAfter(WaitBound(new SgVarRefExp(stmt->symbol()))); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st;//setting stmt on inserted statement - break; - - case DVM_REDUCTION_START_DIR: - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - doCallAfter(StartRed(new SgVarRefExp(stmt->symbol()))); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st;//setting stmt on inserted statement - break; - - case DVM_REDUCTION_WAIT_DIR: - {SgExpression *rg = new SgVarRefExp(stmt->symbol()); - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - doCallAfter(WaitRed(rg)); - if(dvm_debug) - doCallAfter( D_CalcRG(DebReductionGroup( rg->symbol()))); - - doCallAfter(DeleteObject_H(rg)); - doAssignTo_After(rg, new SgValueExp(0)); - if(debug_regim) - doCallAfter( D_DelRG(DebReductionGroup( rg->symbol()))); - } - //Extract_Stmt(stmt); // extracting DVM-directive - wait_list = addToStmtList(wait_list, stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st;//setting stmt on last inserted statement - break; - - - case DVM_CONSISTENT_START_DIR: - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - doAssignStmtAfter(StartConsGroup(new SgVarRefExp(stmt->symbol()))); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st;//setting stmt on inserted statement - break; - - case DVM_CONSISTENT_WAIT_DIR: - {SgExpression *rg = new SgVarRefExp(stmt->symbol()); - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - doAssignStmtAfter(WaitConsGroup(rg)); - //if(dvm_debug) - //doAssignStmtAfter( D_CalcRG(DebReductionGroup( rg->symbol()))); - if(cur_st->controlParent()->variant() != PROG_HEDR){ - doCallAfter(DeleteObject_H(rg)); - doAssignTo_After(rg, new SgValueExp(0)); - } - //if(debug_regim) - //doAssignStmtAfter( D_DelRG(DebReductionGroup( rg->symbol()))); - } - wait_list = addToStmtList(wait_list, stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st;//setting stmt on last inserted statement - break; - - case DVM_REMOTE_ACCESS_DIR: - if(inparloop) { - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - ReplaceContext(stmt->lexNext()); - switch(stmt->lexNext()->variant()) { - case LOGIF_NODE: - rmout = stmt->lexNext()->lexNext()->lexNext(); - break; - case SWITCH_NODE: - rmout = stmt->lexNext()->lastNodeOfStmt()->lexNext(); - break; - case IF_NODE: - rmout = lastStmtOfIf(stmt->lexNext())->lexNext(); - break; - case CASE_NODE: - case ELSEIF_NODE: - err("Misplaced REMOTE_ACCESS directive", 99,stmt); - rmout = stmt->lexNext()->lexNext(); - break; - case FOR_NODE: - rmout = lastStmtOfDo(stmt->lexNext())->lexNext(); - break; - case WHILE_NODE: - rmout = lastStmtOfDo(stmt->lexNext())->lexNext(); - break; - case DVM_PARALLEL_ON_DIR: - rmout = lastStmtOfDo(stmt->lexNext()->lexNext())->lexNext(); - break; - default: - rmout = stmt->lexNext()->lexNext(); - break; - } - //adding new element to remote_access directive/clause list - AddRemoteAccess(stmt->expr(0),rmout); - LINE_NUMBER_STL_BEFORE(cur_st,stmt,stmt->lexNext()); // moving the label of next statement - // looking through the remote variable list - RemoteVariableList(stmt->symbol(),stmt->expr(0),stmt); - - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - break; - - case DVM_NEW_VALUE_DIR: - if((stmt->lexNext()->variant()==DVM_REDISTRIBUTE_DIR) || (stmt->lexNext()->variant()==DVM_REALIGN_DIR)) - st_newv = stmt; - else - err("NEW_VALUE directive must be followed by REDISTRIBUTE or REALIGN directive", 146,stmt); - break; - - case DVM_REALIGN_DIR: - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - st_newv = 0; - break; - } else { - int iaxis; // AxisArray index - int nr,new_sign,ia; - SgSymbol *als,*tgs; - - where = stmt; //for inserting before current directive - iaxis = ndvm; - ia = 0; - //sta = NULL; - // new_val = isSgExprListExp(stmt->expr(2)) ? (stmt->expr(2)->rhs()->lhs()) : (SgExpression *) NULL; - - tgs = isSgExprListExp(stmt->expr(2)) ? (stmt->expr(2))->lhs()->symbol() : (stmt->expr(2))->symbol(); - if(!HEADER(tgs)) - Error("'%s' isn't distributed array", tgs->identifier(), 72,stmt); - - new_sign = 0; - if(st_newv) - new_sign = 1; // NEW_VALUE without variable list - //looking through the alignee_list - for(e=stmt->expr(0); e; e=e->rhs()) { - als = (e->lhs())->symbol(); // realigned array symbol - //nr = doAlignRule(als, stmt, ia); - SgExpression *align_rule_list = doAlignRules(als, stmt, ia, nr); - /* - *if(sta) // is not first list element - * for(i=0;i<2*nr;i++) - * Extract_Stmt(sta->lexNext());//extracting axis and coeff - * //assignment statements - */ - - /* - * if(new_val) - * if(!new_val->lhs()) // NEW_VALUE without variable list - * new_sign = 1; - * else - * for(env=new_val->lhs(); env; env=env->rhs()) { - * symb=env->lhs()->symbol(); - * if(symb==als) { - * new_sign = 1; - * break; - * } - * } - */ - LINE_NUMBER_AFTER(stmt,cur_st);// doAssignStmt in doAlignRule resets cur_st - //all inserted statements for REALIGN directive appear before it - RealignArray(als,tgs,iaxis,nr,align_rule_list,new_sign,stmt); - // doAssignStmt(RealignArr(DistObjectRef(als),DistObjectRef(stmt->expr(2)->symbol()),iaxis,iaxis+nr,iaxis+2*nr,new_sign)); - - ia = iaxis; - - } - SET_DVM(iaxis); - - } - - Extract_Stmt(stmt); // extracting REALIGN directive - if(st_newv) - Extract_Stmt(st_newv); //extracting preceeding NEW_VALUE directive - stmt = cur_st;//setting stmt on last inserted statement - st_newv = 0; - break; - - case DVM_REDISTRIBUTE_DIR: - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - else { - int idis; // DisRuleArray index - int new_sign,isave; - SgSymbol *das; - SgExpression *target,*ps; - // new_val = hasNewValueClause(stmt); - nproc = 0; - isave = ndvm; - where = stmt; //for inserting before current directive - LINE_NUMBER_BEFORE(stmt,stmt); - SgExpression *distr_rule_list = doDisRules(stmt,0,idis); - target = hasOntoClause(stmt); - if ( target ) { //is there ONTO_clause - nproc=RankOfSection(target); // rank of Processors - if(nblock && nproc && nblock > nproc) - Error("The number of BLOCK/GENBLOCK elements of dist-format-list is greater than the rank of PROCESSORS '%s'", target->symbol()->identifier(),90,stmt); - } - ps = PSReference(stmt); - //LINE_NUMBER_AFTER(stmt,cur_st);// doAssignStmt in doDisRuleArrays resets cur_st - //all inserted statements for REDISTRIBUTE directive appear before it - new_sign = 0; - if(st_newv) - new_sign = 1; // NEW_VALUE without variable list - //looking through the dist_name_list - for(e=stmt->expr(0); e; e=e->rhs()) { - das = (e->lhs())->symbol(); // distribute array symbol - // for debug - //printf("%s\n ", das->identifier()); - // - //new_sign = 0; - //if(new_val) - // if(!new_val->lhs()) // NEW_VALUE without variable list - // new_sign = 1; - // else - // for(env=new_val->lhs(); env; env=env->rhs()) { - // symb=env->lhs()->symbol(); - // if(symb==das) { - // new_sign = 1; - // break; - // } - // } - // if(Rank(das)!=ndis) - // Error("Length of dist-format-list is not equal the rank of %s ", das->identifier(),stmt); - - // creating LibDVM function calls for redistributing array - - RedistributeArray(das,idis,distr_rule_list,ps,new_sign,e->lhs(),stmt); - - } - - SET_DVM(isave); - Extract_Stmt(stmt); // extracting REDISTRIBUTE directive - if(st_newv) - Extract_Stmt(st_newv); //extracting preceeding NEW_VALUE directive - stmt = cur_st;//setting stmt on last inserted statement - - } - st_newv = 0; - break; - - case DVM_LOCALIZE_DIR: - { - int iaxis; - int rank=Rank(stmt->expr(1)->symbol()); - SgExpression *ei; - if(!INTERFACE_RTS2) - { - warn("LOCALIZE directive is ignored, -Opl2 option should be specified",621,stmt); - pstmt = addToStmtList(pstmt, stmt); - break; - } - LINE_NUMBER_AFTER(stmt,stmt); - for(ei=stmt->expr(1)->lhs(),iaxis=rank; ei; ei=ei->rhs(),iaxis--) - if(ei->lhs()->variant() == DDOT) - break; - - if( HEADER(stmt->expr(0)->symbol()) && HEADER(stmt->expr(1)->symbol()) ) - { - doCallAfter(IndirectLocalize(HeaderRef(stmt->expr(0)->symbol()),HeaderRef(stmt->expr(1)->symbol()),iaxis)); - Extract_Stmt(stmt); - } - if( !HEADER( stmt->expr(0)->symbol()) ) - Error("'%s' is not distributed array", stmt->expr(0)->symbol()->identifier(),72,stmt); - if( !HEADER( stmt->expr(1)->symbol()) ) - Error("'%s' is not distributed array", stmt->expr(1)->symbol()->identifier(),72,stmt); - - stmt = cur_st; - break; - } - - case DVM_SHADOW_ADD_DIR: - if(!INTERFACE_RTS2) - { - warn("SHADOW_ADD directive is ignored, -Opl2 option should be specified",621,stmt); - pstmt = addToStmtList(pstmt, stmt); - break; - } - LINE_NUMBER_AFTER(stmt,stmt); - Shadow_Add_Directive(stmt); - Extract_Stmt(stmt); - stmt = cur_st; - break; - -//Debugging Directive - case DVM_INTERVAL_DIR: - if (perf_analysis > 1){ - //generating call to 'binter' function of performance analizer - // (begin of user interval) - - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter(St_Binter(OpenInterval(stmt),Value_F95(stmt->expr(0))), cur_st,cur_st->controlParent()); - } - pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list - stmt = cur_st; - break; - - case DVM_ENDINTERVAL_DIR: - if (perf_analysis > 1){ - //generating call to 'einter' function of performance analizer - // (end of user interval) - - if(!St_frag){ - err("Unmatched directive",182,stmt); - break; - } - if(St_frag && St_frag->begin_st && (St_frag->begin_st->controlParent() != stmt->controlParent())) - err("Misplaced directive",103,stmt); //interval must be a block - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter(St_Einter(INTERVAL_NUMBER,INTERVAL_LINE), cur_st, stmt->controlParent()); - CloseInterval(); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } - else - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; - - case DVM_EXIT_INTERVAL_DIR: - if (perf_analysis > 1){ - //generating calls to 'einter' function of performance analizer - // (exit from user intervals) - - if(!St_frag){ - err("Misplaced directive",103,stmt); - break; - } - ExitInterval(stmt); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } - else - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; - - case DVM_MAP_DIR: - { int ind; - SgExpression *ps,*am,*index; - SgSymbol *s_tsk; - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - LINE_NUMBER_BEFORE(stmt,stmt); - where = stmt; //for inserting before current directive - ind = ndvm; - s_tsk = stmt->expr(0)->symbol(); - if(!stmt->expr(2)) // MAP ... ONTO ... - { index = Calculate(stmt->expr(0)->lhs()->lhs()); - if(!isSgValueExp(index) && !isSgVarRefExp(index)) - { doAssignStmt(index); - index = DVM000(ind); - } - PSReference(stmt); - ps = new SgArrayRefExp(*s_tsk,*new SgValueExp(1),*index); - cur_st->setExpression(0,*ps); - am = new SgArrayRefExp(*s_tsk,*new SgValueExp(2),*index); - doCallStmt(MapAM(am,ps)); - SET_DVM(ind); - } else // MAP ... BY ... - { SgExpression *section, *ev_tsk, *e_count; - SgSymbol *s_ind; - int ips,i_size, i_lps, ic; - SgStatement *dost; - s_tsk->addAttribute(TSK_AUTO, (void*) 1, 0); - section = stmt->expr(0)->lhs(); - i_size = ndvm; - doAssignStmt(GetSize(ParentPS(),0)); - // pr = psview(PSRef, rank, SizeArray, StaticSign) - ips = ndvm; - doAssignStmt(Reconf(DVM000(i_size), 1, 0)); - s_ind = loop_var[0]; //TASK_IND_VAR(s_tsk); - ev_tsk = new SgVarRefExp(s_ind); - ic = ndvm; - e_count = CountOfTasks(stmt); - doAssignStmt(e_count); - TestParamType(stmt); - doCallStmt(MapTasks(DVM000(ic),DVM000(i_size),new SgVarRefExp(stmt->expr(2)->symbol()),new SgVarRefExp(TASK_LPS_ARRAY(s_tsk)),new SgVarRefExp(TASK_HPS_ARRAY(s_tsk)),new SgVarRefExp(TASK_RENUM_ARRAY(s_tsk)))); - ps = new SgArrayRefExp(*s_tsk,*new SgValueExp(1),*ev_tsk); - am = new SgArrayRefExp(*s_tsk,*new SgValueExp(2),*ev_tsk); - dost = new SgForStmt(*s_ind,*new SgValueExp(1),*e_count,*MapAM(am,ps)); - where->insertStmtBefore(*dost); - cur_st = dost; - i_lps = ndvm; - doAssignStmtAfter( &(*new SgArrayRefExp(*TASK_LPS_ARRAY(s_tsk),*ev_tsk) - *new SgValueExp(1)) ); - doAssignStmtAfter( &(*new SgArrayRefExp(*TASK_HPS_ARRAY(s_tsk),*ev_tsk) - *new SgValueExp(1)) ); - doAssignTo_After(ps, CrtPS(DVM000(ips), i_lps, i_lps+1, 0) ); - cur_st = dost->lastNodeOfStmt(); - SET_DVM(i_size); - } - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } - break; - - case DVM_TASK_REGION_DIR: - if(in_task_region++) { - err("Nested TASK_REGION are not permitted", 100,stmt); - break; - } - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - if((stmt->lexNext()->variant() != DVM_ON_DIR) && (stmt->lexNext()->variant() != DVM_END_TASK_REGION_DIR) && (stmt->lexNext()->variant() != DVM_PARALLEL_TASK_DIR)) - err("Statement is outside of on-block",101,stmt->lexNext()); - LINE_NUMBER_AFTER(stmt,stmt); - //if(stmt->expr(0)) - Reduction_Task_Region(stmt); - //if(stmt->expr(1)) - Consistent_Task_Region(stmt); - task_region_st = stmt; - task_region_parent = stmt->controlParent(); //to test nesting blocks - task_lab = (SgLabel *) NULL; - task_ind = ndvm++; - if(dvm_debug) - DebugTaskRegion(stmt); - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - break; - - case DVM_END_TASK_REGION_DIR: - if(!in_task_region--) { - err("No matching TASK_REGION", 102,stmt); - break; - } - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - if(stmt->controlParent() != task_region_parent) //test of nesting blocks - err("Misplaced directive",103,stmt); - LINE_NUMBER_AFTER(stmt,stmt); - if(dvm_debug) - CloseTaskRegion(task_region_st,stmt); - EndReduction_Task_Region(stmt); - EndConsistent_Task_Region(stmt); - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - break; - - case DVM_ON_DIR: - if(in_task++) { - err("Nested ON-blocks are not permitted", 104,stmt); - break; - } - - if(inparloop){ - err("The directive is inside the range of PARALLEL loop",98, stmt); - break; - } - - if(!isSgArrayRefExp(stmt->expr(0)) || !stmt->expr(0)->symbol()) { - err("Syntax error",14, stmt); - break; - } - - on_stmt = stmt; - if(HEADER(stmt->expr(0)->symbol())) // ON construct - { - LINE_NUMBER_BEFORE(stmt,stmt); - in_on++; - break; - } - // ON construct - if(!in_task_region) - err("ON directive is outside of the task region", 105,stmt); - if( stmt->expr(0)->symbol()->attributes() & TASK_BIT) - { - LINE_NUMBER_AFTER(stmt,stmt); - task_lab = GetLabel(); - StartTask(stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - } - else - Error("'%s' is not task array", stmt->expr(0)->symbol()->identifier(),77,stmt); - break; - - case DVM_END_ON_DIR: - if(!in_task) { - err("No matching ON directive", 106,stmt); - break; - } else - in_task--; - if(in_task) //nested ON constructs - break; - - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - if(on_stmt && stmt->controlParent() != on_stmt->controlParent()) - err("Misplaced directive",103,stmt); - if(in_on) // end of ON construct - { - ReplaceOnByIf(on_stmt,stmt); - Extract_Stmt(on_stmt); // extracting DVM-directive (ON) - in_on--; - - if(dvm_debug) - { - SgStatement *std = dbg_if_regim ? CreateIfThenConstr(DebugIfCondition(),D_Skpbl()) : D_Skpbl(); - InsertNewStatementAfter(std,stmt,stmt->controlParent()); - cur_st = lastStmtOf(std); - } - Extract_Stmt(stmt); // extracting DVM-directive (END_ON) - stmt = cur_st; - break; - } - //end of ON construct - if((stmt->lexNext()->variant() != DVM_ON_DIR) && (stmt->lexNext()->variant() != DVM_END_TASK_REGION_DIR)) - err("Statement is outside of on-block",101,stmt->lexNext()); - LINE_NUMBER_AFTER(stmt,stmt); - doCallAfter(StopAM()); - InsertNewStatementAfter(new SgStatement(CONT_STAT),cur_st,stmt->controlParent()); - if(task_lab) - cur_st->setLabel(*task_lab); - FREE_DVM(1); - Extract_Stmt(stmt);// extracting DVM-directive (END_ON) - stmt = cur_st; - break; - - case DVM_RESET_DIR: - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - if(options.isOn(NO_REMOTE)) { - pstmt = addToStmtList(pstmt, stmt); - break; - } - LINE_NUMBER_AFTER(stmt,stmt); - doCallAfter(DeleteObject_H(GROUP_REF(stmt->symbol(),1))); - doAssignTo_After(GROUP_REF(stmt->symbol(),1),new SgValueExp(0)); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_PREFETCH_DIR: - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - if(options.isOn(NO_REMOTE)) { - pstmt = addToStmtList(pstmt, stmt); - break; - } - if(INTERFACE_RTS2) - err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); - - {SgStatement *if_st,*endif_st; - pref_st = addToStmtList(pref_st, stmt);//add to list of PREFETCH directive - if_st = doIfThenConstrForPrefetch(stmt); - cur_st = if_st->lexNext()->lexNext();//ELSE IF - endif_st = cur_st->lexNext()->lexNext(); //END IF - doAssignStmtAfter((stmt->symbol()->attributes() & INDIRECT_BIT) ? LoadIG(stmt->symbol()) : LoadBG(GROUP_REF(stmt->symbol(),1))); - doAssignTo_After(GROUP_REF(stmt->symbol(),3),new SgValueExp(1)); - cur_st = if_st;//IF THEN - doAssignTo_After(GROUP_REF(stmt->symbol(),1),(stmt->symbol()->attributes() & INDIRECT_BIT) ? CreateIG(0,1) : CreateBG(0,1)); - LINE_NUMBER_AFTER(stmt,stmt); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = endif_st; - } - break; - - /* case DVM_INDIRECT_ACCESS_DIR:*/ -/* - case DVM_OWN_DIR: - if(inparloop){ - err("The directive is inside the range of PARALLEL loop", 98,stmt); - break; - } - if(stmt->lexNext()->variant() == ASSIGN_STAT) - own_exe = 1; - else - err("OWN directive must precede an assignment statement",stmt); - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - - break; - */ - case DVM_PARALLEL_TASK_DIR: - { //SgForStmt *stdo; - SgExpression *el; - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - if(!in_task_region) - err("Parallel-task-loop directive is outside of the task region", 107,stmt); - if(in_task++) { - err("Nested ON-blocks are not permitted", 104,stmt); - break; - } - //stdo = isSgForStmt(stmt->lexNext()); - if(! isSgForStmt(stmt->lexNext())){ - err(" PARALLEL directive must be followed by DO statement",97,stmt); - //directive is ignored - break; - } - for(el=stmt->expr(1); el; el=el->rhs()) { - if(el->lhs()->variant() != ACC_PRIVATE_OP) - err("Illegal clause",150,stmt); - break; - } - task_do = stmt->lexNext(); - LINE_NUMBER_AFTER(stmt,stmt); - cur_st = task_do; - task_lab = GetLabel();//stdo->endOfLoop() - // task_do_ind = (loop_var_ind) - doAssignTo_After(new SgVarRefExp(task_do->symbol()),new SgArrayRefExp(*TASK_RENUM_ARRAY(stmt->expr(0)->symbol()),*new SgVarRefExp(loop_var[0]))); - task_do->setSymbol(*loop_var[0]); - StartTask(stmt); - pstmt = addToStmtList(pstmt, stmt); - //Extract_Stmt(stmt);// extracting DVM-directive - //stmt = cur_st; - } - break; - - case DVM_ASYNCWAIT_DIR: - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98, stmt); - if(INTERFACE_RTS2) - warn("Illegal directive/statement in -Opl2 mode. Asynchronous execution is replaced by a synchronous.", 649, stmt); - else - { - LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM - AsyncCopyWait(stmt->expr(0)); - } - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st;//setting stmt on last inserted statement - break; - - case DVM_ASYNCHRONOUS_DIR: - AnalyzeAsynchronousBlock(stmt); //analysis of ASYNCHRONOUS_ENDASYNCHRONOUS block - inasynchr++; - async_id = stmt->expr(0); - if(inparloop) - err("The directive is inside the range of PARALLEL loop",98, stmt); - if(INTERFACE_RTS2) - warn("Illegal directive/statement in -Opl2 mode. Asynchronous execution is replaced by a synchronous.", 649, stmt); - pstmt = addToStmtList(pstmt, stmt); - break; - - case DVM_ENDASYNCHRONOUS_DIR: - inasynchr--; - if(inparloop) - err("The directive is inside the range of PARALLEL loop",98, stmt); - pstmt = addToStmtList(pstmt, stmt); - break; - - case DVM_F90_DIR: - if(inparloop) { - err("The directive is inside the range of PARALLEL loop",98, stmt); - break; - } - if(!inasynchr) - err("Misplaced directive",103,stmt); - AsynchronousCopy(stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt=cur_st; - break; - - case DVM_TEMPLATE_CREATE_DIR: - LINE_NUMBER_BEFORE(stmt,stmt); - Template_Create(stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - break; - - case DVM_TEMPLATE_DELETE_DIR: - LINE_NUMBER_BEFORE(stmt,stmt); - Template_Delete(stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - break; - - case DVM_TRACEON_DIR: - InsertNewStatementAfter(new SgCallStmt(*fdvm[TRON]),stmt,stmt->controlParent()); - LINE_NUMBER_AFTER(stmt,stmt); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_TRACEOFF_DIR: - InsertNewStatementAfter(new SgCallStmt(*fdvm[TROFF]),stmt,stmt->controlParent()); - LINE_NUMBER_AFTER(stmt,stmt); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_BARRIER_DIR: - doAssignStmtAfter(Barrier()); - FREE_DVM(1); - LINE_NUMBER_AFTER(stmt,stmt); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_CHECK_DIR: - if(check_regim) { - cur_st = Check(stmt); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } else - pstmt = addToStmtList(pstmt, stmt); - break; - - case DVM_DEBUG_DIR: - { int num; - /* - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - */ - if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) - err("Illegal fragment number",181,stmt); - else if(debug_fragment || perf_fragment) - BeginDebugFragment(num,stmt); - - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - } - break; - case DVM_ENDDEBUG_DIR: - { int num; - /* - if(inparloop) - err("The directive is inside the range of PARALLEL loop", 98,stmt); - */ - if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) - err("Illegal fragment number",181,stmt); - else if((debug_fragment || perf_fragment) && ((cur_fragment && cur_fragment->No != num) || !cur_fragment)) - err("Unmatched directive",182,stmt); - else { - if(cur_fragment && cur_fragment->begin_st && (stmt->controlParent() != cur_fragment->begin_st->controlParent())) - err("Misplaced directive",103,stmt); //fragment must be a block - EndDebugFragment(num); - } - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - } - break; - - case DVM_IO_MODE_DIR: - IoModeDirective(stmt,io_modes_str,WITH_ERR_MSG); - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; - case OPEN_STAT: - Open_Statement(stmt,io_modes_str,WITH_ERR_MSG); - stmt = cur_st; - break; - case CLOSE_STAT: - Close_Statement(stmt,WITH_ERR_MSG); - stmt = cur_st; - break; - case INQUIRE_STAT: - Inquiry_Statement(stmt,WITH_ERR_MSG); - stmt = cur_st; - break; - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - FilePosition_Statement(stmt,WITH_ERR_MSG); - stmt = cur_st; - break; - case WRITE_STAT: - case READ_STAT: - ReadWrite_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case PRINT_STAT: - Any_IO_Statement(stmt); - ReadWritePrint_Statement(stmt,WITH_ERR_MSG); - stmt = cur_st; - break; - - case DVM_CP_CREATE_DIR: /*Check Point*/ - CP_Create_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case DVM_CP_SAVE_DIR: - CP_Save_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case DVM_CP_LOAD_DIR: - CP_Load_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case DVM_CP_WAIT_DIR: - CP_Wait(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; /*Check Point*/ - - case FOR_NODE: - if(HPF_program) - SetDoVar(stmt->symbol()); - if(perf_analysis == 4 && !IN_COMPUTE_REGION) - SeqLoopBegin(stmt); - if(dvm_debug) - DebugLoop(stmt); - else - { - ChangeDistArrayRef(stmt->expr(0)); - ChangeDistArrayRef(stmt->expr(1)); - } - default: - break; - } - - // analyzing of loop end statement - { - SgStatement *end_stmt; - end_stmt = isSgLogIfStmt(stmt->controlParent()) ? stmt->controlParent() : stmt; - if(inparloop && isParallelLoopEndStmt(end_stmt,par_do)) - - { //stmt is last statement of parallel loop or is body of logical IF , which - // is last statement - EndOfParallelLoopNest(stmt,end_stmt,par_do,func); - inparloop = 0; // end of parallel loop nest - stmt = cur_st; - //SET_DVM(iplp); - continue; - } // end of processing last statement of parallel loop - //printf("!!! end parallel loop %d\n",end_stmt->lineNumber()); - if(HPF_program && isDoEndStmt(end_stmt)) - OffDoVarsOfNest(end_stmt); - - if(task_do && isDoEndStmt(end_stmt) && end_stmt->controlParent() == task_do){ - SgStatement *st; - st=ReplaceDoLabel(end_stmt,task_lab); - if(st) { - BIF_LABEL(st->thebif) = NULL; - stmt = st; - InsertNewStatementBefore (StopAM(),st); - st->setLabel(*task_lab); - - } else {//ENDDO - InsertNewStatementBefore (StopAM(),stmt); - } - in_task--; - } - - if(dvm_debug){ - if( isDoEndStmt_f90(stmt)) { - //on debug regim logical IF may not be end of loop - CloseLoop(stmt); - stmt = cur_st; - } - } - else if(perf_analysis && close_loop_interval) - if(isDoEndStmt_f90(end_stmt)){ - SeqLoopEnd(end_stmt,stmt); - stmt = cur_st; - } - - } // end of processing last statement of loop nest - - } // end of processing executable statement/directive - -END_: // end of program unit - //checking: is in program unit any enclosed DVM-construct? - if(in_task_region) - err("Missing ENDTASK_REGION directive",108,stmt); - if(in_task) - err("Missing ENDON directive",109,stmt); -//checking: is in program unit any enclosed ACC-construct? /*ACC*/ - if(cur_region) /*ACC*/ - { if( cur_region->is_data) - err("Missing END DATA REGION directive",602,stmt); - else - err("Missing END REGION directive",603,stmt); - } - -// for declaring dvm000(N) is used maximal value of ndvm - SET_DVM(ndvm); - cur_st = first_dvm_exec; - if(last_dvm_entry) - lentry = last_dvm_entry->lexNext(); // lentry - statement following first_dvm_exec or last generated dvm-initialization statement(before first_exec) - // before first_exec may be new statements generated for first_exec - if(!IN_MODULE) { - if(has_contains) - MarkCoeffsAsUsed(); - InitBaseCoeffs(); - InitRemoteGroups(); - InitShadowGroups(); - InitRedGroupVariables(); - WaitDirList(); - if(IN_MAIN_PROGRAM) - EnterDataRegionForVariablesInMainProgram(begin_block ? begbl : dvmh_init_st); /*ACC*/ - else - EnterDataRegionForLocalVariables(begin_block ? begbl : cur_st, first_exec, begin_block); /*ACC*/ - DoStmtsForENTRY(first_dvm_exec,lentry); // copy the previously generated statements for each ENTRY - // except for statements generated for the first executable statement if it is DVM-directive - UnregisterVariables(begin_block); // close data region before exit from the procedure - - fmask[FNAME] = 0; - stmt = data_stf ? data_stf->lexPrev() : first_dvm_exec->lexPrev(); - DeclareVarDVM(stmt,stmt); - CheckInrinsicNames(); - - } else { - if(mod_proc){ - cur_st = end_of_unit->lexPrev(); - InitBaseCoeffs(); - MayBeDeleteModuleProc(mod_proc,end_of_unit); - } - fmask[FNAME] = 0; - nloopred = nloopcons = MAX_RED_VAR_SIZE; - stmt= mod_proc ? has_contains->lexPrev() : first_dvm_exec->lexPrev(); - DeclareVarDVM(stmt, (mod_proc ? mod_proc : stmt)); - } - - Extract_Stmt(first_dvm_exec); //extract fname() call - for(;pstmt; pstmt= pstmt->next) - Extract_Stmt(pstmt->st);// extracting DVM Directives and - //statements (inside the range of ASYNCHRONOUS construct) - if(ACC_program==0 && debug_regim) - if(cur_func->expr(2) && cur_func->expr(2)->variant() == PURE_OP) - cur_func->setExpression(2, NULL); // removing PURE attribute from procedure header - return; -} - - -int DeleteDArFromList(SgStatement *stmt) -{ SgExpression *el,*preve,*pl,*opl,*dvm_list, *dvml; - SgSymbol * s; - int ia,is_assign; - - if(stmt->variant() == SAVE_DECL || stmt->variant() == OPTIONAL_STMT || stmt->variant() == PRIVATE_STMT || stmt->variant() == PUBLIC_STMT) //|| stmt->variant() == INTENT_STMT deleted 28.06.21 - return(1); - - pl = stmt->expr(0); - preve = 0; - is_assign = 0; - dvm_list = NULL; - for(el=stmt->expr(0); el; el=el->rhs()) { - if(el->lhs()->variant() == ASSGN_OP || el->lhs()->variant() == POINTST_OP) is_assign = 1;//with initial value - s = el->lhs()->symbol(); - if(s) { - if((debug_regim || IN_MAIN_PROGRAM) && !in_interface && IS_ARRAY(s) ) - registration = AddNewToSymbList( registration, s); - if(!strcmp(s->identifier(),"heap") && el->lhs()->lhs()) - // heap_ar_decl = el->lhs(); - //heap_ar_decl->setSymbol(*heapdvm); - heap_ar_decl = new SgArrayRefExp(*heapdvm); - // heap_ar_decl = el->lhs()->lhs(); - ia = s->attributes(); - if(IS_GROUP_NAME(s)) - Error("Inconsistent declaration of identifier: %s",s->identifier(),16,stmt); - - if(((ia & DISTRIBUTE_BIT) || (ia & ALIGN_BIT) || (ia & INHERIT_BIT)) && !(ia & DVM_POINTER_BIT) || (ia & HEAP_BIT) || !strcmp(s->identifier(),"heap") ){ - el->lhs()->setLhs(NULL); - if(stmt->variant() == POINTER_STMT || stmt->variant() == TARGET_STMT || stmt->variant() == STATIC_STMT) - continue; - dvml = new SgExprListExp(el->lhs()->copy()); - dvml->setRhs(dvm_list); - dvm_list = dvml; - - if(preve) - preve->setRhs( el->rhs()); - else - pl = el->rhs(); - } - else - preve = el; - } - else - preve = el; - } - if(stmt->variant() == VAR_DECL && dvm_list) { - for( opl = stmt->expr(2); opl; opl=opl->rhs()) //looking through the option list and generating new statements - NewSpecificationStatement(opl->lhs(),dvm_list,stmt); - } - if(is_assign && stmt->variant() == VAR_DECL && !stmt->expr(2)) - stmt->setVariant(VAR_DECL_90); - - if(pl) { - stmt->setExpression(0, *pl); - return (1); - } - else // variable list is empty - return (0); - -} - - -int DeleteHeapFromList(SgStatement *stmt) -{ SgExpression *el,*ec,*preve,*pl, *prcl, *cl; - SgSymbol * s; - int ia; - // stmt is COMMON statement - prcl = NULL; - cl = stmt->expr(0); - for(ec=stmt->expr(0); ec; ec=ec->rhs()) {// looking through COMM_LIST - pl = ec->lhs(); - preve = NULL; - for(el=ec->lhs(); el; el=el->rhs()) { - s = el->lhs()->symbol(); - if(s) { - ia = s->attributes(); - if( (ia & HEAP_BIT) || !strcmp(s->identifier(),"heap") ){ - if(preve) - preve->setRhs( el->rhs()); - else - pl = el->rhs(); - } - else - preve = el; - } - else - preve = el; - } //end of loop el - if(pl) { - ec->setLhs(pl); - prcl = ec; - } - else {// common variable list is empty - if(prcl) - prcl->setRhs(ec->rhs()); - else - cl = ec->rhs(); - } - } - if(cl) { - stmt->setExpression(0, *cl); - return(1); - } - else // COMM_LIST is empty - return(0); -} - -void NewSpecificationStatement(SgExpression *op, SgExpression *dvm_list, SgStatement *stmt) -{SgStatement *st; - switch(op->variant()){ - case PUBLIC_OP: - st = new SgStatement(PUBLIC_STMT); - break; - case PRIVATE_OP: - st = new SgStatement(PRIVATE_STMT); - break; -// 28.06.21 -// case IN_OP: -// case OUT_OP: -// case INOUT_OP: -// st = new SgStatement(INTENT_STMT); -// st->setExpression(1, op->copy()); -// break; - case SAVE_OP: - st = new SgStatement(SAVE_DECL); - break; - case OPTIONAL_OP: - st = new SgStatement(OPTIONAL_STMT); - break; - case POINTER_OP: - st = new SgStatement(POINTER_STMT); - break; - case TARGET_OP: - st = new SgStatement(TARGET_STMT); - break; - case STATIC_OP: - st = new SgStatement(STATIC_STMT); - break; - default: st = NULL; - } - if(st){ - st->setExpression(0,*dvm_list); - stmt->insertStmtBefore(*st, *stmt->controlParent()); - } -} - -int DeferredShape(SgExpression *eShape) -{ - SgExpression *el; - SgSubscriptExp *sbe; - for(el=eShape; el; el=el->rhs()) - { - if ((sbe=isSgSubscriptExp(el->lhs())) != NULL && !sbe->ubound() && !sbe->lbound()) - continue; - else - return 0; - } - return 1; -} - -void TemplateDeclarationTest(SgStatement *stmt) -{ - SgExpression *eol; - SgSymbol *symb; - for(eol=stmt->expr(0); eol; eol=eol->rhs()) { //testing object list - symb=eol->lhs()->symbol(); - if(IS_DUMMY(symb)) - Error("Template may not be a dummy argument: %s",symb->identifier(), 80,stmt); - if(DeferredShape(eol->lhs()->lhs())) - symb->addAttribute(DEFERRED_SHAPE,(void*)1,0); - if(IN_COMMON(symb) && IN_MODULE) - { - SYMB_ATTR(symb->thesymb) = SYMB_ATTR(symb->thesymb) & (~COMMON_BIT); - Warning("COMMON attribute is ignored: %s",symb->identifier(), 641,stmt); - } - } -} - -void CreateArray_RTS2(SgSymbol *das, int indh, SgStatement *stdis) -{ - int rank = Rank(das); - SgExpression *shape_list = DEFERRED_SHAPE_TEMPLATE(das) ? NULL : doDvmShapeList(das,stdis); - if(IS_TEMPLATE(das)) - { - // adding to the Template_array Symbol the attribute (ARRAY_HEADER) - // with integer value "indh" //"iamv" - ArrayHeader(das,indh); // or 2 - SgExpression *array_header = HeaderRef(das); - das->addAttribute(RTS2_CREATED, (void*) 1, 0); - if(!DEFERRED_SHAPE_TEMPLATE(das)) - doCallStmt(DvmhTemplateCreate(das,array_header,rank,shape_list)); - } - else - { - // create dvm-array - ArrayHeader(das,indh); - SgExpression *array_header = HeaderRef(das); - SgExpression *shadow_list = DeclaredShadowWidths(das); - doCallStmt(DvmhArrayCreate(das,array_header,rank,ListUnion(shape_list,shadow_list))); - if(!HAS_SAVE_ATTR(das) && !IN_MODULE) - doCallStmt(ScopeInsert(array_header)); - } -} - -void GenDistArray (SgSymbol *das, int idisars, SgExpression *distr_rule_list, SgExpression *ps, SgStatement *stdis) { - - int iamv,rank,iaxis,ileft,iright,ifst,indh; - SgExpression *am_view = NULL, *array_header, *size_array; - - int ia,sign,re_sign,postponed_root; - SgStatement *savest; - - savest = where; - ifst = ndvm; - pointer_in_tree = 0; - postponed_root = 0; - indh = 1; - - if(IS_POINTER(das)) { //is POINTER - ArrayHeader(das,0); - loc_distr = 1; // POINTER is local object - goto TREE_; - } - if(IS_ALLOCATABLE(das)) { // ALLOCATABLE - ArrayHeader(das,-2); - loc_distr = 1; // ALLOCATABLE is local object - goto TREE_; - } - - if(IS_DUMMY(das)) { //is dummy argument - ArrayHeader(das,1); - //ReplaceArrayBounds(das); - goto TREE_; - } - if(IS_POINTER_F90(das)) { // POINTER F90 - ArrayHeader(das,-2); - if(!IS_DUMMY(das)) - loc_distr = 1; - goto TREE_; - } - if(IN_COMMON(das)) // COMMON-block element or TEMPLATE_COMMON - if(das->scope()->variant() != PROG_HEDR) { // is not in MAIN-program - //if(stdis->controlParent()->variant() != PROG_HEDR) - - if(IS_TEMPLATE(das)) - { - if(idisars == -1) { //interface of RTS2 - das->addAttribute(RTS2_CREATED, (void*) 1, 0); - // ArrayHeader(das,1); - } //else - ArrayHeader(das,2); - } else - ArrayHeader(das,1); - goto TREE_; - } - //if(DEFERRED_SHAPE_TEMPLATE(das) - - if((das->attributes() & SAVE_BIT) || (saveall && (!IN_COMMON(das))) - || ORIGINAL_SYMBOL(das)->scope()->variant() == MODULE_STMT) { - SgStatement *if_st; - if_st = doIfThenConstr(das); - //first_exec = if_st->lexNext(); // reffer to ENDIF statement - where = if_st->lexNext(); // reffer to ENDIF statement - } - - LINE_NUMBER_BEFORE(stdis,where); // for tracing set the global variable of LibDVM to - // line number of statement(stdis) - ia = das->attributes(); - //if(ia & DYNAMIC_BIT && IS_SAVE(das)) - // Error ("Saved object may not have the DYNAMIC attribute: %s", das->identifier(), 111,stdis); - - rank = Rank(das); - if(ndis && rank && rank != ndis) - Error ("Rank of array %s is not equal to the length of the dist_format_list", das->identifier(), 110,stdis); - - if((ia & SAVE_BIT) || saveall || IN_MODULE) - sign = 1; - else - sign = 0; - if(ia & TEMPLATE_BIT) { //!!! must be changed - if(ia & ALIGN_BASE_BIT) - sign = 1; - else { //template is not used in ALIGN or REALIGN directive - //(is used only in parallel directive) - sign = 2; - loc_templ_symb=AddToSymbList(loc_templ_symb,das); - } - } - if(ia & POSTPONE_BIT) - indh = -1; - - if(idisars == -1) { //interface of RTS2 - CreateArray_RTS2(das,indh,stdis); - // distribute dvm-array - if(!(ia & POSTPONE_BIT)) //distr_rule_list!=NULL - doCallStmt(DvmhDistribute(das,rank,distr_rule_list)); - where = savest; - goto TREE_; - } - // interface of RTS1 - if(DEFERRED_SHAPE_TEMPLATE(das)) - { - iamv = ndvm; ifst = iamv+1; - ArrayHeader(das,iamv); - doAssignStmt(new SgValueExp(0)); - doAssignTo(HeaderRef(das),DVM000(iamv)); // t = AMViewRef - where = savest; - goto TREE_; - } - -// dvm000(i) = crtamv(AMRef, rank, SizeArray, StaticSign) -// crtamv() creates current Abstract_Machine view - size_array = doSizeArray(das,stdis); - if(!rank) //distributee is not array - size_array = new SgValueExp(0); // for continuing translation of procedure - - iamv = ndvm; ifst = iamv+1; - if(ia & POSTPONE_BIT){ - //indh = -1; - if(ia & TEMPLATE_BIT) - //dvm000(i) = 0; (AMViewRef = 0) - doAssignStmt(new SgValueExp(0)); - else - ifst = ndvm; - } else { - am_view = LeftPart_AssignStmt(CreateAMView(size_array, rank, sign)); - if(mult_block) - doAssignStmt(MultBlock(am_view, mult_block, ndis)); - //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) - // genbli sets on the weights of elements of processor system - if(gen_block == 1) - doAssignStmt(GenBlock(ps,am_view, idisars+2*nblock,nblock)); - if(gen_block == 2) - doAssignStmt(WeightBlock(ps,am_view, idisars+2*nblock, idisars+3*nblock,nblock)); - //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) - // DisAM distributes resourses of parent (current) AM between children - doAssignStmt(DistributeAM(am_view, ps, nblock, idisars, idisars+nblock)); - if(mult_block) - doAssignStmt(MultBlock(am_view, mult_block, 0)); - } - -//if distributed object isn't template then -// 1) create distribute array (CrtDa) -// 2) align distribute array with AM view: -// align (i1,...,ik) with AM(i1,...,ik):: dist_array - - - if(! (ia & TEMPLATE_BIT)) { - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, dosn't allocate array - - ArrayHeader(das,indh); - array_header = HeaderRef(das); - //creating LeftBSizeArray and RightBSizeArray - ileft = ndvm; - iright = BoundSizeArrays(das); - if(ia & DYNAMIC_BIT) - re_sign = 3; - else - re_sign = 0; - - StoreLowerBoundsPlus(das,NULL); - - doAssignStmt(CreateDistArray(das,array_header,size_array,rank,ileft,iright,sign,re_sign)); - - //ndvm--; // CrtDa result is exit code, test and free - - if(!(ia & POSTPONE_BIT)) { - - // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, - // Axis Array,Coeff Array),Const Array) - //function AlgnDA alignes the array according to aligning template - //actually AlgnDA distributes aligned array elements between virtual - //processors - iaxis = ndvm; - doAlignRule_1(rank); - // doAlignRule_1(axis_array,coeff_array,const_array); - doAssignStmt(AlignArray(array_header, am_view, iaxis, iaxis+rank, iaxis+2*rank)); - - // AlgnDA result is exit code, isn't used */ - // axis_array, coeff_array and const_array arn't used more - } - SET_DVM(ileft); - - //doAssignTo(header_ref(das,rank+2),HeaderNplus1(das)); - // calculating HEADER(rank+1) - } - else - - // adding to the Template_array Symbol the attribute (ARRAY_HEADER) - // with integer value "iamv" - { - ArrayHeader(das,iamv); - doAssignTo(HeaderRef(das),DVM000(iamv)); // t = AMViewRef - if(IN_COMMON(das)) - StoreLowerBoundsPlus(das,NULL); - } - where = savest; //first_exec; - -TREE_: -// Looking through the Align Tree of distributed array - if(das->numberOfAttributes(ALIGN_TREE)) {//there are any align statements - algn_attr * attr; - align * root; - - postponed_root = (das->attributes() & POSTPONE_BIT); - attr = (algn_attr *) das->attributeValue(0,ALIGN_TREE); - root = attr->ref; // reference to root of align tree - // test: attr->type == ROOT ???? - // for(node=root->alignees; node; node=node->next) - AlignTree(root); - } - if(!pointer_in_tree && !postponed_root) // there are not any allocatable aligned arrays in alignment_tree - {SET_DVM(ifst);} -//end GenDistArray -} - -/* -void RedistributeArray_RTS2(das,headref,*distr_rule_list,stdis) -{ - if(ia & POSTPONE_BIT) { - SgStatement *if_st,*end_if; - SgExpression *size_array; - int iaxis; - int iamv = INDEX(das); - if_st = doIfThenConstrForRedis(headref,stdis,iamv); - where = end_if = if_st->lexNext()->lexNext(); // reffer to ENDIF statement - - int ia = das->attributes(); - int rank = Rank(das); - - // distribute dvm-array - if(distr_rule_list!=NULL) - doCallStmt(DvmhDistribute(das,rank,distr_rule_list)); - } - else { - - - } -} -*/ - -void RedistributeArray(SgSymbol *das, int idisars, SgExpression *distr_rule_list, SgExpression *ps, int sign, SgExpression *dasref, SgStatement *stdis) -{ int rank,ia; - SgExpression *headref, *stre; - rank = Rank(das); - headref = IS_POINTER(das) ? PointerHeaderRef(dasref,1) : HeaderRef(das); - if(isSgRecordRefExp(dasref)) - { stre = & (dasref->copy()); - stre-> setLhs(headref); - headref = stre; - } - if(rank && rank != ndis) - Error ("Rank of array '%s' isn't equal to the length of the dist_format_list",das->identifier(), 110,stdis); - - ia=das->attributes(); - if(!(ia & DYNAMIC_BIT) && !(ia & POSTPONE_BIT)) - Error (" '%s' hasn't the DYNAMIC attribute",das->identifier(), 113,stdis); - if(!(ia & DISTRIBUTE_BIT) && !(ia & INHERIT_BIT)) - Error (" '%s' does not appear in DISTRIBUTE/INHERIT directive ",das->identifier(), 114,stdis); - if(ia & ALIGN_BIT) - Error ("A distributee may not have the ALIGN attribute: %s",das->identifier(), 54, stdis); - if(!HEADER(das)) { - Error("'%s' isn't distributed array", das->identifier(), 72,stdis); - return; - } - - if(idisars==-1) // indirect distribution => interface of RTS2 - { - //RedistributeArray_RTS2(das,headref,distr_rule_list,stdis); - doCallStmt(DvmhRedistribute(das,rank,distr_rule_list)); - doAssignTo(HeaderRefInd(das,HEADER_SIZE(das)),new SgValueExp(1)); // Header(HEADER_SIZE) = 1 => the array has been distributed already - return; - } - - if(ia & POSTPONE_BIT){ - SgStatement *if_st,*end_if; - SgExpression * size_array, *am_view, *amvref, *headref_flag; - int i1,st_sign,iaxis,iamv; - iamv = INDEX(das); - if(ia & TEMPLATE_BIT) //TEMPLATE ( iamv>1 ) - headref_flag = headref; - else - headref_flag = IS_POINTER(das) ? PointerHeaderRef(dasref,HEADER_SIZE(das)) : HeaderRefInd(das,HEADER_SIZE(das)); - if_st = doIfThenConstrForRedis(headref_flag,stdis,iamv); /*08.05.17*/ - where = end_if = if_st->lexNext()->lexNext(); // reffer to ENDIF statement - i1 = ndvm; - if(ACC_program || parloop_by_handler) /*ACC*/ - where->insertStmtBefore(*Redistribute_H(headref,sign),*where->controlParent()); - amvref = (ia & TEMPLATE_BIT) ? headref : GetAMView( headref); - //inserting after ELSE - if(mult_block) - doAssignStmt(MultBlock(amvref, mult_block, ndis)); - //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) - // genbli sets on the weights of processor system elements - if(gen_block == 1) - doAssignStmt(GenBlock(ps,amvref, idisars+2*nblock,nblock)); - if(gen_block == 2) - doAssignStmt(WeightBlock(ps,amvref,idisars+2*nblock,idisars+3*nblock,nblock)); - doCallStmt(RedistributeAM(headref, ps, nblock,idisars,sign)); - if(mult_block) - doAssignStmt(MultBlock(amvref, mult_block, 0)); - where = if_st->lexNext(); // reffer to ELSE statement - //inserting after IF (...) THEN - if (DEFERRED_SHAPE_TEMPLATE(das)) - am_view = DVM000(INDEX(das)); - else - { - if(ia & TEMPLATE_BIT) - size_array = doSizeArray(das,stdis); - else - size_array = doSizeArrayQuery( IS_POINTER(das) ? headref : HeaderRefInd(das,1),rank); - if(!rank) //distributee is not array - size_array = new SgValueExp(0); // for continuing translation of procedure - - // dvm000(i) = crtamv(AMRef, rank, SizeArray, StaticSign) - //crtamv creates current Abstract_Machine view - - if((ia & SAVE_BIT) || saveall || IN_COMMON(das) || das->scope() != cur_func || IS_BY_USE(das) ) - st_sign = 1; - else - st_sign = 0; - if(iamv <= 1) // is not TEMPLATE - iamv = ndvm++; - am_view = DVM000(iamv); - doAssignTo(am_view,CreateAMView(size_array, rank, st_sign)); - } - - if(mult_block) - doAssignStmt(MultBlock(am_view, mult_block, ndis)); - //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) - // genbli sets on the weights of elements of processor system - if(gen_block == 1) - doAssignStmt(GenBlock(ps,am_view, idisars+2*nblock,nblock)); - if(gen_block == 2) - doAssignStmt(WeightBlock(ps,am_view, idisars+2*nblock, idisars+3*nblock,nblock)); - //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) - // DisAM distributes resourses of parent (current) AM between children - doAssignStmt(DistributeAM(am_view,ps,nblock,idisars,idisars+nblock)); - if(mult_block) - doAssignStmt(MultBlock(am_view, mult_block, 0)); - if (!(ia & TEMPLATE_BIT)) { - // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, - // Axis Array,Coeff Array,Const Array) - //function AlgnDA alignes the array according to aligning template - //actually AlgnDA distributes aligned array elements between virtual - //processors - iaxis = ndvm; - doAlignRule_1(rank); - doAssignStmt(AlignArray( headref, am_view, iaxis, iaxis+rank, iaxis+2*rank)); - doAssignTo(headref_flag, new SgValueExp(1)); // Header(HEADER_SIZE) == 1 => the array has been distributed already - } else - doAssignTo(headref,am_view); // t = AMViewRef - // Looking through the Align Tree of distributed array - if(das->numberOfAttributes(ALIGN_TREE) && !IS_ALLOCATABLE_POINTER(das)) {//there are any align statements - algn_attr * attr; - align * root; - attr = (algn_attr *) das->attributeValue(0,ALIGN_TREE); - root = attr->ref; // reference to the root of align tree - AlignTreeAlloc(root,stdis); - } - SET_DVM(i1); - cur_st = end_if; // => where 10.12.12 ; - where = stdis; //10.12.12 - } - else { - SgExpression *amvref; - - if(ACC_program || parloop_by_handler) /*ACC*/ - where->insertStmtBefore(*Redistribute_H(headref,sign),*where->controlParent()); - - amvref = (ia & TEMPLATE_BIT) ? headref : GetAMView( headref); - if(mult_block) - doAssignStmt(MultBlock(amvref, mult_block, ndis)); - if(gen_block == 1) - // genbli sets on the weights of processor system elements - doAssignStmt(GenBlock(ps,amvref, idisars+2*nblock,nblock)); - if(gen_block == 2) - doAssignStmt(WeightBlock(ps,amvref,idisars+2*nblock,idisars+3*nblock,nblock)); - doCallStmt(RedistributeAM(headref,ps,nblock,idisars,sign)); - //doAssignTo_After(header_ref(das,rank+2),HeaderNplus1(das)); - // calculating HEADER(rank+1) - if(mult_block) - doAssignStmt(MultBlock(amvref, mult_block, 0)); - } -} - -void AlignTree( align *root) { - align *node; - int nr,iaxis,ia; - SgStatement *stalgn; - int pointer_is; - stalgn = NULL; - pointer_is = 0; - iaxis = 0; - for(node=root->alignees; node; node=node->next) { - if (stalgn != node->align_stmt) { - if(IN_COMMON(node->symb) && (node->symb->scope()->variant() != PROG_HEDR) || !CURRENT_SCOPE(node->symb)) - { stalgn = NULL; ia = -1;} - else { - stalgn = node->align_stmt; - iaxis = ndvm; ia = 0; - } - } - else if(!INDEX(root->symb) || pointer_is || (INDEX(root->symb)==-1)) - { iaxis = ndvm; ia = 0;} - else - ia = iaxis; - if(IS_ALLOCATABLE(node->symb) || (IS_ALLOCATABLE(root->symb) && CURRENT_SCOPE(root->symb))) - ia = -2; //doAlignRule is empty: align rules are not generated - if(IS_POINTER_F90(node->symb) || (IS_POINTER_F90(root->symb) && !IS_DUMMY(root->symb) && CURRENT_SCOPE(root->symb))) - ia = -2; //doAlignRule is empty: align rules are not generated - SgExpression *align_rule_list = doAlignRules(node->symb,node->align_stmt,ia,nr);// creating axis_array, - // coeff_array and const_array - GenAlignArray(node,root, nr, align_rule_list, iaxis); - pointer_is = IS_POINTER(node->symb) || IS_ALLOCATABLE_POINTER(node->symb); - AlignTree(node); - } -} - - -void GenAlignArray(align *node, align *root, int nr, SgExpression *align_rule_list, int iaxis) { - -// 1) creates Distribute Array for "node" -// 2) alignes Distribute Array with Distribute Array for "root" or with Template - -// To array symbol added attribute ARRAY_HEADER (by function ArrayHeader): -// 0, for DVM-pointer -// -1, for array with postponed allignment and for array allined with one or DVM-pointer -// -2, for ALLOCATABLE array -// 1, for other arrays - - int rank,ileft,iright,isize; - int sign,re_sign,ia,indh; - SgSymbol *als; - SgExpression *array_header,*size_array; - SgStatement *savest; - //st = first_exec; // store first_exec - savest = where; - als = node->symb; - ia = als->attributes(); - - // for debug - //printf("%s\n", als->identifier()); - // - - if(IS_POINTER(als)) { //alignee is POINTER - - int *index = new int [2]; - *index = iaxis; - *(index+1) = nr; - als-> addAttribute(ALIGN_RULE, (void*) index, 2*sizeof(int)); - - ArrayHeader(als,0); - loc_distr = 1; //POINTER is local object - pointer_in_tree = 1; - return; - } - if(IS_ALLOCATABLE(als)) { //alignee is ALLOCATABLE array - - // int *index = new int [2]; - // *index = 0; //iaxis; - // *(index+1) = nr; - // als-> addAttribute(ALIGN_RULE, (void*) index, 2*sizeof(int)); - - ArrayHeader(als,-2); - loc_distr = 1; //ALLOCATABLE array is local object - pointer_in_tree = 1; - return; - } - if(IS_POINTER_F90(als)) { // POINTER F90 - if(IS_DUMMY(als)) - ArrayHeader(als,1); - else{ - ArrayHeader(als,-2); - pointer_in_tree = 1; - loc_distr = 1; - } - return; - } - - if(root){ - indh = INDEX(root->symb); - if(CURRENT_SCOPE(root->symb) && ((indh == 0) || (indh == -1) || ((indh > 1) && (root->symb->attributes() & POSTPONE_BIT)))) { - //align-target is allocatable array: it is aligned directly - // or indirectly with POINTER - //or - //align-target is "postponed" array:it is aligned directly - // or indirectly with array having POSTPONE_BIT attribute - // or - // align-target is TEMPLATE with POSTPONE_BIT - int *index = new int [2]; - *index = iaxis; - *(index+1) = nr; - als-> addAttribute(ALIGN_RULE, (void*) index, 2*sizeof(int)); - - ArrayHeader(als,-1); - indh = -1; - } else - ArrayHeader(als,1); - - if(root && IS_ALLOCATABLE(root->symb) && CURRENT_SCOPE(root->symb)) { - Error("Array '%s' may not be alligned with ALLOCATABLE array",als->identifier(),401,node->align_stmt); - return; - } - - } else { - ArrayHeader(als,-1); // with POSTPONE_BIT - indh = 1; - } - - - if(IS_TEMPLATE(als)){ - Error("Template '%s' appears as an alignee",als->identifier(),116,node->align_stmt); - return; - } - if(IS_DUMMY(als)) { //alignee is dummy argument - if(!root) return; - if(!IS_DUMMY(root->symb)){ // align-target is local array - if(!IN_COMMON(root->symb) && CURRENT_SCOPE(root->symb)) - Error("Dummy argument '%s' is aligned with a local array", als->identifier(),117, node->align_stmt); - } - else - if(warn_all) - warn("Associated actual arguments must be aligned",177,node->align_stmt); - return; - } - - if(IN_COMMON(als)){ // COMMON-block element - if(root && !IN_COMMON(root->symb) && (root->symb->scope()->variant() != PROG_HEDR)) { - //align-target is not in COMMON and its scope is not MAIN-program - Error("Aligned array '%s' is in COMMON but align-target is not", als->identifier(), 118,node->align_stmt); - return; - } - if(als->scope()->variant() != PROG_HEDR) // is not in MAIN-program - return; - } - if(indh <= 0 && root && CURRENT_SCOPE(root->symb)) //align-target is allocatable or "postponed" array /podd 31.05.08/ - return; - - if(IS_SAVE(als)) { // has SAVE attribute - if(root && !IS_TEMPLATE(root->symb) && !IN_COMMON(root->symb) && !HAS_SAVE_ATTR(root->symb) && CURRENT_SCOPE(root->symb) ) { - Error("Aligned array '%s' has SAVE attribute but align-target has not", als->identifier(),119,node->align_stmt); - return; - } - } - if(IS_SAVE(als) || ORIGINAL_SYMBOL(als)->scope()->variant() == MODULE_STMT) { - SgStatement *ifst; - ifst = doIfThenConstr(als); - //first_exec = ifst->lexNext(); // reffer to ENDIF statement - where = ifst->lexNext(); // reffer to ENDIF statement - } - LINE_NUMBER_BEFORE(node->align_stmt,where); - // for tracing set the global variable of LibDVM to - // line number of ALIGN directive - - array_header = HeaderRef(als); - rank = Rank(als); - - if(INTERFACE_RTS2) { //interface of RTS2 - - doCallStmt(DvmhArrayCreate(als,array_header,rank,ListUnion(doDvmShapeList(als,node->align_stmt),DeclaredShadowWidths(als)))); - if(!HAS_SAVE_ATTR(als) && !IN_MODULE) - doCallStmt(ScopeInsert(array_header)); - if(!(ia & POSTPONE_BIT) && align_rule_list) - doCallStmt(DvmhAlign(als,root->symb,nr,align_rule_list)); - where = savest; - return; - } - // interface of RTS1 - isize = ndvm; - size_array = doSizeArray(als, node->align_stmt ); - ileft = ndvm; - iright= BoundSizeArrays(als); - if((ia & SAVE_BIT) || saveall || IN_MODULE) - sign = 1; - else - sign = 0; - - if(ia & DYNAMIC_BIT){ - /* - if( IS_SAVE(als)) - Error ("Saved object may not have the DYNAMIC attribute: %s", als->identifier(), 111,node->align_stmt); - - if(IN_COMMON(als)) - Error ("Object in COMMON may not have the DYNAMIC attribute: %s", als->identifier(), 112,node->align_stmt); - */ - re_sign = 2; - } - else if(ia & POSTPONE_BIT) - re_sign = 2; - else - re_sign = 0; - // aligned array may not be redisributed - - StoreLowerBoundsPlus(als,NULL); - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, dosn't allocate array - doAssignStmt(CreateDistArray(als, array_header, size_array,rank,ileft,iright,sign,re_sign)); - /* ndvm--; // CrtDa result is exit code, test and free */ - - if(!(ia & POSTPONE_BIT)) { - // dvm000(i) = AlgnDA (ArrayHeader,PatternRef, - // Axis Array,Coeff Array,Const Array) - doAssignStmt(AlignArray(array_header,HeaderRef(root->symb), - iaxis, iaxis+nr,iaxis+2*nr)); - //doAssignTo(header_ref(als,rank+2),HeaderNplus1(als));//calculating HEADER(rank+1) - } - SET_DVM(isize); - //first_exec = st; //restore first_exec - where = savest; //first_exec; -} - -void RealignArray(SgSymbol *als, SgSymbol *tgs, int iaxis, int nr, SgExpression *align_rule_list, int new_sign, SgStatement *stal) -{ int ia,iamv; - SgStatement *if_st; - SgExpression *header_flag = HeaderRefInd(als,HEADER_SIZE(als)); - - ia=als->attributes(); - if(!(ia & DYNAMIC_BIT) && !(ia & POSTPONE_BIT)) - Error (" '%s' hasn't the DYNAMIC attribute",als->identifier(), 113,stal); - if(!(ia & ALIGN_BIT) && !(ia & INHERIT_BIT)) - Error (" '%s' does not appear in ALIGN or INHERIT directive ",als->identifier(),120, stal); - if(ia & DISTRIBUTE_BIT) - Error ("An alignee may not have the DISTRIBUTE attribute: %s",als->identifier(), 57, stal); - if(!HEADER(als)) { - Error("%s isn't distributed array", als->identifier(), 72,stal); - return; - } - if(!HEADER(tgs)) - return; - if(INTERFACE_RTS2) - { - doCallAfter(DvmhRealign(HeaderRef(als),new_sign,HeaderRef(tgs),nr,align_rule_list)); - return; - } - iamv = ndvm; - if(ACC_program || parloop_by_handler) /*ACC*/ - { if( !(ia & POSTPONE_BIT) ) - doCallAfter(Realign_H(HeaderRef(als),new_sign)); - else { - if_st = doIfThenConstrForRealign(header_flag,cur_st,0); - cur_st = if_st; - doCallAfter(Realign_H(HeaderRef(als),new_sign)); - cur_st = if_st->lexNext()->lexNext(); //ENDIF statement - } - } - doCallAfter(RealignArr(HeaderRef(als),HeaderRef(tgs),iaxis,iaxis+nr,iaxis+2*nr,new_sign)); - - - if(ia & POSTPONE_BIT) { - if_st = doIfThenConstrForRealign(header_flag,cur_st,1); - where = if_st->lexNext(); // reffer to ENDIF statement - algn_attr *attr = (algn_attr *) als->attributeValue(0,ALIGN_TREE); - align *root = attr->ref; // reference to the root of align tree - if( !(ia & ALLOCATABLE_BIT) && !(ia & POINTER_BIT) && root->alignees) - // Looking through the Align Tree of array - AlignTreeAlloc(root,stal); - doAssignTo(header_flag, new SgValueExp(1)); - SET_DVM(iamv); - cur_st = where;// ENDIF statement - where = stal; //11.12.12 - } -} - -void ALLOCATEf90_arrays(SgStatement *stmt, distribute_list *distr) -{SgExpression *alce,*al, *new_list, *apr; - SgSymbol *ar; - int dvm_flag = 0; - where = stmt; - ReplaceContext(stmt); - //LINE_NUMBER_BEFORE(stmt,stmt); /*26.10.17*/ - if(stmt->hasLabel()) /*26.10.17*/ - InsertNewStatementBefore(new SgStatement(CONT_STAT),stmt); // lab CONTINUE - SgStatement *prev = stmt->lexPrev(); - new_list = stmt->expr(0); apr = NULL; - for(al=stmt->expr(0); al; al=al->rhs()) { - alce = al->lhs(); //allocation - - if(isSgRecordRefExp(alce)) - { struct_component = alce; - alce = RightMostField(alce); - } else - struct_component = NULL; - ar = alce->symbol(); - //ar = (isSgRecordRefExp(alce)) ? RightMostField(alce)->symbol() : alce->symbol(); - if(!IS_ALLOCATABLE_POINTER(ar)) { - Error("An allocate/deallocate object must have the ALLOCATABLE or POINTER attribute: %s",ar->identifier(),287,stmt); - continue; - } - if(only_debug) - return; - if(ar->attributes() & DISTRIBUTE_BIT) { - //determine corresponding DISTRIBUTE statement - SgStatement *dist_st = (DISTRIBUTE_DIRECTIVE(ar)) ? *(DISTRIBUTE_DIRECTIVE(ar)) : NULL; - if(ar->attributes() & POINTER_BIT) - AllocatePointerHeader(ar,stmt); - if(struct_component) - ALLOCATEStructureComponent(ar,struct_component,alce,stmt); - //allocate distributed array - if(dist_st) - ALLOCATEf90DistArray(ar,alce,dist_st,stmt); - //delete from list of ALLOCATE statement - if(apr) - apr->setRhs(al->rhs()); - else - new_list = al->rhs(); - dvm_flag = 1; - } - - else if(ar->attributes() & ALIGN_BIT) { - if(ar->attributes() & POINTER_BIT) - AllocatePointerHeader(ar,stmt); - //allocate aligned array - if(struct_component) - ALLOCATEStructureComponent(ar,struct_component,alce,stmt); - else - AllocateAlignArray(ar,alce,stmt); - //delete from list of ALLOCATE statement - if(apr) - apr->setRhs(al->rhs()); - else - new_list = al->rhs(); - dvm_flag = 1; - } - else - apr = al; - } - //replace allocation-list of ALLOCATE statement by new_list - //stmt->setExression(0,new_list); - if(new_list) - BIF_LL1(stmt->thebif)= new_list->thellnd; - else - BIF_LL1(stmt->thebif)= NULL; - - if(dvm_flag) - LINE_NUMBER_AFTER_WITH_CP(stmt,prev,stmt->controlParent()); /*26.10.17*/ - return; -} - -void AllocatePointerHeader(SgSymbol *ar,SgStatement *stmt) -{SgStatement *alst; - SgExpression *headerRef, *structRef; - alst = new SgStatement(ALLOCATE_STMT); - headerRef = new SgArrayRefExp(*ar,*new SgValueExp(HEADER_SIZE(ar))); - if(ar->variant() == FIELD_NAME) - { structRef = &(struct_component->copy()); - structRef->setRhs(headerRef); - headerRef = structRef; - } - alst->setExpression(0, *new SgExprListExp(*headerRef)); - //alst->setExpression(0, *new SgExprListExp(*new SgArrayRefExp(*ar,*new SgValueExp(HEADER_SIZE(ar))))); - InsertNewStatementBefore(alst,stmt); -} - -void DEALLOCATEf90_arrays(SgStatement *stmt) -{SgExpression *al, *new_list, *apr; - SgSymbol *ar; - SgStatement *prev; - int dvm_flag = 0; - - ReplaceContext(stmt); - //LINE_NUMBER_BEFORE(stmt,stmt); /*26.10.17*/ - if(stmt->hasLabel()) /*26.10.17*/ - InsertNewStatementBefore(new SgStatement(CONT_STAT),stmt); // lab CONTINUE - cur_st = prev = stmt->lexPrev(); - new_list = stmt->expr(0); apr = NULL; - for(al=stmt->expr(0); al; al=al->rhs()) { - ar = (isSgRecordRefExp(al->lhs())) ? RightMostField(al->lhs())->symbol() : al->lhs()->symbol(); - if(!IS_ALLOCATABLE_POINTER(ar)) { - Error("An allocate/deallocate object must have the ALLOCATABLE or POINTER attribute: %s",ar->identifier(),287,stmt); - continue; - } - if(ar->variant()==FIELD_NAME && IS_DVM_ARRAY(ar)) - { SgExpression *structRef, *headerRef; - headerRef = new SgArrayRefExp(*ar,*new SgValueExp(1)); - structRef = &(al->lhs()->copy()); - structRef->setRhs(headerRef); - headerRef = structRef; - InsertNewStatementAfter(DeleteObject_H(headerRef),cur_st,stmt->controlParent()); /*26.10.17*/ - dvm_flag = 1; - //doCallAfter(DeleteObject_H(headerRef)); - //if(ACC_program) /*ACC*/ - //InsertNewStatementAfter(DestroyArray(headerRef),cur_st,stmt->controlParent()); - - apr = al; - continue; - } - if(HEADER(ar)) { - InsertNewStatementAfter(DeleteObject_H(HeaderRefInd(ar,1)),cur_st,stmt->controlParent()); /*26.10.17*/ - dvm_flag = 1; - //if(ACC_program) /*ACC*/ - //InsertNewStatementAfter(DestroyArray(HeaderRefInd(ar,1)),cur_st,stmt->controlParent()); - //FREE_DVM(1); - //doCallAfter(DeleteObject_H(HeaderRefInd(ar,1))); - - if(IS_POINTER_F90(ar)){ - apr = al; - continue; - } - if(apr) - apr->setRhs(al->rhs()); - else - new_list = al->rhs(); - - } else - { apr = al; - if(ACC_program) /*ACC*/ - InsertNewStatementAfter(DataExit(&al->lhs()->copy(),0),cur_st,stmt->controlParent()); /*26.10.17*/ - //if(ACC_program) /*ACC*/ - // InsertNewStatementAfter(DestroyScalar(&al->lhs()->copy()),cur_st,stmt->controlParent()); - //doCallAfter(DataExit(&al->lhs()->copy(),0)); /*ACC*/ - } - } - //replace deallocation-list of DEALLOCATE statement by new_list - if(new_list) - BIF_LL1(stmt->thebif)= new_list->thellnd; - else - BIF_LL1(stmt->thebif)= NULL; - - if(dvm_flag) - LINE_NUMBER_AFTER_WITH_CP(stmt,prev,stmt->controlParent()); /*26.10.17*/ - return; -} - - -void AllocateArray(SgStatement *stmt, distribute_list *distr) -{ SgExpression *desc; - SgSymbol *p; - if(!stmt->expr(1)->lhs()) {// empty argument list of allocate function call - err("Wrong argument list of ALLOCATE function call", 262, stmt); - return; - } - desc = stmt->expr(1)->lhs()->lhs(); //descriptor array reference - if(!isSgArrayRefExp(desc) || !desc->symbol() || (desc->symbol()->type()->baseType()->variant() != T_INT) || IS_POINTER(desc->symbol()) || IS_DVM_ARRAY(desc->symbol())) - { - err("Descriptor array error", 122, stmt); - return; - } - if(desc->lhs()) - ChangeDistArrayRef(desc); - - where = stmt; - p = stmt->expr(0)->symbol(); // pointer in left part - /*if (p->attributes() & DIMENSION_BIT) - Error("POINTER in left part has DIMENSION attribute: %s",p->identifier(),stmt);*/ - if(p->attributes() & DISTRIBUTE_BIT) { - //determine corresponding DISTRIBUTE statement - SgStatement *dist_st; - SgExpression *el; - distribute_list *dsl; - dist_st = NULL; - for(dsl=distr; dsl && !dist_st; dsl=dsl->next) - for(el=dsl->stdis->expr(0); el; el=el->rhs()) - if(el->lhs()->symbol() == p) { - dist_st = dsl->stdis; - break; - } - //allocate distributed array - ReplaceContext(stmt); - AllocateDistArray(p,desc,dist_st,stmt); - return; - } - - if(p->attributes() & ALIGN_BIT) { - //allocate aligned array - ReplaceContext(stmt); - AllocateAlignArray(p,desc,stmt); - return; - } - - Error("POINTER '%s' is not distributed object",p->identifier(), 85,stmt); - return; -} - -void AllocateDistArray(SgSymbol *p, SgExpression *desc, SgStatement *stdis, SgStatement *stmt) { - - int iamv,rank,iaxis,ileft,iright,ifst; - SgExpression *array_header, *size_array, *ps, *arglist, *lbound; - //SgSymbol *sheap; - int ia,sign,re_sign; - int idisars; - - ifst = ndvm; - // if(IS_DUMMY(p) || IN_COMMON(p)) { //is dummy argument or COMMON-block element - // return; - //} - LINE_NUMBER_BEFORE(stmt,stmt); // for tracing set the global variable of LibDVM to - // line number of statement(stmt) - SgExpression *distr_rule_list = doDisRules(stdis,0,idisars); - //idisars = doDisRuleArrays(stdis,0,NULL); - if(idisars == -1) - Error ("INDIRECT/DERIVED format is not permitted for pointer %s", p->identifier(), 626,stdis); - rank = PointerRank(p); - if(ndis && rank && rank != ndis) - Error ("Rank of pointer %s is not equal to the length of the dist_format_list", p->identifier(), 123,stdis); - - // dvm000(i) = CrtAMV(AMRef, rank, SizeArray, StaticSign) - //CrtAMV creates current Abstract_Machine view - ia = p->attributes(); - size_array = ReverseDim(desc,rank); - if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT)) - sign = 1; - else - sign = 0; - iamv = ndvm; /* ifst = iamv+1; */ - if(!(ia & POSTPONE_BIT)){ - doAssignStmt(CreateAMView(size_array, rank, sign)); - - ps = PSReference(stdis); - if(mult_block) - doAssignStmt(MultBlock(DVM000(iamv), mult_block, ndis)); - //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) - // genbli sets on the weights of elements of processor system - if(gen_block == 1) - doAssignStmt(GenBlock(ps,DVM000(iamv), idisars+2*nblock,nblock)); - if(gen_block == 2) - doAssignStmt(WeightBlock(ps,DVM000(iamv),idisars+2*nblock, idisars+3*nblock,nblock)); - //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) - // DisAM distributes resourses of parent (current) AM between children - doAssignStmt(DistributeAM(DVM000(iamv),ps,nblock,idisars,idisars+nblock)); - if(mult_block) - doAssignStmt(MultBlock(DVM000(iamv), mult_block, 0)); - } - - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, doesn't allocate array - - //sheap = heap_ar_decl ? heap_ar_decl->symbol() : p;//heap_ar_decl == NULL is user error - //doAssignTo(stmt->expr(0), ARRAY_ELEMENT(sheap,1)); - // P = HEAP(1) or P(I) = HEAP(1) - if(!stmt->expr(0)->lhs()) // case P - doAssignTo(stmt->expr(0), new SgValueExp(POINTER_INDEX(p))); - // P = or P(I) = - else { // case P(I,...) - doAssignTo(stmt->expr(0), HeapIndex(stmt)); - } - array_header = PointerHeaderRef(stmt->expr(0),1); - //doAssignTo( ARRAY_ELEMENT(sheap, 1), &(* ARRAY_ELEMENT(sheap, 1) + *new SgValueExp(HEADER_SIZE(p)))); - //HEAP(1) = HEAP(1) + - //doLogIfForHeap(sheap, heap_size); - - //creating LeftBSizeArray and RightBSizeArray - ileft = ndvm; - iright = BoundSizeArrays(p); - if(ia & DYNAMIC_BIT) - re_sign = 3; - else - re_sign = 0; - arglist= stmt->expr(1)->lhs(); - lbound=0; - if(arglist->rhs() && arglist->rhs()->rhs() && arglist->rhs()->rhs()->rhs() ) {//there are 3-nd and 4-nd argument of ALLOCATE function call - SgExpression *heap; - lbound = arglist->rhs()->rhs()->lhs(); //lower bound array reference ?? - heap = arglist->rhs()->lhs(); //heap array reference ?? - if(heap && isSgArrayRefExp(heap) && !heap->lhs() && lbound && isSgArrayRefExp(lbound)) - ; - else - lbound = 0; - } - if(!lbound) - StoreLowerBoundsPlus(p,stmt->expr(0)); - else - StoreLowerBoundsPlusFromAllocate(p,stmt->expr(0),lbound); - doAssignStmt(CreateDistArray(p,array_header,size_array,rank,ileft,iright,sign,re_sign)); - if(debug_regim && TestType(PointerType(p))) { - SgExpression *heap; - if(stmt->expr(1)->lhs()->rhs()) {//there is 2-nd argument of ALLOCATE function call - heap = stmt->expr(1)->lhs()->rhs()->lhs(); //heap array reference - if(heap && isSgArrayRefExp(heap) && !heap->lhs()) - InsertNewStatementBefore(D_RegistrateArray(rank, TestType(PointerType(p)), GetAddresDVM(array_header),size_array,stmt->expr(0) ) ,stmt); - } - } - if(ia & POSTPONE_BIT) - { SET_DVM(ifst); return;} - // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, - // Axis Array,Coeff Array),Const Array) - //function AlgnDA alignes the array according to aligning template - //actually AlgnDA distributes aligned array elements between virtual - //processors - iaxis = ndvm; - doAlignRule_1(rank); - // doAlignRule_1(axis_array,coeff_array,const_array); - doAssignStmt(AlignArray(array_header, DVM000(iamv), iaxis, iaxis+rank, iaxis+2*rank)); - // axis_array, coeff_array and const_array arn't used more - SET_DVM(ileft); - - // doAssignTo(header_ref(p,rank+2),HeaderNplus1(p)); - // calculating HEADER(rank+1) - - -// Looking through the Align Tree of distributed array - //algn_attr * attr; - //align * root; - if(p->numberOfAttributes(ALIGN_TREE)) {//there are any align statements - algn_attr * attr; - align * root; - attr = (algn_attr *) p->attributeValue(0,ALIGN_TREE); - root = attr->ref; // reference to root of align tree - - AlignTreeAlloc(root,stmt); - } - - SET_DVM(ifst); -} - -void ALLOCATEf90DistArray(SgSymbol *p, SgExpression *desc, SgStatement *stdis, SgStatement *stmt) { - - int iamv,rank,iaxis,ileft,iright,ifst; - SgExpression *array_header, *size_array, *ps; - int ia,sign,re_sign; - int idisars; - SgType *type; -/* - if(p->variant() == FIELD_NAME) - { SgExpression *structRef ; - structRef = &(struct_component->copy()); - array_header = new SgArrayRefExp(*p,*new SgValueExp(HEADER_SIZE(p))); - structRef->setRhs(array_header); - array_header = structRef; - - } else - */ - if(!HEADER(p)) return; - ifst = ndvm; - - //idisars = doDisRuleArrays(stdis,0,NULL); - SgExpression *distr_rule_list = doDisRules(stdis,0,idisars); - rank = Rank(p); - if(ndis && rank && rank != ndis) - Error ("Rank of array %s is not equal to the length of the dist_format_list", p->identifier(), 110,stdis); - type = p->type(); - size_array = doSizeAllocArray(p,desc,stmt,(idisars==-1 ? RTS2 : RTS1)); - array_header = HeaderRef(p); - ia = p->attributes(); - - if(idisars == -1) //interface of RTS2 - { - SgExpression *shadow_list = DeclaredShadowWidths(p); - doCallStmt(DvmhArrayCreate(p,array_header,rank,ListUnion(size_array,shadow_list))); - //doCallStmt(ScopeInsert(array_header)); - if(!(ia & POSTPONE_BIT)) //distr_rule_list!=NULL - doCallStmt(DvmhDistribute(p,rank,distr_rule_list)); // distribute dvm-array - SET_DVM(ifst); - return; - } - - // dvm000(i) = crtamv(AMRef, rank, SizeArray, StaticSign) - // crtamv function creates current Abstract_Machine view - if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT) || p->scope()!=cur_func || IS_BY_USE(p)) - sign = 1; - else - sign = 0; - iamv = ndvm; - if(!(ia & POSTPONE_BIT)){ - doAssignStmt(CreateAMView(size_array, rank, sign)); - ps = PSReference(stdis); - if(mult_block) - doAssignStmt(MultBlock(DVM000(iamv), mult_block, ndis)); - //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) - // genbli sets on the weights of elements of processor system - if(gen_block == 1) - doAssignStmt(GenBlock(ps,DVM000(iamv), idisars+2*nblock,nblock)); - if(gen_block == 2) - doAssignStmt(WeightBlock(ps,DVM000(iamv),idisars+2*nblock, idisars+3*nblock,nblock)); - //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) - // DisAM distributes resourses of parent (current) AM between children - doAssignStmt(DistributeAM(DVM000(iamv),ps,nblock,idisars,idisars+nblock)); - if(mult_block) - doAssignStmt(MultBlock(DVM000(iamv), mult_block, 0)); - } - - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, doesn't allocate array - - //creating LeftBSizeArray and RightBSizeArray - ileft = ndvm; - iright = BoundSizeArrays(p); - if(ia & DYNAMIC_BIT) - re_sign = 3; - else - re_sign = 0; - - StoreLowerBoundsPlusOfAllocatable(p,desc); - - doAssignStmt(CreateDistArray(p,array_header,size_array,rank,ileft,iright,sign,re_sign)); - if(debug_regim && TestType(type)) - InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(HeaderRefInd(p,1)),size_array,new SgVarRefExp(p)) ,stmt); - - if(ia & POSTPONE_BIT) - { SET_DVM(ifst); return;} - - // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, - // Axis Array,Coeff Array),Const Array) - //function AlgnDA alignes the array according to aligning template - //actually AlgnDA distributes aligned array elements between virtual processors - - iaxis = ndvm; - doAlignRule_1(rank); - doAssignStmt(AlignArray(array_header, DVM000(iamv), iaxis, iaxis+rank, iaxis+2*rank)); - - SET_DVM(ifst); -} - -void ALLOCATEStructureComponent(SgSymbol *p, SgExpression *struct_e, SgExpression *desc, SgStatement *stmt) { - - int rank,ileft,iright,ifst; - SgExpression *array_header, *size_array; - int ia,sign,re_sign; - SgType *type; - SgExpression *structRef, *struct_ , *struct_comp; - // p->variant() == FIELD_NAME - - structRef = &(struct_e->copy()); - array_header = new SgArrayRefExp(*p, *new SgValueExp(1)); //*new SgValueExp(HEADER_SIZE(p))); - structRef->setRhs(array_header); - array_header = structRef; - ifst = ndvm; - rank = Rank(p); - type = p->type(); - size_array = doSizeAllocArray(p,desc,stmt,(INTERFACE_RTS2 ? RTS2:RTS1)); - if( INTERFACE_RTS2 ) // interface of RTS2 - { - doCallStmt(DvmhArrayCreate(p,array_header,rank,ListUnion(size_array,DeclaredShadowWidths(p)))); - //doCallStmt(ScopeInsert(array_header)); - return; - } - //interface of RTS1 - SgSymbol *s_struct = LeftMostField(struct_e)->symbol(); - ia = s_struct->attributes(); - if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT) || s_struct->scope()!=cur_func || IS_BY_USE(s_struct)) - sign = 1; - else - sign = 0; - - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, doesn't allocate array - - //creating LeftBSizeArray and RightBSizeArray - ileft = ndvm; - iright = BoundSizeArrays(p); - if(p->attributes() & DYNAMIC_BIT) - re_sign = 3; - else - re_sign = 0; - - struct_ = &(struct_e->copy()); - struct_ ->setRhs(NULL); - StoreLowerBoundsPlusOfAllocatableComponent(p,desc,struct_); - - doAssignStmt(CreateDistArray(p,array_header,size_array,rank,ileft,iright,sign,re_sign)); - struct_comp = &(struct_->copy()); - struct_comp->setRhs(new SgArrayRefExp(*p)); - if(debug_regim && TestType(type)) - InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(header_ref_in_structure(p,1,struct_)),size_array,struct_comp) ,stmt); - - SET_DVM(ifst); - return; -} - - -void AlignTreeAlloc( align *root,SgStatement *stmt) { - align *node; - int nr,iaxis=-1,ia,*ix; - SgStatement *stalgn; - SgExpression *align_rule_list=NULL; - stalgn = NULL; - - for(node=root->alignees; node; node=node->next) { - if(IS_POINTER(node->symb)) //node is pointer must not be allocated - continue; - ix = ALIGN_RULE_INDEX(node->symb); - if(ix) - {iaxis = *ix; nr = *(++ix);} - else { - if (stalgn != node->align_stmt) { - stalgn = node->align_stmt; - iaxis = ndvm; ia = 0; - } - else - ia = iaxis; - align_rule_list = doAlignRules(node->symb,node->align_stmt,ia,nr);// creating axis_array, - } // coeff_array and const_array - - AlignAllocArray(node,root, nr, iaxis, NULL, stmt); - AlignTreeAlloc(node,stmt); - } -} -align *CopyAlignTreeNode(SgSymbol *ar) -{ - algn_attr * attr; - align *node, *node_copy; - SgStatement *algn_st; - - attr = (algn_attr *) ORIGINAL_SYMBOL(ar)->attributeValue(0,ALIGN_TREE); - node = attr->ref; // reference to root of align tree - node_copy = new align; - node_copy->symb = ar; - node_copy->align_stmt = node->align_stmt; - //algn_st = node->align_stmt; - return(node_copy); -} - -void AllocateAlignArray(SgSymbol *p, SgExpression *desc, SgStatement *stmt) { - int nr=0,iaxis=0,*ix=NULL,ifst=0; - SgStatement *algn_st; - SgSymbol *base, *pb; - SgExpression *align_rule_list; - align *node,*root=NULL, *node_copy; - ifst = ndvm; - pb = ORIGINAL_SYMBOL(p); - if(!pb->attributeValue(0,ALIGN_TREE)) - return; - node = ((algn_attr *) pb->attributeValue(0,ALIGN_TREE))->ref; - algn_st = node->align_stmt; - node_copy = IS_BY_USE(p) ? CopyAlignTreeNode(p) : node; - if(algn_st->expr(2)){ - base = (algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs()->symbol() : (algn_st->expr(2))->symbol();// align_base symbol - root = ((algn_attr *) base->attributeValue(0,ALIGN_TREE))->ref; - } - if(IS_ALLOCATABLE_POINTER(p)){ - AlignAllocArray(node_copy,root,0,0,desc,stmt); - return; - } -/* - if(!algn_st->expr(2)){ //postponed aligning - root = NULL; - if(IS_ALLOCATABLE_POINTER(p)){ - AlignAllocArray(node,root,0,0,desc,stmt); - return; - } - } - else { - base = (algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs()->symbol() : (algn_st->expr(2))->symbol();// align_base symbol - root = ((algn_attr *) base->attributeValue(0,ALIGN_TREE))->ref; - - if(IS_ALLOCATABLE_POINTER(p)){ - AlignAllocArray(node,root,0,0,desc,stmt); - return; - } -*/ - if(root) { - LINE_NUMBER_BEFORE(stmt,stmt); // for tracing set the global variable of LibDVM to - // line number of statement(stmt) - ix = ALIGN_RULE_INDEX(p); - if(ix) - {iaxis = *ix; nr = *(++ix);} - else { - iaxis = ndvm; - align_rule_list = doAlignRules(p,algn_st,0,nr); - } - } - //sheap = heap_ar_decl ? heap_ar_decl->symbol() : p;//heap_ar_decl == NULL is user error - //doAssignTo(stmt->expr(0), ARRAY_ELEMENT(sheap,1)); - // P = HEAP(1) or P(I) = HEAP(1) - if(!stmt->expr(0)->lhs()) // case P - doAssignTo(stmt->expr(0), new SgValueExp(POINTER_INDEX(p))); - // P = or P(I) = - else { // case P(I,...) - doAssignTo(stmt->expr(0), HeapIndex(stmt)); - } - //doAssignTo( ARRAY_ELEMENT(sheap, 1), &(* ARRAY_ELEMENT(sheap, 1) + *new SgValueExp(HEADER_SIZE(p)))); - //HEAP(1) = HEAP(1) + - //doLogIfForHeap(sheap, heap_size); //IF(HEAP(1) > heap_size) STOP 'HEAP limit is exceeded' - - AlignAllocArray(node,root,nr,iaxis,desc,stmt); - AlignTreeAlloc(node,stmt); - SET_DVM(ifst); -} - -void AlignAllocArray(align *node, align *root, int nr, int iaxis,SgExpression *desc, SgStatement *stmt) { - -// 1) creates Distributed Array for "node" -// 2) alignes Distributed Array with Distributed Array for "root" or with -// Template - - int rank,ileft,iright,isize; - int sign,re_sign,ia; - SgSymbol *als; - SgExpression *array_header,*size_array,*pref, *arglist, *lbound; - SgExpression *align_rule_list; - SgType *type; - - als = node->symb; - ia = als->attributes(); - - if(!HEADER(ORIGINAL_SYMBOL(als))){ - Error("Array '%s' may not be allocated", als->identifier(),124,node->align_stmt); - return; - } - if(IS_TEMPLATE(als) || IS_DUMMY(als) || (IN_COMMON(als) && !IS_POINTER(als) && !IS_ALLOCATABLE_POINTER(als))) - return; - - if(IS_SAVE(als)) { // has SAVE attribute - if(root && !IS_TEMPLATE(root->symb) && !IN_COMMON(root->symb) && !HAS_SAVE_ATTR(root->symb) && CURRENT_SCOPE(root->symb) ) { - Error("Aligned array '%s' has SAVE attribute but align-target has not", als->identifier(),119,node->align_stmt); - return; - } - SgStatement *ifst; - ifst = doIfThenConstr(als); - where = ifst->lexNext(); // reffer to ENDIF statement - } - LINE_NUMBER_BEFORE(stmt,where); - rank = Rank(als); - - if(INTERFACE_RTS2) { //interface of RTS2 - size_array = NULL; - array_header = HeaderRef(als); - if(IS_ALLOCATABLE_POINTER(als)) - size_array = doSizeAllocArray(als, desc, stmt, RTS2); - else if(!IS_POINTER(als)) - size_array = doDvmShapeList(als,node->align_stmt); - doCallStmt(DvmhArrayCreate(als,array_header,rank,ListUnion(size_array,DeclaredShadowWidths(als)))); - //doCallStmt(ScopeInsert(array_header)); - align_rule_list = root ? doAlignRules(node->symb,node->align_stmt,0,nr) : NULL; - if( root && align_rule_list) //!(ia & POSTPONE_BIT) - doCallStmt(DvmhAlign(als,root->symb,nr,align_rule_list)); - if(IS_SAVE(als)) - where = where->lexNext(); - return; - } - //interface of RTS1 - isize = ndvm; - if(IS_POINTER(als)){ - size_array = ReverseDim(desc,rank); - pref = where->expr(0); - array_header = PointerHeaderRef(pref,1); - type = PointerType(als); - } else if(IS_ALLOCATABLE_POINTER(als)) { - size_array = doSizeAllocArray(als, desc, stmt, RTS1); - pref = NULL; - array_header = HeaderRef(als); - type = als->type(); - } else { - size_array = doSizeArray(als, node->align_stmt ); - pref = NULL; - array_header = HeaderRef(als); - type = als->type(); - } - - ileft = ndvm; - iright= BoundSizeArrays(als); - if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT) || als->scope()!=cur_func || IS_BY_USE(als)) - sign = 1; - else - sign = 0; - - if(ia & DYNAMIC_BIT) - re_sign = 2; - else - re_sign = 0; - //re_sign = 0; aligned array may not be redisributed - if(IS_ALLOCATABLE_POINTER(als)) { - StoreLowerBoundsPlusOfAllocatable(als,desc); - iaxis = ndvm; - if(root) //!(ia & POSTPONE_BIT) - align_rule_list = doAlignRules(node->symb,node->align_stmt,0,nr); //nr = doAlignRule(als,node->align_stmt,0); - } - else { - arglist= stmt->expr(1)->lhs(); - lbound=0; - if(arglist->rhs() && arglist->rhs()->rhs() && arglist->rhs()->rhs()->rhs() ) {//there are 3-nd and 4-nd argument of ALLOCATE function call - SgExpression *heap; - lbound = arglist->rhs()->rhs()->lhs(); //lower bound array reference ?? - heap = arglist->rhs()->lhs(); //heap array reference ?? - if(heap && isSgArrayRefExp(heap) && !heap->lhs() && lbound && isSgArrayRefExp(lbound)) - ; - else - lbound = 0; - } - if(!lbound) - StoreLowerBoundsPlus(als,pref); - else - StoreLowerBoundsPlusFromAllocate(als,pref,lbound); -} - - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, dosn't allocate array - doAssignStmt(CreateDistArray(als, array_header, size_array,rank,ileft,iright,sign,re_sign)); - if( debug_regim && TestType(type)) { - if(IS_POINTER(als) ){ - SgExpression *heap; - if(stmt->expr(1)->lhs()->rhs()) {//there is 2-nd argument of ALLOCATE function call - heap = stmt->expr(1)->lhs()->rhs()->lhs(); //heap array reference - if(heap && isSgArrayRefExp(heap) && !heap->lhs()) - InsertNewStatementBefore(D_RegistrateArray(rank, TestType(PointerType(als)), GetAddresDVM(array_header),size_array,stmt->expr(0) ) ,stmt); - } - } else if(IS_ALLOCATABLE_POINTER(als)) - InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(HeaderRefInd(als,1)),size_array,new SgVarRefExp(als)),stmt); - else - InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(HeaderRefInd(als,1)),size_array,new SgVarRefExp(als)),where); - } - if(root) // non postponed aligning ((ia & POSTPONE_BIT)==0) - - // dvm000(i) = AlgnDA (ArrayHeader,PatternRef, - // Axis Array,Coeff Array,Const Array) - doAssignStmt(AlignArray(array_header,HeaderRef(root->symb), - iaxis, iaxis+nr,iaxis+2*nr)); - - //doAssignTo(header_ref(als,rank+2),HeaderNplus1(als));//calculating HEADER(rank+1) - SET_DVM(isize); - if(IS_SAVE(als)) - where = where->lexNext(); -} - -void PostponedAlignArray(align *node, align *root, int nr, int iaxis) { - -// 1) creates Distributed Array for "node" -// 2) alignes Distributed Array with Distributed Array for "root" - - int rank,ileft,iright,isize; - int sign,re_sign,ia; - SgSymbol *als; - SgExpression *array_header,*size_array; - - als = node->symb; - ia = als->attributes(); - - if(!HEADER(als)){ - Error("Array '%s' may not be aligned", als->identifier(),125,node->align_stmt); - return; - } - if(IS_TEMPLATE(als) || IS_DUMMY(als) || IN_COMMON(als)) - return; - - if(IS_SAVE(als)) { // has SAVE attribute - if(root && !IS_TEMPLATE(root->symb) && !IN_COMMON(root->symb) && !HAS_SAVE_ATTR(root->symb) && CURRENT_SCOPE(root->symb) ) { - Error("Aligned array '%s' has SAVE attribute but align-target has not", als->identifier(),119,node->align_stmt); - return; - } - SgStatement *ifst; - ifst = doIfThenConstr(als); - where = ifst->lexNext(); // reffer to ENDIF statement - } - LINE_NUMBER_BEFORE(node->align_stmt,where); - // for tracing set the global variable of LibDVM to - // line number of ALIGN directive - array_header = HeaderRef(als); - isize = ndvm; - size_array = doSizeArray(als, node->align_stmt ); - rank = Rank(als); - ileft = ndvm; - iright= BoundSizeArrays(als); - if((ia & SAVE_BIT) || saveall) - sign = 1; - else - sign = 0; - - if(ia & DYNAMIC_BIT) - re_sign = 2; - else - re_sign = 0; - - StoreLowerBoundsPlus(als,NULL); - - // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, - // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) - // function CrtDA creates system structures, dosn't allocate array - doAssignStmt(CreateDistArray(als, array_header, size_array,rank,ileft,iright,sign,re_sign)); - - // dvm000(i) = AlgnDA (ArrayHeader,PatternRef, - // Axis Array,Coeff Array,Const Array) - doAssignStmt(AlignArray(array_header,HeaderRef(root->symb), - iaxis, iaxis+nr,iaxis+2*nr)); - SET_DVM(isize); - if(IS_SAVE(als)) - where = where->lexNext(); -} - -void Template_Create(SgStatement *stmt) -{ - SgExpression *el; - int isave = ndvm; - for(el = stmt->expr(0); el; el=el->rhs()) - { - if(isSgArrayRefExp(el->lhs())) - { - SgSymbol *s = el->lhs()->symbol(); - int rank = Rank(s); - if(!HEADER(s)) - { - Error("'%s' has not DISTRIBUTE attribute ", s->identifier(), 637,stmt); - continue; - } - if(!(s->attributes() & POSTPONE_BIT)) - { - Error("Template '%s' has no postponed distribution", s->identifier(), 638,stmt); - continue; - } - if(!DEFERRED_SHAPE_TEMPLATE(s)) - { - Error("Template '%s' has no deferred shape", s->identifier(), 640,stmt); - continue; - } - where = stmt; - SgExpression *size_array = doSizeAllocArray(s, el->lhs(), stmt, (INTERFACE_RTS2 ? RTS2 : RTS1)); - cur_st = stmt; - if(INTERFACE_RTS2) - { - doCallAfter(DvmhTemplateCreate(s,HeaderRef(s),rank,size_array)); - //doCallAfter(ScopeInsert(HeaderRef(s))); - } - else - { - doAssignTo_After(DVM000(INDEX(s)),CreateAMView(size_array, rank, 1)); - where = cur_st; - StoreLowerBoundsPlusOfAllocatable(s,el->lhs()); - } - } - else - { - err("Illegal element of list",636,stmt); - continue; - } - } - SET_DVM(isave); -} - -void Template_Delete(SgStatement *stmt) -{ - SgExpression *el; - for(el = stmt->expr(0); el; el=el->rhs()) - { - if(isSgArrayRefExp(el->lhs())) - { - SgSymbol *s = el->lhs()->symbol(); - if(!HEADER(s)) - { - Error("'%s' has not DISTRIBUTE attribute ", s->identifier(), 637,stmt); - continue; - } - if(!DEFERRED_SHAPE_TEMPLATE(s)) - { - Error("Template '%s' has no deferred shape", s->identifier(), 640,stmt); - continue; - } - - doCallAfter(DeleteObject_H(HeaderRef(s))); - } - else - { - err("Illegal element of list",636,stmt); - continue; - } - } -} - -SgExpression * dvm_array_ref () { -// creates array reference: dvm000(i) , i - index of first free element - SgValueExp * index = new SgValueExp(ndvm); - return( new SgArrayRefExp(*dvmbuf, *index)); -} - -SgExpression * dvm_ref (int n) { -// creates array reference: dvm000(n) - SgValueExp * index = new SgValueExp(n); - return( new SgArrayRefExp(*dvmbuf, *index)); -} - - -void Align_Tree(align *root) { - align *p; - if (!root) - return; - -// looking through alignees of the root - for(p=root->alignees; p; p=p->next) - { - //printf(" %s is aligned with %s (statement at line %d)\n", p->symb->identifier(), root->symb->identifier(), p->align_stmt->lineNumber()); - Align_Tree(p); - } - return; -} - -stmt_list *addToStmtList(stmt_list *pstmt, SgStatement *stat) -{ -// adding the statement to the beginning of statement list -// pstmt-> stat -> stmt-> ... -> stmt - stmt_list * stl; - if (!pstmt) { - pstmt = new stmt_list; - pstmt->st = stat; - pstmt->next = NULL; - } else { - stl = new stmt_list; - stl->st = stat; - stl->next = pstmt; - pstmt = stl; - } - return (pstmt); -} - -stmt_list *delFromStmtList(stmt_list *pstmt) -{ -// deletinging last statement from the statement list -// pstmt-> stat -> stmt-> ... -> stmt - pstmt = pstmt->next; - return (pstmt); -} - -void RenamingDvmArraysByUse(SgStatement *stmt) -{ - SgSymbol *ar; - SgExpression *e = stmt->expr(0), *el; - - if(e && e->variant()==ONLY_NODE) - e = e->lhs(); - for(el=e; el; el=el->rhs()) - { - ar = el->lhs()->lhs()->symbol(); - if(!IS_DVM_ARRAY(ar)) continue; - // if(el->lhs()->rhs()) - if(strcmp(ar->identifier(),ORIGINAL_SYMBOL(ar)->identifier())) //case of renaming in a use statement - { //printf("%s %s SCOPE: %s\n", ar->identifier(),ORIGINAL_SYMBOL(ar)->identifier(),ar->scope()->symbol()->identifier()); - //adding the distributed array symbol 'ar' to symb_list 'dsym' - if(!(ar->attributes() & DVM_POINTER_BIT)) - AddDistSymbList(ar); - // creating variables used for optimisation array references in parallel loop - coeffs *scoef = new coeffs; - CreateCoeffs(scoef,ar); - // adding the attribute (ARRAY_COEF) to distributed array symbol - ar->addAttribute(ARRAY_COEF, (void*) scoef, sizeof(coeffs)); - } - } -} - -void ArrayHeader (SgSymbol *ar,int ind) -{ -// creating header of distributed array: HEADER(0:N+1), -// N - rank of array - // Rank+1 elements for DVM system - // and 1 element for F_DVM - - int *index = new int; - int * count = new int; - coeffs *scoef = new coeffs; - SgSymbol **base = new (SgSymbol *); - SgType *btype; - - if(IS_BY_USE(ar)) - return; - - if(HEADER(ar)) { - Err_g("Illegal aligning of '%s'", ar->identifier(),126); - return; - } - btype = Base_Type(ar->type()); - - /* - if(btype->variant() == T_STRING) - Err_g("Illegal type of '%s'", ar->identifier(),141); - */ /* podd 13.01.12 */ - - if( ar->attributes() & DATA_BIT ) - Err_g("Distributed object may not be initialized (in DATA statement): %s", ar->identifier(), 265); - if(!(ar->attributes() & DIMENSION_BIT) && !(ar->attributes() & DVM_POINTER_BIT)) - Err_g("Distributed object '%s' is not array", ar->identifier(),127); - if(ar->attributes() & DVM_POINTER_BIT) - //TypeMemory(PointerType(ar)); // marking type memory use - TypeMemory(SgTypeInt()); // marking type memory use - else if(!(ar->attributes() & TEMPLATE_BIT) ) //ind == 1 - { - TypeMemory(btype); // marking type memory use - if(TypeIndex(btype) == -1 && btype->variant()!=T_DERIVED_TYPE) - //if(TypeSize(btype) != TypeSize(baseMemory(btype)->type()->baseType())) - Err_g("Illegal type of '%s'", ar->identifier(),141); - } -//adding the distributed array symbol 'ar' to symb_list 'dsym' - if(!(ar->attributes() & DVM_POINTER_BIT)) - AddDistSymbList(ar); - - - *index = ind; -// adding the attribute (ARRAY_HEADER) to distributed array symbol - ar->addAttribute(ARRAY_HEADER, (void*) index, sizeof(int)); - *count = 0; -// adding the attribute (BUFFER_COUNT) to distributed array symbol -// counter of remote group buffers - ar->addAttribute(BUFFER_COUNT, (void*) count, sizeof(int)); -// creating variables used for optimisation array references in parallel loop - CreateCoeffs(scoef,ar); -// adding the attribute (ARRAY_COEF) to distributed array symbol - ar->addAttribute(ARRAY_COEF, (void*) scoef, sizeof(coeffs)); -//creating base variable - if(opt_base) { - *base= BaseSymbol(ar); -// adding the attribute (ARRAY_BASE) to distributed array symbol - ar->addAttribute(ARRAY_BASE, (void*) base, sizeof(SgSymbol *)); - } -} - -int Rank (SgSymbol *s) -{ - SgArrayType *artype; - if(IS_POINTER(s)) - return(PointerRank(s)); - artype=isSgArrayType(s->type()); - if(artype) - return (artype->dimension()); - else - return (0); -} - -SgExpression *doSizeArrayQuery(SgExpression *headref,int rank) -{int ind,i; - ind = ndvm; - for(i=1; i<=rank ; i++) - doAssignStmt(GetSize(headref,i)); - return(DVM000(ind)); -} - -SgExpression *doDvmShapeList(SgSymbol *ar, SgStatement *st) /* RTS2 */ -{ - SgExpression *l_bound, *u_bound, *pe, *result=NULL; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - int i; - artype = isSgArrayType(ar->type()); - if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array - ndim = 0; - return (NULL); - } - ndim = artype->dimension(); - for(i=0; isizeInDim(i); - if ((sbe=isSgSubscriptExp(pe)) != NULL) { - - if(!sbe->ubound()) { - Error("Illegal array shape: %s",ar->identifier(), 162,st); - u_bound = &(c1.copy()); - } - else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * - Error("Assumed-size array: %s",ar->identifier(), 162,st); - u_bound = &(c1.copy()); - } - else - u_bound = &((sbe->ubound())->copy()); - if(sbe->lbound()) - l_bound = &((sbe->lbound())->copy()); - else if(sbe->ubound()) - l_bound = &(c1.copy()); - else { - Error("Illegal array shape: %s",ar->identifier(), 162,st); - l_bound = &(c1.copy()); - } - } - else { - if(pe->variant() == STAR_RANGE) // dim=ubound = * - Error("Assumed-size array: %s",ar->identifier(),162,st); - u_bound = &(pe->copy()); - l_bound = &(c1.copy()); - } - //reversing dimensions for LibDVM - result = AddElementToList(result, DvmType_Ref(Calculate(u_bound))); - result = AddElementToList(result, DvmType_Ref(Calculate(l_bound))); - } - return(result); -} - -SgExpression *doShapeList(SgSymbol *ar, SgStatement *st) /* RTS2 */ -{ - SgExpression *l_bound, *u_bound, *pe, *result=NULL; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - int i; - artype = isSgArrayType(ar->type()); - if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array - ndim = 0; - return (NULL); - } - ndim = artype->dimension(); - for(i=0; isizeInDim(i); - if(IS_BY_USE(ar)) { - u_bound = UBOUNDFunction(ar,i+1); - l_bound = LBOUNDFunction(ar,i+1); - } - else if ((sbe=isSgSubscriptExp(pe)) != NULL) { - if(sbe->ubound() && (sbe->ubound()->variant() == INT_VAL || sbe->ubound()->variant() == CONST_REF) && (!sbe->lbound() || sbe->lbound() && (sbe->lbound()->variant() == INT_VAL || sbe->lbound()->variant() == CONST_REF))) { - u_bound = &((sbe->ubound())->copy()); - if(sbe->lbound()) - l_bound = &((sbe->lbound())->copy()); - else - l_bound = &(c1.copy()); - } - else { - if(sbe->ubound() && sbe->ubound()->variant() == STAR_RANGE) { - if(st->variant()==DVM_PARALLEL_ON_DIR ) - Error("Assumed-size array in parallel loop: %s",ar->identifier(), 162,st); - else if( st->variant()==ACC_REGION_DIR) - Error("Assumed-size array in region: %s",ar->identifier(), 162,st); - else - Error("Assumed-size array: %s",ar->identifier(), 162,st); - } - u_bound = UBOUNDFunction(ar,i+1); - l_bound = LBOUNDFunction(ar,i+1); - } - } - else - { - if(pe->variant() == INT_VAL || pe->variant() == CONST_REF) { - u_bound = &(pe->copy()); - l_bound = &(c1.copy()); - } - else { - if(pe->variant() == STAR_RANGE) { - if(st->variant()==DVM_PARALLEL_ON_DIR ) - Error("Assumed-size array in parallel loop: %s",ar->identifier(), 162,st); - else if( st->variant()==ACC_REGION_DIR) - Error("Assumed-size array in region: %s",ar->identifier(), 162,st); - else - Error("Assumed-size array: %s",ar->identifier(), 162,st); - } - u_bound = UBOUNDFunction(ar,i+1); - l_bound = LBOUNDFunction(ar,i+1); - } - } - //reversing dimensions for LibDVM - result = AddElementToList(result, DvmType_Ref(u_bound)); - result = AddElementToList(result, DvmType_Ref(l_bound)); - - } - return(result); -} - - -SgExpression * doSizeFunctionArray(SgSymbol *ar, SgStatement *st) -{ - SgExpression *esize, *pe, *result; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - int i,n; - -//allocating SizeArray and setting on it - result = dvm_array_ref(); // SizeArray reference - artype = isSgArrayType(ar->type()); - if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array - ndim = 0; - return (result); - } - ndim = n = artype->dimension(); - for(i=n-1; i>=0 ; i--) { //reversing dimensions for LibDVM - pe = artype->sizeInDim(i); - if ((sbe=isSgSubscriptExp(pe)) != NULL) { - if(!sbe->ubound()) - esize = SizeFunction(ar,i+1); - else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * - Error("Assumed-size array: %s",ar->identifier(), 162,st); - esize = SizeFunction(ar,i+1); - } - else - if(sbe->lbound()) - esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); - else - esize = &((sbe->ubound())->copy()); - } - else - { - if(pe->variant() == STAR_RANGE) // dim=ubound = * - Error("Assumed-size array: %s",ar->identifier(),162,st); - esize = &(pe->copy()); - } - -// dvm000(N+j) = size_in_dimension_(n-j) - esize = Calculate( esize); - if(esize->variant()!=INT_VAL) - esize = SizeFunction(ar,i+1); - doAssignStmt(esize); - } - return (result); -} - - -SgExpression * doSizeArray(SgSymbol *ar, SgStatement *st) -{ - SgExpression *esize, *pe, *result; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - int i,n; - -//allocating SizeArray and setting on it - result = dvm_array_ref(); // SizeArray reference - artype = isSgArrayType(ar->type()); - if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array - ndim = 0; - //Error (" Distributed object %s isn't declared as array\n", ar->identifier(),st); - return (result); - } - ndim = n = artype->dimension(); - for(i=n-1; i>=0 ; i--) { //reversing dimensions for LibDVM - pe = artype->sizeInDim(i); - if ((sbe=isSgSubscriptExp(pe)) != NULL) { - - if(!sbe->ubound()) { - Error("Illegal array shape: %s",ar->identifier(), 162,st); - esize = &(c1.copy()); //SizeFunction(ar,i+1); - } - else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * - Error("Assumed-size array: %s",ar->identifier(), 162,st); - esize = &(sbe->ubound()->copy()); - } - else - if(sbe->lbound()) - esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); - else - esize = &((sbe->ubound())->copy()); - } - else { - if(pe->variant() == STAR_RANGE) // dim=ubound = * - Error("Assumed-size array: %s",ar->identifier(),162,st); - esize = &(pe->copy()); - } - -// dvm000(N+j) = size_in_dimension_(n-j) - doAssignStmt(Calculate( esize)); - } - return (result); -} - -SgExpression * doSizeArrayD(SgSymbol *ar, SgStatement *st) -{ - SgExpression *esize, *pe, *result; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - int i,n; - if(st) - ; -//allocating SizeArray and setting on it - result = dvm_array_ref(); // SizeArray reference - artype = isSgArrayType(ar->type()); - if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array - ndim = 0; - //Error (" Distributed object %s isn't declared as array\n", ar->identifier(),st); - return (result); - } - ndim = n = artype->dimension(); - for(i=0; isizeInDim(i); - if ((sbe=isSgSubscriptExp(pe)) != NULL) - esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); - else -// !!! test : ubound = * - esize = &(pe->copy()); -// dvm000(N+j) = size_in_dimension(j) - doAssignStmt(Calculate( esize)); - } - return (result); -} - -SgExpression * doSizeAllocArray(SgSymbol *ar, SgExpression *desc, SgStatement *st, int RTS_flag) -{ - SgExpression *pe, *result, *size[MAX_DIMS], *el; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - int i,n; - -//allocating SizeArray and setting on it - result = RTS_flag == 1 ? dvm_array_ref() : NULL; // SizeArray reference/Shape list - artype = isSgArrayType(ar->type()); - if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array - ndim = 0; - return (result); - } - ndim = artype->dimension(); - if(!desc->lhs()) - Error("No allocaton specifications for %s",ar->identifier(),293,st); - if(!TestMaxDims(desc->lhs(), ar, st)) - return(result); - for(el=desc->lhs(),n=0; el; el=el->rhs(),n++){ - pe = el->lhs(); - if((sbe=isSgSubscriptExp(pe)) != NULL) - { - if(RTS_flag == RTS1) - size[n] = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); - else //RTS2 - { - result = AddElementToList(result, DvmType_Ref(Calculate(sbe->ubound()))); - result = AddElementToList(result, DvmType_Ref(Calculate(sbe->lbound()))); - } - } - else - if(RTS_flag == RTS1) - size[n] = &(pe->copy()); - else //RTS2 - { - result = AddElementToList(result, DvmType_Ref(Calculate(pe))); - result = AddElementToList(result, DvmType_Ref(Calculate(&c1))); - } - - } - if(ndim != n) - Error("Rank of array '%s' is not equal the length of allocation-specification-list",ar->identifier(),292,st); - if(RTS_flag == RTS1) - { - for(i=n-1; i>=0 ; i--) //reversing dimensions for LibDVM - doAssignStmt(Calculate( size[i])); - } - return (result); -} - - -SgExpression * ArrayDimSize(SgSymbol *ar, int i) -{ -// i= 1,...,Rank - SgExpression *esize,*pe; - SgSubscriptExp *sbe; - SgValueExp c1(1); - SgArrayType *artype; - - if(IS_POINTER(ar)) - return(UpperBound(ar,i-1)); // lower bound = 1 - - if(!(ar->attributes() & DIMENSION_BIT)){// Error isn't array - ndim = 0; - return (NULL); - } - artype = isSgArrayType(ar->type()); - /* - if(! artype) { // Error: isn't array - ndim = 0; - return (NULL); - } - */ - pe = artype->sizeInDim(i-1); - if ((sbe=isSgSubscriptExp(pe)) != NULL){ - if(!sbe->ubound()) - esize = SizeFunction(ar,i); - else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * - //Error("Assumed-size array: %s",ar->identifier(),cur_st); - esize = &(sbe->ubound()->copy()); - } - else - if(sbe->lbound()) - esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); - else - esize = &((sbe->ubound())->copy()); - } - else - //if(pe->variant() == STAR_RANGE) // dim=ubound = * - // Error("Assumed-size array: %s",ar->identifier(),cur_st); - esize = &(pe->copy()); - - return (esize); -} - - -SgSymbol * baseMemory(SgType *t) -{ - TypeMemory(t); //14.03.03 - if(t->variant() == T_DERIVED_TYPE) - return baseMemoryOfDerivedType(t) ; - int Tind = TypeIndex(t); //21.04.15 - if(Tind != -1) - return mem_symb[Tind] ; - else - { //Err_g ("There is not dvm-base for array %s", " ", 616); - return mem_symb[Integer] ; - } - -} - -SgSymbol *baseMemoryOfDerivedType(SgType *t) -{SgSymbol *stype; - base_list *el; - stype = t->symbol(); - for(el=mem_use_structure; el; el = el->next) - if(el->type_symbol == stype) return(el->base_symbol); - Error("Can not define base memory symbol for %s",stype->identifier(),333,cur_st); - return(Imem);//error -} - -void TypeMemory(SgType *t) -{ - if(t->variant() == T_DERIVED_TYPE) - DerivedTypeMemory(t); - int tInd = TypeIndex(t); - - if(tInd != -1) - mem_use[tInd] = 1; - -} - -void DerivedTypeMemory(SgType *t) -{SgSymbol *stype; - base_list *el; - - stype = t->symbol(); - for(el=mem_use_structure; el; el = el->next) - { if(el->type_symbol == stype) - { if(!el->base_symbol) - el->base_symbol = DerivedTypeBaseSymbol(stype,t); - return; - } - } - el = new base_list; - el->type_symbol = stype; - el->base_symbol = DerivedTypeBaseSymbol(stype,t); - el->gpu_symbol = NULL; - el->next=mem_use_structure; - mem_use_structure = el; -} - -int IntrinsicTypeSize(SgType *t) -{ - switch(t->variant()) { - case T_INT: - case T_BOOL: return (len_int ? len_int : default_integer_size); - case T_FLOAT: return (len_int ? len_int : default_real_size); - case T_COMPLEX: return (len_int ? 2*len_int : 2*default_real_size); - case T_DOUBLE: return (len_int ? 2*len_int : 8); - - case T_DCOMPLEX: return(16); - - case T_STRING: - case T_CHAR: - return(1); - default: - return(0); - } -} - -//SAPFOR has the same function without modification, 28.09.2021 -SgExpression * TypeLengthExpr(SgType *t) -{ - SgExpression *len; - SgExpression *selector; - if(t->variant() == T_DERIVED_TYPE) return(new SgValueExp(StructureSize(t->symbol()))); - len = TYPE_RANGES(t->thetype) ? t->length() : NULL; - selector = TYPE_KIND_LEN(t->thetype) ? t->selector() : NULL; - // printf("\nTypeSize"); - // printf("\nranges:"); if(len) len->unparsestdout(); - // printf("\nkind_len:"); if(selector) selector->unparsestdout(); - if(!len && !selector) //the number of bytes is not specified in type declaration statement - return (new SgValueExp(IntrinsicTypeSize(t))); - else if(len && !selector) //INTEGER*2,REAL*8,CHARACTER*(N+1) - return(Calculate(len)); - else - return(Calculate(LengthOfKindExpr(t, selector, len))); //specified kind or/and len -} - -//SAPFOR has the same function without modification, 28.09.2021 -SgExpression *LengthOfKindExpr(SgType *t, SgExpression *se, SgExpression *le) -{ - switch(t->variant()) { - case T_INT: - case T_FLOAT: - case T_BOOL: - case T_DOUBLE: - return(se->lhs()); - case T_COMPLEX: - case T_DCOMPLEX: - return(&(*new SgValueExp(2) * (*(se->lhs())))); - case T_CHAR: - case T_STRING: - { SgExpression *length, *kind; - if(se->rhs() && se->rhs()->variant() == LENGTH_OP ) { - length = se->rhs()->lhs(); - kind = se->lhs()->lhs(); - } - else if(se->rhs() && se->rhs()->variant() != LENGTH_OP){ - length = se->lhs()->lhs(); - kind = se->rhs()->lhs(); - } - else { - length = se->lhs(); - kind = NULL; - } - length = le ? le : length; - if(kind) - return(&(*length * (*kind))); - //return(Calculate(length)->valueInteger() * Calculate(kind)->valueInteger()); - else - return(length); - //return(Calculate(length)->valueInteger()); - - /*length = se->rhs() ? (se->rhs()->variant() == LENGTH_OP ? se->rhs()->lhs() : se->lhs()->lhs()) : se->lhs(); - length = le ? le : length; - if(se->rhs()) // specified KIND and LEN - return((se->lhs()->lhs()->valueInteger()) * (se->rhs()->lhs()->valueInteger()) ); //kind*len - else - return(se->lhs()->valueInteger()); */ - } - - default: - return(NULL); - } -} - -int TypeSize(SgType *t) -{ - SgExpression *le; - int len; - if(IS_INTRINSIC_TYPE(t)) return (IntrinsicTypeSize(t)); - if(t->variant() == T_DERIVED_TYPE) return (StructureSize(t->symbol())); - if((len = NumericTypeLength(t))) return(len); - le = TypeLengthExpr(t); - if(le->isInteger()){ - len = le->valueInteger(); - len = len < 0 ? 0 : len; //according to standard F90 - } else - len = -1; //may be error situation - return(len); -} - -SgExpression *StringLengthExpr(SgType *t, SgSymbol *s) -{ SgExpression *le; - le = TypeLengthExpr(t); - if (isSgKeywordValExp(le)) - le = LENFunction(s); - if (le->lhs() && isSgKeywordValExp(le->lhs())) - le->setLhs(LENFunction(s)); - return(le); -} - -int NumericTypeLength(SgType *t) -{ SgExpression *le; - SgValueExp *ve; - if(t->variant() == T_STRING) return (0); - if(TYPE_RANGES(t->thetype)){ - le = t->length(); - if((ve =isSgValueExp(le))) - return (ve->intValue()); - else - return (0); - } - if(TYPE_KIND_LEN(t->thetype) ) { - le = t->selector()->lhs(); - if((ve=isSgValueExp(le))) - if(t->variant() == T_COMPLEX || t->variant() == T_DCOMPLEX) - return (2*ve->intValue()); - else - return (ve->intValue()); - else - return (0); - } - return(0); -} - -int StructureSize(SgSymbol *s) -{ //SgClassSymb *sc; - //SgFieldSymb *sf; - SgSymbol *sf; - //SgType *type; - // SgExpression *le; - int n; - int size; - size = 0; - //n = ((SgClassSymb *) s)->numberOfFields(); - //for(i=0;itype()))->fieldSymb(1);sf;sf=((SgFieldSymb *)sf)->nextField()){ - for(sf=FirstTypeField(s->type());sf;sf=((SgFieldSymb *)sf)->nextField()){ - - //sf = sc->field(i); - if(IS_POINTER_F90(sf)) - { size = size + DVMTypeLength(); - continue; - } - if(isSgArrayType(sf->type())) { - //le= ArrayLength(sf,cur_st,1); - //if (le->isInteger()) - // size = size + le->valueInteger(); - n= NumberOfElements(sf,cur_st,2);//ArrayLength(sf,cur_st,1); - if (n != 0) - size = size + n*TypeSize(sf->type()->baseType()); - else - Error("Can't calulate structure size: %s", s->identifier(),294,cur_st); - } - else - size = size + TypeSize(sf->type()); - } - - return(size); -} - -SgSymbol *FirstTypeField(SgType *t) -{return(SymbMapping(TYPE_COLL_FIRST_FIELD(t->thetype)));} - - - -int DVMTypeLength() -{return( len_DvmType ? len_DvmType : TypeSize(SgTypeInt()));} - - -int CharLength(SgType *t) -{ - if(!TYPE_RANGES(t->thetype)) - return(1); // CHARACTER (without len, default len=1) - - return(ReplaceParameter( &(t->length()->copy()) )->valueInteger() ); - //return(ReplaceParameter( (new SgExpression(TYPE_RANGES(t->thetype)))->lhs() )->valueInteger() ); -} - - -int TypeIndex(SgType *t) -{ - if(!t) return -1; - int Tsize = TypeSize(t); - switch(t->variant()) { - case T_INT: if(Tsize==4) - return (Integer); - else if (Tsize==1) - return (Integer_1); - else if (Tsize==2) - return (Integer_2); - else if (Tsize==8) - return (Integer_8); - else - break; - case T_FLOAT: if(Tsize == 4) - return (Real); - else if(Tsize == 8) - return (Double); - else - break; - case T_DOUBLE: return (Double); - case T_COMPLEX: if(Tsize == 8) - return (Complex); - else if(Tsize == 16) - return (DComplex); - else - break; - case T_DCOMPLEX: return (DComplex); - case T_BOOL: if(Tsize==4) - return (Logical); - else if(Tsize==1) - return (Logical_1); - else if (Tsize==2) - return (Logical_2); - else if (Tsize==8) - return (Logical_8); - else - break; - case T_STRING: if(Tsize==1) - return (Character); /*13.01.12*/ - else - break; - default: break; - } - - return (-1); -} - -int CompareTypes(SgType *t1,SgType *t2) - -{ - if(!t1 || !t2) return(1); - if(TypeIndex(t1) >= 0 ) - if( TypeIndex(t1)==TypeIndex(t2) ) - return(1); - else - return(0); - if(t1->variant() == T_DERIVED_TYPE ) - if(t2->variant() == T_DERIVED_TYPE && !strcmp(t1->symbol()->identifier(), t2->symbol()->identifier())) - return(1); - else - return(0); - if(TypeIndex(t1)==-1 && TypeIndex(t2)==-1) - return(1); - else - return(0); - return(0); -} - -int BoundSizeArrays (SgSymbol *das) -// returns dvm-index of RightBSizeArray -{ - int iright; - int i,nw,rank,width; - SgExpression *wl,*ew, *lbound[MAX_DIMS], *ubound[MAX_DIMS], *she; - - rank = Rank(das); - if(SHADOW_(das)) { // there is SHADOW directive, i.e. shadow widths are - // specified - iright = 0; - she = *SHADOW_(das); - if(!TestMaxDims(she,das,0)) return(0); - for(wl = she,i=0; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(ew->variant() == DDOT){ - lbound[i] = &(ew->lhs())->copy();//left bound - ubound[i] = &(ew->rhs())->copy();//right bound - } else { - lbound[i] = &(ew->copy());//left bound == right bound - ubound[i] = &(ew->copy()); - } - } - nw = i; - - if(nw=0; i--) - doAssignStmt(lbound[i]); - if(!iright) { // shadow widths are specified in program - iright = ndvm; - for(i=rank-1;i>=0; i--) - doAssignStmt(ubound[i]); - } - return(iright); -} - -void TestWeightArray(SgExpression *efm, SgStatement *st) -{ - SgArrayType *artype; - if(VarType_RTS(efm->symbol())!=4) //DOUBLE PRECISION - Error("Illegal type of '%s'",efm->symbol()->identifier(),141,st); - - artype = isSgArrayType(efm->symbol()->type()); - if(! artype || !artype->getDimList()) //isn't array - { - Error ("'%s' isn't array", efm->symbol()->identifier(),66,st); - return; - } - - if(artype->dimension() != 1) - { - Error ("Illegal rank of '%s'", efm->symbol()->identifier(),76,st); - return; - } - SgExpression *arsize = Calculate(artype->sizeInDim(0)); - if(arsize->variant() == INT_VAL) - { - SgExpression *nblock = Calculate(efm->lhs()); - if(nblock->variant() == INT_VAL) - { - if(((SgValueExp *)arsize)->intValue() < ((SgValueExp *)nblock)->intValue()) - { - Error("Illegal array size of '%s'",efm->symbol()->identifier(),340,st); - return; - } - } - } -} - -SgExpression *AddElementToList(SgExpression *list, SgExpression *e) -{ - SgExpression *el = new SgExprListExp(*e); - el->setRhs(list); - return (el); -} - -SgExpression *ListUnion(SgExpression *list1, SgExpression *list2) -{ - SgExpression *el1=list1, *el2=list2,*result=list1; - for( ; el1 && el2; el1=list1,el2=list2) - { - list1=list1->rhs()->rhs(); - list2=list2->rhs()->rhs(); - el2->rhs()->setRhs(list1); - el1->rhs()->setRhs(el2); - } - return (result); -} - -int isInterfaceRTS2(SgStatement *stdis) -{ - SgExpression *e, *efm; - for(e=stdis->expr(1); e; e = e->rhs()) { - efm = e->lhs(); //dist_format expression - - if(efm->variant() == INDIRECT_OP) - { - if(stdis->expr(2)) - { - err("ONTO/NEW_VALUE clause is not supported",625,stdis); - return(0); - } - if(parloop_by_handler == 2) - return(1); - else - { - err("Indirect/Derived distribution, -Opl2 option should be specified",624,stdis); - return(0); - } - } - } - return(parloop_by_handler==2 ? 1 : 0); -} - -SgExpression *doDisRules(SgStatement *stdis, int aster, int &idis) { - - SgExpression **dis_rules,*distr_list[1]; // DisRule's list - - dis_rules = isInterfaceRTS2(stdis) ? distr_list : NULL; - idis = doDisRuleArrays(stdis, aster, dis_rules); - return (idis==-1 ? *dis_rules : NULL); -} - -int doDisRuleArrays (SgStatement *stdis, int aster, SgExpression **distr_list ) { - - SgExpression *e, *efm, *ed, *nblk[MAX_DIMS], *dist_format, *multiple[MAX_DIMS], *numb[MAX_DIMS]; - SgSymbol *genbl[MAX_DIMS]; - int iaxis, i, axis[MAX_DIMS], param[MAX_DIMS], tp, mps_axis; - SgValueExp M1(1); -//looking through the dist_format_list and -// creating AxisArray and DistrParamArray - ndis = 0; - nblock = 0; - gen_block = 0; - mult_block = 0; - mps_axis = 0; - iaxis = ndvm; - if(distr_list) - *distr_list = NULL; - dist_format = stdis->expr(1); - if(!dist_format){ //dist_format list is absent - all_replicated=0; - return(distr_list ? -1 : iaxis); - } - for(i=0; irhs()) { - efm = e->lhs(); //dist_format expression - if(ndis==MAX_DIMS) - { - err("Too many dimensions",43,stdis); - break; - } - ndis++; - if(efm->variant() == BLOCK_OP) { - nblock++; - mps_axis++; - if(!( efm->symbol() ) ) // case: BLOCK or MULT_BLOCK - { - if( !efm->rhs() ) // case: BLOCK - { - if(distr_list) - *distr_list = AddElementToList(*distr_list,DvmhBlock(mps_axis)); - - multiple[ndis-1] = &M1; - } - else { // case: MULT_BLOCK (k) - if(distr_list) - *distr_list = AddElementToList(*distr_list,DvmhMultBlock(mps_axis, DVM000(iaxis+ndis-1))); - multiple[ndis-1] = numb[ndis-1] = efm->rhs(); - mult_block = 1; - } - axis[ndis-1] = ndis; - param[ndis-1] = 0; - genbl[ndis-1] = NULL; - } - else if (!efm->lhs()) // case: GEN_BLOCK - { if( gen_block == 2 ) // there is WGT_BLOCK in format-list - err("GEN_BLOCK and WGT_BLOCK in format-list",129,stdis); - else - gen_block = 1; - if(distr_list) - *distr_list = AddElementToList(*distr_list,DvmhGenBlock(mps_axis, efm->symbol())); - multiple[ndis-1] = &M1; - axis[ndis-1] = ndis; - param[ndis-1] = 0; - genbl[ndis-1] = efm->symbol(); - tp = VarType_RTS(efm->symbol()); - if((bind_ == 0 && tp != 2 && tp != 1) || (bind_ == 1 && tp != 1)) //INTEGER - Error("Illegal type of '%s'",efm->symbol()->identifier(),141,stdis); - SgArrayType *artype=isSgArrayType(efm->symbol()->type()); - if( !artype || !artype->getDimList() ) - Error("'%s' isn't array",efm->symbol()->identifier(),66,stdis); - } - else // case: WGT_BLOCK - { if( gen_block == 1 ) // there is GEN_BLOCK in format-list - err("GEN_BLOCK and WGT_BLOCK in format-list",129,stdis); - else - gen_block = 2; - if(distr_list) - *distr_list = AddElementToList(*distr_list,DvmhWgtBlock(mps_axis, efm->symbol(),DVM000(iaxis+ndis-1))); - multiple[ndis-1] = &M1; - axis[ndis-1] = ndis; - param[ndis-1] = 0; - genbl[ndis-1] = efm->symbol(); - nblk[ndis-1] = numb[ndis-1] = efm->lhs(); - - TestWeightArray(efm,stdis); - } - /* else if ((efm->lhs())->variant() == SPEC_PAIR) - * //there is one operand (variant==SPEC_PAIR) - * // case: BLOCK(SHADOW=...) - *{ - * efm = (efm->lhs())->rhs(); - * - *} else //there is one operand (variant==CONS) - * // case: BLOCK(LOW_SHADOW=...,HIGH_SHADOW=...) - * { } - */ - } else if(efm->variant() == INDIRECT_OP) - { - mps_axis++; - if(distr_list) - { - if(efm->symbol()) // case INDIRECT(map) - *distr_list = AddElementToList(*distr_list,DvmhIndirect(mps_axis, efm->symbol())); - else // case DERIVED(...) - { - SgExpression *eFunc[2]; - SgExpression *edrv = efm->lhs(); // efm->lhs()->variant() == DERIVED_OP - DerivedSpecification(edrv, stdis, eFunc); - *distr_list = AddElementToList(*distr_list,DvmhDerived(mps_axis, DvmhDerivedRhs(edrv->rhs()),eFunc[0],eFunc[1])); - } - } - } else // variant ==KEYWORD_VAL ("*") - { axis[ndis-1] = 0; - multiple[ndis-1] = &M1; - if(distr_list) - *distr_list = AddElementToList(*distr_list,DvmhReplicated()); - } - } - - if( gen_block == 1 && mult_block) // there are GEN_BLOCK and MULT_BLOCK in format-list - err("GEN_BLOCK and MULT_BLOCK in format-list",129,stdis); - - if(!nblock_all && dist_format) - nblock_all = nblock; - - if(nblock) - all_replicated=0; - - if(aster) // dummy arguments inherit distribution - return(distr_list ? -1 : iaxis); - - if(distr_list) - { - for(i=0; i=0; i--) - doAssignStmt(&(multiple[i]->copy())); - } - - if(!nblock) //replication ("*") in all dimensions - doAssignStmt(new SgValueExp(0)); - - return (iaxis); -} - -void doAlignRule_1 (int rank) -// (SgExpression **p_axis, -// SgExpression **p_coeff, SgExpression **p_const) -{ int i; - SgValueExp *num; - SgValueExp c1(1),c0(0); - // creating axis_array -// axis_array = dvm_array_ref(); // dvm000(ndvm) - for(i=1; i<=rank; i++) { - num = new SgValueExp (i); - doAssignStmt(num); // AxisArray(i)=i - } - // creating coeff_array - // coeff_array = dvm_array_ref(); // dvm000(ndvm) - for(i=1; i<=rank; i++) - doAssignStmt(&c1.copy()); // CoeffArray(i)=1 - // creating const_array - //const_array = dvm_array_ref(); // dvm000(ndvm) - for(i=1; i<=rank; i++) - doAssignStmt(&c0.copy()); // ConstArray(i)=0 -} - -int doAlignRule (SgSymbol *alignee, SgStatement *algn_st, int iaxis) -// creating axis_array, coeff_array and const_array -// returns length of align_source_list (dimension_identifier_list) -// (SgExpression **p_axis, -// SgExpression **p_coeff, SgExpression **p_const) -{ int i,j,rank,ni,nt,ia,num, use[MAX_DIMS]; - //algn_attr *attr; - //SgStatement *algn_st; - SgExpression * el,*e,*ei,*elbi,*elbb; - SgSymbol *dim_ident[MAX_DIMS],*align_base; - SgExpression *axis[MAX_DIMS], *coef[MAX_DIMS], *cons[MAX_DIMS], *et; - SgValueExp c1(1),c0(0),cM1(-1); - int num_dim[MAX_DIMS], ncolon, ntriplet; - for(i=0;ialign_stmt; // align statement - - if(iaxis == -2) return(rank);//for ALLOCATABLE array in specification part - //can't generate align rules because there is not declared array shape - - ni = 0; //counter of elements in align_source_list(dimension_identifier_list) - ncolon = 0; //counter of elements ':'in align_source_list - if(!algn_st->expr(1)) //align_source_list is absent - for(;niexpr(1); el; el=el->rhs()) { - if(ni==MAX_DIMS) { - err("Illegal align-source-list",633,algn_st); - break; - } - if(isSgVarRefExp(el->lhs())) { // dimension identifier - if(el->lhs()->symbol()->attributes() & PARAMETER_BIT) - Error("The align-dummy %s isn't a scalar integer variable",el->lhs()->symbol()->identifier(), 62,algn_st); - dim_ident[ni] = (el->lhs())->symbol(); - } - else if (el->lhs()->variant() == DDOT) { // ':' - num_dim[ncolon++] = ni; - dim_ident[ni] = NULL; - } - else // "*" - dim_ident[ni] = NULL; - use[ni] = 0; - - ni++; - } - if(rank && rank != ni) - Error ("Rank of aligned array %s isn't equal to the length of align-source-list", alignee->identifier(),128,algn_st); - - ia = alignee->attributes(); - if(ia & DISTRIBUTE_BIT) - Error ("An alignee may not have the DISTRIBUTE attribute: %s", alignee->identifier(),57,algn_st); - - et =(algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs() : algn_st->expr(2); - align_base = et->symbol(); - - nt = 0;//counter of elements in align_subscript_list - ntriplet = 0; //counter of triplets in align_subscript_list - if(! et->lhs()) //align_subscript_list is absent - for( ; ntlhs(); el; el=el->rhs()) { - if(nt==MAX_DIMS) { - err("Illegal align-subscript-list",634,algn_st); - break; - } - e = el->lhs(); //subscript expression - if(e->variant()==KEYWORD_VAL) { // "*" - axis[nt] = & cM1.copy(); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else if (e->variant()==DDOT) { // triplet - axis[nt] = new SgValueExp(ni-num_dim[ntriplet]); - coef[nt] = (e->lhs() && e->lhs()->variant()==DDOT) ? & e->rhs()->copy() : - new SgValueExp(1); - //elbi = Exprn( LowerBound(alignee,num_dim[ntriplet])); - //if (e->lhs() && e->lhs()->variant()==DDOT) - // elbi = &(coef[nt]->copy()* (*elbi)); - //else - // elbi = NULL; - elbb = Exprn(LowerBound(align_base,nt)); - if (e->lhs()) - if(e->lhs()->variant()!=DDOT) - cons[nt] = &(e->lhs()->copy() - (*elbb)); - else if (e->lhs()->lhs()) - cons[nt] = &(e->lhs()->lhs()->copy() - (*elbb)); - else - cons[nt] = & c0.copy(); - else - cons[nt] = & c0.copy(); - //cons[nt] = &(*elbb - *elbi); - - ntriplet++; - } - else { // expression - num = AxisNumOfDummyInExpr(e, dim_ident, ni, &ei, use, algn_st); - //ei->unparsestdout(); - //printf("\nnum = %d\n", num); - if (num<=0) { - axis[nt] = & c0.copy(); - coef[nt] = & c0.copy(); - elbb = LowerBound(align_base,nt); - if(elbb) - cons[nt] = & (e->copy() - (elbb->copy())); - // correcting const with lower bound of align-base array - else // error situation : rank of align-base less than list length - cons[nt] = & (e->copy()); - } - else { - axis[nt] = new SgValueExp(ni-num+1); // reversing numbering - CoeffConst(e, ei,&coef[nt], &cons[nt]); - if(!iaxis) TestReverse(coef[nt],algn_st); - if(!coef[nt]) { - if(!iaxis) err("Wrong align-subscript expression", 130,algn_st); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else { - // correcting const with lower bound of alignee and align-base arrays - elbb = LowerBound(align_base,nt); - elbi = LowerBound(alignee,num-1); - if(elbb && elbi) - cons[nt] = &(*cons[nt] + (*coef[nt] * (elbi->copy())) - (elbb->copy())); - } - } - } - - nt++; - } - ia = align_base->attributes(); - if(!iaxis) { - if(!(ia & DIMENSION_BIT) && !IS_POINTER(align_base)) - Error ("Align-target %s isn't declared as array",align_base->identifier(),61,algn_st); - else - if(Rank(align_base) != nt) - Error ("Rank of align-target %s isn't equal to the length of align_subscript-list", align_base->identifier(),132,algn_st); - if(ntriplet != ncolon) - err ("The number of colons in align-source-list isn't equal to the number of subscript-triplets",131,algn_st); - // setting on arrays with reversing - for(i=nt-1; i>=0; i--) - doAssignStmt(axis[i]); - for(i=nt-1; i>=0; i--) - doAssignStmt(ReplaceFuncCall(coef[i])); - for(i=nt-1; i>=0; i--) - doAssignStmt(Calculate(cons[i])); - } - else if(iaxis == -1) - return(nt); - else { - j = iaxis + 2*nt; - for(i=nt-1; i>=0; i--) - doAssignTo(DVM000(j++),Calculate(cons[i])); - } - - return(nt); -} - - -int doAlignRuleArrays (SgSymbol *alignee, SgStatement *algn_st, int iaxis, SgExpression *axis[], SgExpression *coef[],SgExpression *cons[], int interface ) -// creating axis_array, coeff_array and const_array -// returns length of align_source_list (dimension_identifier_list) -// (SgExpression **p_axis, -// SgExpression **p_coeff, SgExpression **p_const) -{ int i,j,rank,ni,nt,ia,num, use[MAX_DIMS]; - //algn_attr *attr; - //SgStatement *algn_st; - SgExpression * el,*e,*ei,*elbi,*elbb; - SgSymbol *dim_ident[MAX_DIMS],*align_base; - SgExpression *et; - SgValueExp c1(1),c0(0),cM1(-1); - int num_dim[MAX_DIMS], ncolon, ntriplet; - for(i=0;iexpr(1)) //align_source_list is absent - for(;niexpr(1); el; el=el->rhs()) { - if(ni==MAX_DIMS) { - err("Illegal align-source-list",633,algn_st); - break; - } - if(isSgVarRefExp(el->lhs())) { // dimension identifier - if(el->lhs()->symbol()->attributes() & PARAMETER_BIT) - Error("The align-dummy %s isn't a scalar integer variable",el->lhs()->symbol()->identifier(), 62,algn_st); - dim_ident[ni] = (el->lhs())->symbol(); - } - else if (el->lhs()->variant() == DDOT) { // ':' - num_dim[ncolon++] = ni; - dim_ident[ni] = NULL; - } - else // "*" - dim_ident[ni] = NULL; - use[ni] = 0; - - ni++; - } - if(rank && rank != ni) - Error ("Rank of aligned array %s isn't equal to the length of align-source-list", alignee->identifier(),128,algn_st); - - ia = alignee->attributes(); - if(ia & DISTRIBUTE_BIT) - Error ("An alignee may not have the DISTRIBUTE attribute: %s", alignee->identifier(),57,algn_st); - - et =(algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs() : algn_st->expr(2); - align_base = et->symbol(); - - nt = 0;//counter of elements in align_subscript_list - ntriplet = 0; //counter of triplets in align_subscript_list - if(! et->lhs()) //align_source_list is absent - for( ; ntlhs(); el; el=el->rhs()) { - if(nt==MAX_DIMS) { - err("Illegal align-subscript-list",634,algn_st); - break; - } - e = el->lhs(); //subscript expression - if(e->variant()==KEYWORD_VAL) { // "*" - axis[nt] = & cM1.copy(); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else if (e->variant()==DDOT) { // triplet - axis[nt] = new SgValueExp(ni-num_dim[ntriplet]); - coef[nt] = (e->lhs() && e->lhs()->variant()==DDOT) ? & e->rhs()->copy() : - new SgValueExp(1); - elbb = Exprn(LowerBound(align_base,nt)); - if (e->lhs()) - if(e->lhs()->variant()!=DDOT) - cons[nt] = interface == RTS2 ? &(e->lhs()->copy()) : &(e->lhs()->copy() - (*elbb)); - else if (e->lhs()->lhs()) - cons[nt] = interface == RTS2 ? &(e->lhs()->lhs()->copy()) : &(e->lhs()->lhs()->copy() - (*elbb)); - else - cons[nt] = & c0.copy(); - else - cons[nt] = & c0.copy(); - - ntriplet++; - } - else { // expression - num = AxisNumOfDummyInExpr(e, dim_ident, ni, &ei, use, algn_st); - //ei->unparsestdout(); - //printf("\nnum = %d\n", num); - if (num<=0) { - axis[nt] = & c0.copy(); - coef[nt] = & c0.copy(); - cons[nt] = & (e->copy()); - if(interface != RTS2 && (elbb = LowerBound(align_base,nt)) ) - cons[nt] = & (*cons[nt] - (elbb->copy())); - // correcting const with lower bound of align-base array - // elbb==NULL is error situation : rank of align-base less than list length - - } - else { - axis[nt] = new SgValueExp(ni-num+1); // reversing numbering - CoeffConst(e, ei,&coef[nt], &cons[nt]); - if(!iaxis) TestReverse(coef[nt],algn_st); - if(!coef[nt]) { - if(!iaxis) err("Wrong align-subscript expression", 130,algn_st); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else { - // correcting const with lower bound of alignee and align-base arrays - elbb = LowerBound(align_base,nt); - elbi = LowerBound(alignee,num-1); - if(interface != RTS2 && elbb && elbi) - cons[nt] = &(*cons[nt] + (*coef[nt] * (elbi->copy())) - (elbb->copy())); - } - } - } - - nt++; - } - ia = align_base->attributes(); - if(!iaxis) { - if(!(ia & DIMENSION_BIT) && !IS_POINTER(align_base)) - Error ("Align-target %s isn't declared as array",align_base->identifier(),61,algn_st); - else - if(Rank(align_base) != nt) - Error ("Rank of align-target %s isn't equal to the length of align_subscript-list", align_base->identifier(),132,algn_st); - if(ntriplet != ncolon) - err ("The number of colons in align-source-list isn't equal to the number of subscript-triplets",131,algn_st); - } - return (nt); -} - -int TestExprArray(SgExpression *e[], int n) -{ - int i; - for(i=0; ivariant()==CONST_REF) - continue; - else - return (0); - return (1); -} - -SgExpression *doAlignRules (SgSymbol *alignee, SgStatement *algn_st, int iaxis, int &nt) -{ - SgExpression *axis[MAX_DIMS], - *coef[MAX_DIMS], - *cons[MAX_DIMS]; - SgExpression *el, *e, *alignment_list = NULL; - int i,j; - nt = doAlignRuleArrays (alignee, algn_st, iaxis, axis, coef, cons, INTERFACE_RTS2 ? RTS2 : RTS1); - if(iaxis == -1 || iaxis == -2) - return(NULL); - if(INTERFACE_RTS2) { - int flag_coef = TestExprArray(coef,nt); - int flag_cons = TestExprArray(cons,nt); - int j1 = ndvm, j2; - if(!iaxis) { - if(!flag_coef) - for(i=nt-1; i>=0; i--) - doAssignStmt(ReplaceFuncCall(coef[i])); - j2 = ndvm; - if(!flag_cons) - for(i=nt-1; i>=0; i--) - doAssignStmt(Calculate(cons[i])); - } else { - j1=iaxis; - j2=flag_coef ? iaxis : iaxis+nt; - } - for(int i=0; isetRhs(alignment_list); - alignment_list = el; - } - return (alignment_list); - } - if(!iaxis) { - // setting on arrays with reversing - for(i=nt-1; i>=0; i--) - doAssignStmt(axis[i]); - for(i=nt-1; i>=0; i--) - doAssignStmt(ReplaceFuncCall(coef[i])); - for(i=nt-1; i>=0; i--) - doAssignStmt(Calculate(cons[i])); - } - else { - j = iaxis + 2*nt; - for(i=nt-1; i>=0; i--) - doAssignTo(DVM000(j++),Calculate(cons[i])); - } - - return(NULL); - -} - -SgExpression * Exprn(SgExpression *e) -{return((!e) ? new SgValueExp(0) : & e->copy());} - -int AxisNumOfDummyInExpr (SgExpression *e, SgSymbol *dim_ident[], int ni, SgExpression **eref, int use[], SgStatement *st) -{ - SgSymbol *symb; - SgExpression * e1; - int i,i1,i2; - *eref = NULL; - if (!e) - return(0); - if(isSgVarRefExp(e)) { - symb = e->symbol(); - for(i=0; ivariant() == DVM_PARALLEL_ON_DIR) - Error("More one occurance of do-variable '%s' in iteration-align-subscript-list", symb->identifier(),133, st); - else if(st) - Error("More one occurance of align_dummy '%s' in align-subscript-list", symb->identifier(), 134,st); - use[i]++; - return(i+1); - } - } - return (0); - } - i1 = AxisNumOfDummyInExpr(e->lhs(), dim_ident, ni, eref, use, st); - e1 = *eref; - i2 = AxisNumOfDummyInExpr(e->rhs(), dim_ident, ni, eref, use, st); - if((i1==-1)||(i2==-1)) return(-1); - if(i1 && i2) { - if(st && st->variant() == DVM_PARALLEL_ON_DIR) - err("More one occurance of a do-variable in do-variable-use expression", 135,st); - else if (st) - err("More one occurance of an align_dummy in align-subscript expression", 136,st); - return(-1); - } - if(i1) *eref = e1; - return(i1 ? i1 : i2); -} - -void CoeffConst(SgExpression *e, SgExpression *ei, SgExpression **pcoef, SgExpression **pcons) -// ei == I; e == a * I + b -// result: *pcoef = a, *pcons = b -{ - SgValueExp c1(1), c0(0), cM1(-1); - switch(e->variant()) { - case VAR_REF: // I - *pcoef = & c1.copy(); - *pcons = & c0.copy(); - break; - case UNARY_ADD_OP: // +I - if(e->lhs()==ei) { - *pcoef = & c1.copy(); - *pcons = & c0.copy(); - } - else - *pcoef = NULL; - break; - case MINUS_OP: // -I - if(e->lhs()==ei) { - *pcoef = & cM1.copy(); - *pcons = & c0.copy(); - } - else - *pcoef = NULL; - break; - - case MULT_OP: // a * I - if (e->lhs()==ei) - *pcoef = &(e->rhs())->copy(); - else if (e->rhs()==ei) - *pcoef = &(e->lhs())->copy() ; - else - *pcoef = NULL; - *pcons = & c0.copy(); - break; - case DIV_OP : // I / a - if(e->rhs()==ei) - *pcoef = NULL; // Error - else { - *pcoef = & (c1.copy() / (e->rhs())->copy()); - *pcons = & c0.copy(); - } - break; - case ADD_OP : - if(e->lhs()==ei) { // I + b - *pcoef = & c1.copy(); - *pcons = & (e->rhs())->copy(); - - } else if(e->rhs()==ei) { // b + I - *pcoef = & c1.copy(); - *pcons = & (e->lhs())->copy(); - } else if (((e->lhs())->lhs()==ei)){ // I * a + b - if(e->lhs()->variant() == MULT_OP){ - *pcons = & (e->rhs())->copy(); - *pcoef = & ((e->lhs())->rhs())->copy(); - } - else if(e->lhs()->variant() == MINUS_OP){ - *pcons = & (e->rhs())->copy(); - *pcoef = & cM1.copy(); - } - else - *pcoef = NULL; - - } else if (((e->lhs())->rhs()==ei)){ // a * I + b - if(e->lhs()->variant() == MULT_OP){ - *pcons = & (e->rhs())->copy(); - *pcoef = & ((e->lhs())->lhs())->copy(); - } - else - *pcoef = NULL; - - } else if (((e->rhs())->lhs()==ei)){ // b + I * a - if(e->rhs()->variant() == MULT_OP){ - *pcons = & (e->lhs())->copy(); - *pcoef = & ((e->rhs())->rhs())->copy(); - } - else if(e->rhs()->variant() == MINUS_OP){ - *pcons = & (e->lhs())->copy(); - *pcoef = & cM1.copy(); - } - else - *pcoef = NULL; - - } else if (((e->rhs())->rhs()==ei)){ // b + a * I - if(e->rhs()->variant() == MULT_OP){ - *pcons = & (e->lhs())->copy(); - *pcoef = & ((e->rhs())->lhs())->copy(); - } - } - else - *pcoef = NULL; - break; - case SUBT_OP : - if(e->lhs()==ei) { // I - b - *pcoef = & c1.copy(); - *pcons = & SgUMinusOp((e->rhs())->copy()); - - } else if(e->rhs()==ei) { // b - I - *pcoef = & cM1.copy(); - *pcons = & (e->lhs())->copy(); - } else if (((e->lhs())->lhs()==ei)){ // I * a - b - if(e->lhs()->variant() == MULT_OP){ - *pcons = & SgUMinusOp((e->rhs())->copy()); - *pcoef = & ((e->lhs())->rhs())->copy(); - } - else if(e->lhs()->variant() == MINUS_OP){ - *pcons = & SgUMinusOp((e->rhs())->copy()); - *pcoef = & cM1.copy(); - } - else - *pcoef = NULL; - - } else if (((e->lhs())->rhs()==ei)){ // a * I - b - if(e->lhs()->variant() == MULT_OP){ - *pcons = & SgUMinusOp((e->rhs())->copy()); - *pcoef = & ((e->lhs())->lhs())->copy(); - } - else - *pcoef = NULL; - - } else if (((e->rhs())->lhs()==ei)){ // b - I * a - if(e->rhs()->variant() == MULT_OP){ - *pcons = & (e->lhs())->copy(); - *pcoef = & SgUMinusOp(((e->rhs())->rhs())->copy()); - } - else - *pcoef = NULL; - - } else if (((e->rhs())->rhs()==ei)){ // b - a * I - if(e->rhs()->variant() == MULT_OP){ - *pcons = & (e->lhs())->copy(); - *pcoef = & SgUMinusOp(((e->rhs())->lhs())->copy()); - } - } - else - *pcoef = NULL; - break; - default: - *pcoef = NULL; - break; - - } -} -//----------------------------------------------------------------------- -SgExpression *SearchDistArrayField(SgExpression *e) -{ - SgExpression *el = e; - while( isSgRecordRefExp(el)) - { - if(isSgArrayRefExp(el->rhs())) - ChangeDistArrayRef(el->rhs()->lhs()); // subscript list - if(el->rhs()->symbol() && (el->rhs()->symbol()->attributes() & DISTRIBUTE_BIT || el->rhs()->symbol()->attributes() & ALIGN_BIT)) - return el; - else - el = el->lhs(); - } - if(el->symbol() && (el->symbol()->attributes() & DISTRIBUTE_BIT || el->symbol()->attributes() & ALIGN_BIT)) - return el; - else - return NULL; -} - -void ChangeDistArrayRef(SgExpression *e) -{ - SgExpression *el; - - if(!e) - return; - if( e->variant() != BOOL_VAL && e->variant() != INT_VAL && e->symbol() && IS_GROUP_NAME(e->symbol())) - Error("Illegal group name use: '%s'",e->symbol()->identifier(),137,cur_st); - - if(opt_loop_range && inparloop && isSgVarRefExp(e) && INDEX_SYMBOL(e->symbol())) { - ChangeIndexRefBySum(e); - return; - } - if(isSgArrayRefExp(e)) { - if(opt_loop_range && inparloop && (sum_dvm=TestDVMArrayRef(e))) - ; - else - for(el=e->lhs(); el; el=el->rhs()) - ChangeDistArrayRef(el->lhs()); - /* - if(HEADER( e -> symbol()) && !isPrivateInRegion(e -> symbol()) //is distributed array reference not private in loop of region - || IN_COMPUTE_REGION && HEADER_OF_REPLICATED(e -> symbol()) ) //or is array reference in compute region - DistArrayRef(e,0,cur_st); //replace distributed array reference - */ - /* - if ( IN_COMPUTE_REGION && is_acc_array(e->symbol()) - || !IN_COMPUTE_REGION && HEADER(e->symbol()) ) - DistArrayRef(e,0,cur_st); //replace dvm-array reference - */ - - if ( HEADER( e -> symbol()) - || (IN_COMPUTE_REGION || inparloop && parloop_by_handler) && DUMMY_FOR_ARRAY(e -> symbol()) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(e -> symbol())) ) - DistArrayRef(e,0,cur_st); //replace dvm-array reference if required - return; - } - if(isSgFunctionCallExp(e)) { - int i; - ReplaceFuncCall(e); - for(el=e->lhs(), i=0; el; el=el->rhs(),i++) - ChangeArg_DistArrayRef(el,e->symbol(),i); - return; - } - - if(isSgRecordRefExp(e)) { - SgExpression *eleft = SearchDistArrayField(e); //from right to left - if(eleft) - DistArrayRef(eleft,0,cur_st); - return; - } - - ChangeDistArrayRef(e->lhs()); - ChangeDistArrayRef(e->rhs()); - return; -} - -void ChangeDistArrayRef_Left(SgExpression *e) -{ - SgExpression *el; - - if(!e) - return; - - if( e->symbol() && IS_GROUP_NAME(e->symbol())) - Error("Illegal group name use: '%s'",e->symbol()->identifier(),137,cur_st); - - if(isSgArrayRefExp(e)) { - if(opt_loop_range && inparloop && (sum_dvm=TestDVMArrayRef(e))) - ; - else - for(el=e->lhs(); el; el=el->rhs()) - ChangeDistArrayRef(el->lhs()); -/* - if(HEADER( e -> symbol()) && !isPrivateInRegion(e -> symbol()) //is distributed array reference not private in loop of region - || IN_COMPUTE_REGION && HEADER_OF_REPLICATED(e -> symbol())) //or is array reference in compute region - - DistArrayRef(e,1,cur_st);//replace distributed array reference (1 -modified variable) -*/ -/* - if ( IN_COMPUTE_REGION && is_acc_array(e->symbol()) - || !IN_COMPUTE_REGION && HEADER(e->symbol()) ) - DistArrayRef(e,0,cur_st); //replace dvm-array reference -*/ - if ( HEADER( e -> symbol()) - || (IN_COMPUTE_REGION || inparloop && parloop_by_handler) && DUMMY_FOR_ARRAY(e -> symbol()) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(e -> symbol())) ) - DistArrayRef(e,1,cur_st); //replace dvm-array reference if required - - return; - } - - if(isSgRecordRefExp(e)) { - SgExpression *eleft = SearchDistArrayField(e); //from right to left - if(eleft) - DistArrayRef(eleft,0,cur_st); - return; - } - - // e->variant()==ARRAY_OP //substring - ChangeDistArrayRef_Left(e->lhs()); - ChangeDistArrayRef(e->rhs()); - - return; -} - -void ChangeArg_DistArrayRef(SgExpression *ele, SgSymbol *fsym, int i) -{//ele is SgExprListExp - SgExpression *el, *e; - e = ele->lhs(); - if(!e) - return; - if(isSgKeywordArgExp(e)) - e = e->rhs(); - - if(isSgArrayRefExp(e)) { - - if(!e->lhs()){ //argument is whole array (array name) - // no changes are required because array header name is - // the same as array name - if(IS_POINTER(e->symbol())) - Error("Illegal POINTER reference: '%s'",e->symbol()->identifier(),138,cur_st); - if((inparloop && parloop_by_handler || IN_COMPUTE_REGION) ) - { - if(DUMMY_FOR_ARRAY(e->symbol()) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(e ->symbol())) ) - { e->setLhs(FirstArrayElementSubscriptsForHandler(e->symbol())); - //changed by first array element reference - if(!for_host) - DistArrayRef(e,0,cur_st); - } - else if(options.isOn(C_CUDA) && for_kernel && isPrivate(e->symbol())) // && PrivateArrayClassUse(sizeOfPrivateArraysInBytes()))) - { - if(fsym && !isArrayParameterWithAssumedShape(ProcedureSymbol(fsym),i)) - e->setLhs(FirstArrayElementSubscriptsOfPrivateArray(e->symbol())); - } - } - if(HEADER(e->symbol()) && for_host) - e->setSymbol(*HeaderSymbolForHandler(e->symbol())); - - return; - } - el=e->lhs()->lhs(); //first subscript of argument - //testing: is first subscript of ArrayRef a POINTER - if((isSgVarRefExp(el) || isSgArrayRefExp(el)) && IS_POINTER(el->symbol())) { - ChangeDistArrayRef(el->lhs()); - // ele->setLhs(PointerHeaderRef(el,1)); - //replace ArrayRef by PointerRef: A(P)=>P(1) or A(P(I)) => P(1,I) - if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) - is_heap_ref = 1; - else - Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,cur_st); - if(e->lhs()->rhs()) //there are other subscripts - Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,cur_st); - if(HEADER(e->symbol())) - Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,cur_st); - - e->setSymbol(*heapdvm); //replace ArrayRef: A(P)=>HEAP00(P) or A(P(I))=>HEAP00(P(I)) - return; - } - } - if(isSgRecordRefExp(e) && isSgArrayRefExp(e->rhs()) && (e->rhs()->symbol()->attributes() & DISTRIBUTE_BIT || e->rhs()->symbol()->attributes() & ALIGN_BIT) - && !e->rhs()->lhs()) { - ChangeDistArrayRef(e->lhs()); - return; - } - - ChangeDistArrayRef(e); - - return; -} - -SgExpression *ToInt(SgExpression *e) -{ if(!e) return(e); - return( e->type() && e->type()->variant()==T_INT) ? e : TypeFunction(SgTypeInt(),e,NULL); -} - -SgExpression *LinearForm (SgSymbol *ar, SgExpression *el, SgExpression *erec) -{ - int j,n; - SgExpression *elin,*e; -// el - subscript list (I1,I2,...In), n - rank of array (ar) -// ind - index of array header in dvm000 -// generating -// [Header(n) +] -// n -// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) -// k=2 -//or for Cuda kernel -// n -// SUMMA(Header(n-k+1) * Ik) -// k=1 - -// Header(0:n+1) - distributed array descriptor - - n = Rank(ar); - if(!el) // there aren't any subscripts - return( coef_ref(ar,n+1,erec) ); //Header(n) - - if(for_kernel) /*ACC*/ - elin = NULL; - else if(opt_loop_range && inparloop && sum_dvm) - // elin = sum_dvm; - elin = coef_ref(ar,0,erec); - else - elin = coef_ref(ar,n+2,erec); // Header(n+1) - e = ToInt(el->lhs()); - if (for_kernel && options.isOn(AUTO_TFM)) /*ACC*/ - e = &(*coef_ref(ar,n+1,erec) * (*e)); // + Header(n)*I1 for loop Cuda-kernel - // or - elin = elin ? &(*elin + *e) : e; // + I1 - j = n ; - for(e=el->rhs(); e && j; e=e->rhs(),j--) { - if(j>=2) //there is coef_ref(ar,j) - elin = &(*elin + (*coef_ref(ar,j,erec) * (*ToInt(e->lhs())))); // + Header(n-k+1)*Ik - } - - if(ACROSS_MOD_IN_KERNEL && (e=analyzeArrayIndxs(ar,el))) /*ACC*/ - elin = &(*elin + *e); - - if(n && j != 1) - Error("Wrong number of subscripts specified for '%s'", ar->identifier(),175,cur_st); - return(elin); -} - -SgExpression *LinearFormB (SgSymbol *ar, int ihead, int n, SgExpression *el) -{ - int j; - SgExpression *elin,*e; -// el - subscript list (I1,I2,...In), n - rank of array (ar) -// generating -// [Header(n) +] -// n -// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) -// k=2 -// Header(0:n+1) - distributed array descriptor - if(n == 0) - return( header_rf(ar,ihead,2) ); //Header(1) - if(!el) // there aren't any subscripts - return( header_rf(ar,ihead,n+1) ); //Header(n) - - elin = header_rf(ar,ihead,n+2); // Header(n+1) - e = ToInt(el->lhs()); - elin = &(*elin + *e); // + I1 - j = n ; - for(e=el->rhs(); e && j; e=e->rhs(),j--) - elin = &(*elin + (*header_rf(ar,ihead,j) * (*ToInt(e->lhs()))));//+ Header(n-k+1)*Ik - - return(elin); -} -/* -SgExpression *LinearFormB (SgSymbol *ar, int ihead, int n, SgExpression *el) -{ - int j; - SgExpression *elin,*e; -// el - subscript list (I1,I2,...In), n - rank of array (ar) -// generating -// [Header(n) +] -// n -// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) -// k=2 -// Header(0:n+1) - distributed array descriptor - - if(n == 0) - return( header_rf(ar,ihead,2) ); //Header(1) - if(!el) // there aren't any subscripts - return( header_rf(ar,ihead,n+1) ); //Header(n) - if(IN_COMPUTE_REGION) //ACC - elin = for_kernel ? NULL : coef_ref(ar,n+2); //ACC - else // Header(n+1) - elin = header_rf(ar,ihead,n+2); - e = el->lhs(); - elin = elin ? &(*elin + *e) : e; // + I1 - j = n ; - for(e=el->rhs(); e && j; e=e->rhs(),j--) - if(IN_COMPUTE_REGION) //ACC - elin = &(*elin + (*coef_ref(ar,j) * (*e->lhs()))); - else //+ Header(n-k+1)*Ik - elin = &(*elin + (*header_rf(ar,ihead,j) * (*e->lhs()))); - - return(elin); -} -*/ - -SgExpression *LinearFormB_for_ComputeRegion (SgSymbol *ar, int n, SgExpression *el) -{ /*ACC*/ - int j; - SgExpression *elin,*e; - -// el - subscript list (I1,I2,...In), n - rank of remote access buffer (ar) -// generating -// [Header(n) +] -// n -// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) -// k=2 -// Header(0:n+1) - distributed array descriptor -// -// for CUDA-kernel -// n -// SUMMA(Header(n-k+1) * Ik) -// k=1 - - if(n == 0) - { if(for_kernel ) /*ACC*/ - return( new SgValueExp(0) ); // 0 - else - return( coef_ref(ar,2) ); // Header(1) - offset - } - - if(!el) // there aren't any subscripts - return( coef_ref(ar,n+1) ); //Header(n) - - elin = for_kernel ? NULL : coef_ref(ar,n+2); // Header(n+1) - e = ToInt(el->lhs()); - if (for_kernel && options.isOn(AUTO_TFM)) /*ACC*/ - e = &(*coef_ref(ar,n+1) * (*e)); // Header(n)*I1 for loop Cuda-kernel - // or - elin = elin ? &(*elin + *e) : e; // [+] I1 - j = n ; - for(e=el->rhs(); e && j; e=e->rhs(),j--) - elin = &(*elin + (*coef_ref(ar,j) * (*ToInt(e->lhs())))); // + Header(n-k+1)*Ik - - if(ACROSS_MOD_IN_KERNEL && (e=analyzeArrayIndxs(ar,el))) /*ACC*/ - elin = &(*elin + *e); - - return(elin); -} - - -SgExpression * head_ref (SgSymbol *ar, int n) { -// creates array header reference - SgValueExp *index = new SgValueExp(n); - if(ar->thesymb->entry.var_decl.local == IO) // is dummy argument - return( new SgArrayRefExp(*ar, *new SgValueExp(1))); - else - return( new SgArrayRefExp(*dvmbuf, *index)); -} - -SgExpression * header_section (SgSymbol *ar, int n1, int n2) { - return(new SgArrayRefExp(*ar, *new SgExpression(DDOT, new SgValueExp(n1), new SgValueExp(n2)))); -} - -SgExpression * header_ref (SgSymbol *ar, int n) { -// creates array header reference: Header(n-1) -// Header(0:n+1) - distributed array descriptor - // int ind; - return( new SgArrayRefExp(*ar, *new SgValueExp(n))); - /* - if(!HEADER(ar)) - return(NULL); - ind = INDEX(ar); - if(ind==1) //is not template - return( new SgArrayRefExp(*ar, *new SgValueExp(n))); - else - return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind+n-1))); - - */ -} - -SgExpression * header_section_in_structure (SgSymbol *ar, int n1, int n2, SgExpression *struct_) { -// creates reference of header section - - SgExpression *estr; - estr = &(struct_->copy()); - estr->setRhs(new SgArrayRefExp(*ar, *new SgExpression(DDOT, new SgValueExp(n1), new SgValueExp(n2)))); - return(estr); -} - -SgExpression * header_ref_in_structure (SgSymbol *ar, int n, SgExpression *struct_) { -// creates array header reference: Header(n-1) -// Header(0:n+1) - distributed array descriptor - SgExpression *estr; - estr = &(struct_->copy()); - estr->setRhs(new SgArrayRefExp(*ar, *new SgValueExp(n))); - return(estr); - //return( new SgArrayRefExp(*ar, *new SgValueExp(n))); -} - -coeffs *DvmArrayCoefficients(SgSymbol *ar) -{ - if(!ar->attributeValue(0,ARRAY_COEF)) //BY USE - { - coeffs *c_new = new coeffs; - CreateCoeffs(c_new,ar); - ar->addAttribute(ARRAY_COEF, (void*) c_new, sizeof(coeffs)); - } - return (coeffs *) ar->attributeValue(0,ARRAY_COEF); -} - -SgExpression * coef_ref (SgSymbol *ar, int n) { -// creates cofficient for dvm-array addressing -//array header reference Header(n) or its copy reference -// Header(0:n+1) - distributed array descriptor - if(inparloop && !HPF_program || for_kernel) { /*ACC*/ - coeffs * scoef; - scoef = AR_COEFFICIENTS(ar); //(coeffs *) ar->attributeValue(0,ARRAY_COEF); - dvm_ar= AddNewToSymbList(dvm_ar,ar); - scoef->use = 1; - return (new SgVarRefExp(*(scoef->sc[n]))); //!!!must be 2<= n <=Rank(ar)+2 - - } else - return( new SgArrayRefExp(*ar, *new SgValueExp(n))); -} - -SgExpression * coef_ref (SgSymbol *ar, int n, SgExpression *erec) { -// creates cofficient for dvm-array addressing -//array header reference Header(n) or its copy reference -// Header(0:n+1) - distributed array descriptor - if(erec) { - SgExpression *e = new SgExpression(RECORD_REF); - e->setLhs(erec); - e->setRhs( new SgArrayRefExp(*ar, *new SgValueExp(n))); - return( e ); - } - if(inparloop && !HPF_program || for_kernel) { /*ACC*/ - coeffs * scoef; - scoef = AR_COEFFICIENTS(ar); //(coeffs *) ar->attributeValue(0,ARRAY_COEF); - dvm_ar= AddNewToSymbList(dvm_ar,ar); - scoef->use = 1; - return (new SgVarRefExp(*(scoef->sc[n]))); //!!!must be 2<= n <=Rank(ar)+2 - - } else - return( new SgArrayRefExp(*ar, *new SgValueExp(n))); -} - -SgExpression * header_rf (SgSymbol *ar, int ihead, int n) { -// creates array header reference: Header(n-1) -// Header(0:r+1) - distributed array descriptor - //int ind; - if(!ar) - return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ihead+n-1))); - else //(may be hpfbuf in HPF_program) - return( new SgArrayRefExp(*ar, *new SgValueExp(ihead+n-1))); - - //if(!HEADER(ar)) - // return(NULL); - //ind = INDEX(ar); - //if(ind==1) //is not template - // return( new SgArrayRefExp(*ar, *new SgValueExp(n))); - //else - // return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind+n-1))); -} - -SgExpression * acc_header_rf (SgSymbol *ar, int ihead, int n) { -// creates array header reference: Header(n-1) -// Header(0:r+1) - distributed array descriptor - - if(!ar) - return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ihead+n-1))); - else //(may be hpfbuf in HPF_program) - return( new SgArrayRefExp(*ar, *new SgValueExp(ihead+n-1))); - -} - - -SgExpression * HeaderRef (SgSymbol *ar) { -// creates array header reference - int ind; - if(!HEADER(ar)) - return(NULL); - ind = INDEX(ar); - if (ind == 0) // is pointer - return(PointerHeaderRef(new SgVarRefExp(ar),1)); - else ///if(ind<=1 || INTERFACE_RTS2) //is not template or interface of RTS2 - return( new SgArrayRefExp(*ar, *new SgValueExp(1)) ); /*10.03.03*/ - /*return( new SgArrayRefExp(*ar)); */ - ///else //is template in RTS1 - /// return( new SgVarRefExp(*ar) ); - //return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind))); -} - -SgExpression *HeaderRefInd(SgSymbol *ar, int n) { - int ind; - if(!HEADER(ar)) - return (NULL); - ind = INDEX(ar); - if (ind == 0) // is pointer - return(PointerHeaderRef(new SgVarRefExp(ar),n)); - else if(ind<=1) //is not template - return(new SgArrayRefExp(*ar, *new SgValueExp(n))); - else //is template - return(new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind+n-1))); -} - -/* -SgExpression * DistObjectRef (SgSymbol *ar) { -//!!! temporary -// creates distributed object reference - int ind; - ind = INDEX(ar); - return(head_ref(ar,ind)); -} -*/ - -SgExpression *HeaderNplus1(SgSymbol * ar) -{ -// n -// Header(n+1) = Header(n) - L1 - SUMMA(Header(n-i+1) * Li) -// i=2 - SgArrayType *artype; - SgExpression *ehead,*e; - SgSubscriptExp *sbe; - int i,n,ind; - - if(IS_POINTER(ar)){ - // Li=1, i=1,n - ind = n = PointerRank(ar); - ehead = &(*header_ref(ar,ind+1) - (*new SgValueExp(1))); - for(; ind>=2; ind--) - ehead = & (*ehead - (*header_ref(ar,ind))); - return(ehead); - } - - artype = isSgArrayType(ar->type()); - if(!artype) // error - return(new SgValueExp(0)); // for continuing translation of procedure - n=artype->dimension(); - if(!n) // error - return(new SgValueExp(0)); // for continuing translation of procedure - ind = n; - ehead = &(*header_ref(ar,ind+1) - LowerBound(ar,0)->copy()); - for(i=2; i<=n; i++,ind--) { - e = artype->sizeInDim(i-1); - if((sbe=isSgSubscriptExp(e)) != NULL) - ehead = & (*ehead - (*header_ref(ar,ind) * - (sbe->lbound()->copy()))); - else - ehead = & (*ehead - (*header_ref(ar,ind))); // by default Li=1 - } - //ehead = & SgUMinusOp(*ehead); - return(ehead); -} -/* -SgExpression *BufferHeaderNplus1(SgExpression * rme, int n, int ihead) -{ -// n -// Header(n+1) = Header(n) - L1 - SUMMA(Header(n-i+1) * Li) -// i=2 - SgArrayType *artype; - SgExpression *ehead,*e,*el; - // SgSubscriptExp *sbe; - SgSymbol *ar; - int i,ind; - ar = rme->symbol(); - if(!(ar->attributes() & DIMENSION_BIT)){// for continuing translation - return (new SgValueExp(0)); - } - artype = isSgArrayType(ar->type()); - if(!artype) // error - return(new SgValueExp(0)); // for continuing translation of procedure - - ind = n; - i=0; - for (el=rme->lhs(); el; el=el->rhs()) //looking through the index list until first ':'element - if(el->lhs()->variant() == DDOT) - break; - else - i++; - if(!(e=LowerBound(ar,i))) - return(new SgValueExp(0)); // for continuing translation of procedure - else - ehead = &(* DVM000(ihead+ind) - e->copy()); - - for (el=el->rhs(),i++; el; el=el->rhs(),i++) //continue looking through the index list - if(el->lhs()->variant() == DDOT) { - ind--; - e = artype->sizeInDim(i); - if(e && e->variant() == DDOT && e->lhs()) - ehead = & (*ehead - (*DVM000(ihead+ind) * - (e->lhs()->copy()))); - else - ehead = & (*ehead - (*DVM000(ihead+ind))); // by default Li=1 - } - - return(ehead); -} -*/ - -SgExpression *BufferHeaderNplus1(SgExpression * rme, int n, int ihead,SgSymbol *ar) -{ -// n -// Header(n+1) = Header(n) - L1*S1 - SUMMA(Header(n-i+1) * Li * Si) -// i=2 -// Si = 1, if i-th remote subscript is ':', else Si = 0 -// Li = lower bound of i-th array dimension if ':', Li = Header(2*n-i+3) - minimum of -// of lower bound and upper bound of corresponding do-variable,if a*i+b - SgArrayType *artype; - SgExpression *ehead,*e,*el; - - SgSymbol *array; - int i,ind,j; - array = rme->symbol(); - if(!(array->attributes() & DIMENSION_BIT)){// for continuing translation - return (new SgValueExp(0)); - } - artype = isSgArrayType(array->type()); - if(!artype) // error - return(new SgValueExp(0)); // for continuing translation of procedure - - ind = n+1; - ehead = header_rf(ar,ihead,ind); - - if(!rme->lhs()) { // buffer is equal to whole array - ehead = &(*ehead - *Exprn(LowerBound(array,0))); - for(i=1,ind=n;ind>1;ind--,i++){ - e = artype->sizeInDim(i); - if(e && e->variant() == DDOT && e->lhs()) - ehead = & (*ehead - (*header_rf(ar,ihead,ind) * - (LowerBound(array,i)->copy()))); - else - ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1 - } - return(ehead); - } - - i=0; j=0; - for (el=rme->lhs(); el; el=el->rhs()) //looking through the index list until first ':' or do-variable-use element - if((el->lhs()->variant() == DDOT) || IS_DO_VARIABLE_USE(el->lhs())) - {j = 1; break;} - else - i++; - if(j == 0) //buffer is of one element - return(ehead); - if( el->lhs()->variant() == DDOT)// : - if(!(e=LowerBound(array,i))) - return(new SgValueExp(0)); // for continuing translation of procedure - else - ehead = &(*ehead - e->copy()); - else //a*i+b - ehead = &(*ehead - (*header_rf(ar,ihead,ind+n+1))); - for (el=el->rhs(),i++; el; el=el->rhs(),i++) //continue looking through the index list - if(el->lhs()->variant() == DDOT) { - ind--; - e = artype->sizeInDim(i); - if(e && e->variant() == DDOT && e->lhs()) - ehead = & (*ehead - (*header_rf(ar,ihead,ind) * - (LowerBound(array,i)->copy()))); - else - ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1 - } - else if( IS_DO_VARIABLE_USE(el->lhs())){ - ind--; - ehead = & (*ehead - (*header_rf(ar,ihead,ind) * (*header_rf(ar,ihead,ind+n+1)))); - } - return(ehead); -} - - - -SgExpression *BufferHeader4(SgExpression * rme, int ihead) -{//temporary - if(rme) - return(DVM000(ihead+2)); - else - return(NULL); -} - -SgExpression *LowerBound(SgSymbol *ar, int i) -// lower bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) -{ - SgArrayType *artype; - SgExpression *e; - SgSubscriptExp *sbe; - if(IS_POINTER(ar)) - return(new SgValueExp(1)); - artype = isSgArrayType(ar->type()); - if(!artype) - return(NULL); - e = artype->sizeInDim(i); - if(!e) - return(NULL); - if((sbe=isSgSubscriptExp(e)) != NULL) { - if(sbe->lbound()) - return(IS_BY_USE(ar) ? Calculate(sbe->lbound()) : sbe->lbound()); - else if(IS_ALLOCATABLE_POINTER(ar) || IS_TEMPLATE(ar)) { - if(HEADER(ar)) - return(header_ref(ar,Rank(ar)+3+i)); - else - return(LBOUNDFunction(ar,i+1)); - } - else - return(new SgValueExp(1)); - } - else - return(new SgValueExp(1)); // by default lower bound = 1 -} - -SgExpression *UpperBound(SgSymbol *ar, int i) -// upper bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) -{ - SgArrayType *artype; - SgExpression *e; - SgSubscriptExp *sbe; - int ri; //06.11.09 - ri = Rank(ar) - i; - if(IS_POINTER(ar)) - return(GetSize(HeaderRefInd(ar,1), ri)); //i+1)); 6.11.09 - artype = isSgArrayType(ar->type()); - if(!artype) - return(NULL); - e = artype->sizeInDim(i); - if(!e) - return(NULL); - if((sbe=isSgSubscriptExp(e)) != NULL){ - if(sbe->ubound()) - return(IS_BY_USE(ar) ? Calculate(sbe->ubound()) : sbe->ubound()); - else if(HEADER(ar)) - //return(&(*GetSize(HeaderRefInd(ar,1),i+1)-*HeaderRefInd(ar,Rank(ar)+3+i)+*new SgValueExp(1))); 06.11.09 - return(&(*GetSize(HeaderRefInd(ar,1),ri)+*HeaderRefInd(ar,Rank(ar)+3+i)-*new SgValueExp(1))); - else - return(UBOUNDFunction(ar,i+1)); - } - else - return(e); -// !!!! test case "*" -} - -void ShadowList (SgExpression *el, SgStatement *st, SgExpression *gref) -{ - int corner; - int ileft,iright; - //int ibsize = 0; - SgExpression *es, *ear, *head, *shlist[1]; - SgSymbol *ar; - // looking through the array_with_shadow_list - for(es = el; es; es = es->rhs()) { - ear = es->lhs(); // array_with_shadow (variant:ARRAY_REF or ARRAY_OP) - if(ear->variant() == ARRAY_OP) { - corner = 1; - ear = ear->lhs(); - } - else - corner = 0; - ar = ear->symbol(); - if(HEADER(ar)) - head = HeaderRef(ar); - else { - Error("'%s' isn't distributed array", ar->identifier(),72, st); - return; - } - if(gref) //interface of RTS1 - { - if(ear->lhs()){ - ileft = ndvm; - iright = doShadSizeArrays(ear->lhs(), ear->symbol(), st, NULL); - } else - ileft=iright= doShadSizeArrayM1(ar,NULL); - - doCallAfter(InsertArrayBound(gref, head, ileft, iright, corner)); - - } else //interface of RTS2 - { - if(ear->lhs()) - { - doShadSizeArrays(ear->lhs(), ear->symbol(), st, shlist); - if(*shlist) - doCallAfter(ShadowRenew_H2(head,corner,Rank(ar),*shlist)); - //doCallAfter(ShadowRenew_H2(Register_Array_H2(head),corner,Rank(ar),*shlist)); - } - else - doCallAfter(ShadowRenew_H2(head,corner,0,NULL)); - //doCallAfter(ShadowRenew_H2(Register_Array_H2(head),corner,0,NULL)); - } - } -} - -int doShadSizeArrayM1(SgSymbol *ar, SgExpression **shlist) -{ - int n,i; - int ileft; - n = Rank(ar); - if(!shlist) - { - ileft = ndvm; - for(i=0; icopy()); - return (0); -} - -int doShadSizeArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, SgExpression **shlist) -{ - int rank,nw; - int i=0,iright=0,j=0; - SgExpression *wl,*ew,*lbound[MAX_DIMS], *ubound[MAX_DIMS]; - rank = Rank(ar); - if(!TestMaxDims(shl,ar,st)) - return (0); - for(wl = shl; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(ew->variant() == SHADOW_NAMES_OP) { - lbound[i] = new SgValueExp(0); - ubound[i] = new SgValueExp(0); - j++; - if(!shlist) //interface of RTS1 - Error("Illegal shadow width specification of array '%s'", ar->identifier(), 56, st); - else //interface of RTS2 - ShadowNames(ar,rank-i,ew->lhs()); - } - else if(ew->variant() == DDOT) { - lbound[i] = &(ew->lhs())->copy();//left bound - ubound[i] = &(ew->rhs())->copy();//right bound - } else { - lbound[i] = &(ew->copy());//left bound == right bound - ubound[i] = &(ew->copy()); - } - } - nw = i; - TestShadowWidths(ar, lbound, ubound, nw, st); - if (nw != rank) {// wrong shadow width list length - Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88, st); - return(0); - } - if(shlist && j==i) //interface of RTS2 - { - *shlist = NULL; - return(0); - } - if(!shlist) //interface of RTS1 - { - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(lbound[i]); - iright = ndvm; - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(ubound[i]); - } else //interface of RTS2 - { - *shlist = NULL; - for(i=rank-1;i>=0; i--) - { - *shlist = AddListToList(*shlist,new SgExprListExp(*DvmType_Ref(lbound[i])) ); - *shlist = AddListToList(*shlist,new SgExprListExp(*DvmType_Ref(ubound[i])) ); - } - } - return(iright); -} - -void ShadowNames(SgSymbol *ar, int axis, SgExpression *shadow_name_list) -{ - SgExpression *nml; - SgExpression *head=HeaderRef(ar); - if(!head) return; - for(nml = shadow_name_list; nml; nml = nml->rhs()) - doCallAfter(IndirectShadowRenew(head,axis,nml->lhs())); -} - -void TestShadowWidths(SgSymbol *ar, SgExpression * lbound[], SgExpression * ubound[], int nw, SgStatement *st) - //compare shadow widths with that specified for array 'ar' in SHADOW directive - // or SHADOW attribute of combined directive -{SgExpression *lw[MAX_DIMS], *uw[MAX_DIMS],**pe,*wl,*ew; - int i,n; - pe=SHADOW_(ar); - if(pe){ //distributed array has SHADOW attribute - //looking through the shadow width list of SHADOW directive/attribute - if(!TestMaxDims(*pe,ar,0)) return; - for(wl = *pe, i=0; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(ew->variant() == DDOT){ - lw[i] = ew->lhs();//left bound - uw[i] = ew->rhs();//right bound - } - else { - lw[i] = ew;//left bound == right bound - uw[i] = ew; - } - } - n = i; - for(i=0; iisInteger() && lw[i]->isInteger() && lbound[i]->valueInteger() > lw[i]->valueInteger() ) - Error("Low shadow width of '%s' is greater than the corresponding one specified in SHADOW directive", ar->identifier(), 142,st); - if(ubound[i]->isInteger() && uw[i]->isInteger() && ubound[i]->valueInteger() > uw[i]->valueInteger() ) - Error("High shadow width of '%s' is greater than the corresponding one specified in SHADOW directive", ar->identifier(), 143,st); - } - } - else {//by default shadow width = 1 - if(!IS_DUMMY(ar) && HEADER(ar)) - for(i=0; iisInteger() && lbound[i]->valueInteger() > 1 ) - Error("Low shadow width of '%s' is greater than 1", ar->identifier(), 144,st); - if(ubound[i]->isInteger() && ubound[i]->valueInteger() > 1 ) - Error("High shadow width of '%s' is greater than 1", ar->identifier(), 145,st); - } - } -} - -SgExpression *DeclaredShadowWidths(SgSymbol *ar) -{ - SgExpression **pe,*wl,*ew, *shlist=NULL; - int i; - pe=SHADOW_(ar); - if(pe) //distributed array has SHADOW attribute - { - //looking through the shadow width list of SHADOW directive/attribute - for(wl = *pe, i=0; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(ew->variant() == DDOT){ - shlist = AddElementToList(shlist, DvmType_Ref(ew->rhs())); - shlist = AddElementToList(shlist, DvmType_Ref(ew->lhs())); - } - else { - shlist = AddElementToList(shlist, DvmType_Ref(ew)); - shlist = AddElementToList(shlist, DvmType_Ref(ew)); - } - } - } - else //by default shadow width = 1 - { - int rank = Rank(ar); - for (i=0; isymbol(); - if(HEADER(ar)) - head = HeaderRef(ar); - else { - Error("'%s' isn't distributed array", ar->identifier(),72, st); - return; - } - if(st->expr(0)->symbol() != ar){ - Error("Illegal array in SHADOW_COMPUTE clause: %s", ar->identifier(),264, st); - } - if(!ilh) //interface of RTS1 - { - if(ear->lhs()){ - ileft = ndvm; - iright = doShadSizeArrays(ear->lhs(), ar, st, NULL); - } else - ileft=iright= doShadSizeArrayM1(ar, NULL); - doCallAfter(AddBoundShadow(head, ileft, iright)); - - } else //interface of RTS2 - if(ear->lhs()){ - doShadSizeArrays(ear->lhs(), ar, st, shlist); - doCallAfter(ShadowCompute(ilh,head,Rank(ar),*shlist)); - //doCallAfter(ShadowCompute(ilh,Register_Array_H2(head),Rank(ar),*shlist)); - } else - doCallAfter(ShadowCompute(ilh,head,0,NULL)); - //doCallAfter(ShadowCompute(ilh,Register_Array_H2(head),0,NULL)); -} - -symb_list *DerivedRhsAnalysis(SgExpression *derived_op,SgStatement *stmt, int &nd) -{ - SgExpression *el; - symb_list *dummy_list = NULL; - SgSymbol *s_dummy = NULL; - nd = 0; - // looking through the rhs of derived_op ( WITH target_spec ) - for(el=derived_op->rhs()->lhs();el;el=el->rhs()) - { - if(el->lhs()->variant() == DUMMY_REF) // @align-dummy[ + shadow-name ]... - { - s_dummy = el->lhs()->symbol(); - dummy_list = AddNewToSymbList(dummy_list,s_dummy); - nd++; - } - } -/* - if(!s_dummy) //??? - err("Illegal DERIVED/SHADOW_ADD specification", 629, stmt); -*/ - //reversing dummy_list - symb_list *sl = NULL; - for( ; dummy_list; dummy_list=dummy_list->next) - sl= AddNewToSymbList(sl,dummy_list->symb); - return (sl); //(dummy_list); -} - -int is_derived_dummy(SgSymbol *s, symb_list *dummy_list) -{ - symb_list *sl; - for(sl=dummy_list; sl; sl=sl->next) - if(s == sl->symb) return 1; - return 0; -} - -symb_list *DerivedElementAnalysis(SgExpression *e, symb_list *dummy_list, symb_list *arg_list, SgStatement *stmt) -{ - if(!e) - return (arg_list); - if(isSgValueExp(e)) - return (arg_list); - - if(isSgVarRefExp(e) && !is_derived_dummy(e->symbol(),dummy_list) || e->variant() == CONST_REF) - { - arg_list = AddNewToSymbList(arg_list,e->symbol()); - return (arg_list); - } - - if(isSgArrayRefExp(e) ) //!!! look trough the tree - { - if(HEADER(e->symbol())) - arg_list = AddNewToSymbList(arg_list,e->symbol()); - else - Error("Illegal use of array '%s' in DERIVED/SHADOW_ADD, not implemented yet",e->symbol()->identifier(), 629, stmt); - arg_list = DerivedElementAnalysis(e->lhs(), dummy_list, arg_list, stmt); - return (arg_list); - } - - arg_list = DerivedElementAnalysis(e->lhs(), dummy_list, arg_list, stmt); - arg_list = DerivedElementAnalysis(e->rhs(), dummy_list, arg_list, stmt); - return (arg_list); -} - -symb_list *DerivedLhsAnalysis(SgExpression *derived_op, symb_list *dummy_list, SgStatement *stmt) -{ - SgExpression *el,*e; - symb_list *arg_list = NULL, *sl; - SgExpression *elhs = derived_op->lhs(); //derived_elem_list - // looking through the lhs of derived_op (derived_elem_list) - - for(el=elhs; el; el=el->rhs()) - { - e = el->lhs(); // derived_elem - arg_list = DerivedElementAnalysis(e, dummy_list, arg_list, stmt); - } - return (arg_list); -} - -SgExpression *FillerActualArgumentList(symb_list *paramList, int &nArg) -{ - SgExpression *arg_expr_list = NULL; - symb_list *sl; - nArg = 0; - for (sl = paramList; sl; sl=sl->next) - { - if(isSgArrayType(sl->symb->type())) - { - if(!HEADER(sl->symb)) - continue; - arg_expr_list = AddListToList(arg_expr_list,new SgExprListExp(*new SgArrayRefExp(*sl->symb))); - arg_expr_list = AddListToList(arg_expr_list,ElementOfAddrArgumentList(sl->symb)); - nArg+=2; - } - else - { - arg_expr_list = AddListToList(arg_expr_list,new SgExprListExp(*new SgVarRefExp(*sl->symb))); - nArg++; - } - } - return arg_expr_list; -} - -void DerivedSpecification(SgExpression *edrv, SgStatement *stmt, SgExpression *eFunc[]) -{ - int narg = 0, nd = 0; - symb_list *dummy_list = DerivedRhsAnalysis(edrv,stmt,nd); - symb_list *paramList = DerivedLhsAnalysis(edrv,dummy_list,stmt); - SgSymbol *sf_counter = IndirectFunctionSymbol(stmt,"counter"); - SgSymbol *sf_filler = IndirectFunctionSymbol(stmt,"filler"); - SgStatement *st_counter = CreateIndirectDistributionProcedure(sf_counter, paramList, dummy_list, edrv->lhs(), 0); - SgStatement *st_filler = CreateIndirectDistributionProcedure(sf_filler, paramList, dummy_list, edrv->lhs(), 1); - st_counter->addComment(Indirect_ProcedureComment(stmt->lineNumber())); - SgExpression *argument_list = FillerActualArgumentList(paramList,narg); - eFunc[0] = HandlerFunc (sf_counter, narg, argument_list); // counter function - eFunc[1] = HandlerFunc (sf_filler, narg, argument_list ? &argument_list->copy() : NULL); // filler function - return; -} - -void Shadow_Add_Directive(SgStatement *stmt) -{ - int n,iaxis; - SgExpression *el,*edrv; - for (el=stmt->expr(2),n=0; el; el=el->rhs(),n++) - ; //el->setLhs(HeaderRef(el->lhs()->symbol()));HederRef() for each element of el->lhs() - int rank = Rank(stmt->expr(0)->symbol()); - for (el=stmt->expr(0)->lhs(),iaxis=rank; el; el=el->rhs(),iaxis--) - if(el->lhs()->variant()==DERIVED_OP) - { - edrv = el->lhs(); - break; - } - SgExpression *eFunc[2]; - DerivedSpecification(edrv, stmt, eFunc); - doCallAfter(ShadowAdd(HeaderRef(stmt->expr(0)->symbol()),iaxis,DvmhDerivedRhs(edrv->rhs()),eFunc[0],eFunc[1],stmt->expr(1),n,stmt->expr(2))); - return; -} - -int doAlignIteration(SgStatement *stat, SgExpression *aref) -{ - SgExpression *axis[MAX_LOOP_LEVEL], - *coef[MAX_LOOP_LEVEL], - *cons[MAX_LOOP_LEVEL]; - int i; - int nt = Alignment(stat,aref,axis,coef,cons,0); - // setting on arrays - for(i=nt-1; i>=0; i--) - doAssignStmtAfter(axis[i]); - for(i=nt-1; i>=0; i--) - doAssignStmtAfter(ReplaceFuncCall(coef[i])); - for(i=nt-1; i>=0; i--) - doAssignStmtAfter(Calculate(cons[i])); - return(nt); -} - -int Alignment(SgStatement *stat, SgExpression *aref, SgExpression *axis[], SgExpression *coef[], SgExpression *cons[],int interface) -// creating axis_array, coeff_array and const_array -// returns the number of elements in align_iteration_list - -{ int i,ni,nt,num, use[MAX_LOOP_LEVEL]; - SgExpression * el,*e,*ei,*elbb, *es; - SgSymbol *l_var[MAX_LOOP_LEVEL], *ar; - SgValueExp c1(1),c0(0),cM1(-1); - - - ni = 0; //counter of elements in loop_control_variable_list - //looking through the loop_control_variable_list - for(el=stat->expr(2); el; el=el->rhs()) { - l_var[ni] = (el->lhs())->symbol(); - use[ni] = 0; - ni++; - } - es = aref ? aref : stat->expr(0); - ar = es->symbol(); // array - - //looking through the align_iteration_list - nt = 0; //counter of elements in align_iteration_list - for(el=es->lhs(); el; el=el->rhs()) { - e = el->lhs(); //subscript expression - if(e->variant()==KEYWORD_VAL || e->variant()==DDOT) { // "*" or ":" - axis[nt] = & cM1.copy(); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - - else { // expression - num = AxisNumOfDummyInExpr(e, l_var, ni, &ei, use, stat); - //printf("\nnum = %d\n", num); - if (num<=0) { - axis[nt] = & c0.copy(); - coef[nt] = & c0.copy(); - cons[nt] = & (e->copy()); - if((elbb = LowerBound(ar,nt)) != NULL && interface != 2) - cons[nt] = & (*cons[nt] - (elbb->copy())); - // correcting const with lower bound of array, if interface != 2 - } - else { - axis[nt] = new SgValueExp(num); - CoeffConst(e, ei, &coef[nt], &cons[nt]); - if(interface != 2) - TestReverse(coef[nt],stat); - if(!coef[nt]){ - err("Wrong iteration-align-subscript in PARALLEL", 160,stat); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else - // correcting const with lower bound of array, if interface != 2 - if((elbb = LowerBound(ar,nt)) != NULL && interface != 2 ) - cons[nt] = &(*cons[nt] - (elbb->copy())); - } - } - - nt++; - } - - if(Rank(ar) && Rank(ar) != nt) - Error("Rank of array '%s' isn't equal to the length of iteration-align-subscript-list", ar->identifier(), 161,stat); - - return(nt); -} - -int DefineLoopNumberForDimension(SgStatement * stat, SgExpression *ear, int loop_num[]) -{ int ni,nt,num,i, use[MAX_LOOP_LEVEL]; - SgExpression * el,*e,*ei; - SgSymbol *l_var[MAX_LOOP_LEVEL], *ar; - if(!ear) return 0; - for(i=MAX_DIMS-1; i; i--) - loop_num[i] = 0; - ni = 0; //counter of elements in loop_control_variable_list - //looking through the loop_control_variable_list - for(el=stat->expr(2); el; el=el->rhs()) { - l_var[ni] = (el->lhs())->symbol(); - use[ni] = 0; - ni++; - } - //ar = stat->expr(0)->symbol(); // array - ar = ear->symbol(); // array - //looking through the align_iteration_list - nt = 0; //counter of elements in align_iteration_list - for(el=ear->lhs(); el; el=el->rhs()) { - e = el->lhs(); //subscript expression - if(e->variant()==KEYWORD_VAL) { // "*" - loop_num[nt] = 0; // -1; - - } - - else { // expression - num = AxisNumOfDummyInExpr(e, l_var, ni, &ei, use, stat); - //printf("\nnum = %d\n", num); - if (num<=0) - loop_num[nt] = 0; - else - loop_num[nt] = num; - } - - nt++; - } - - - return(nt); -} - -int RedFuncNumber(SgExpression *kwe) -{ - char *red_name; - //PTR_LLND thellnd; - red_name = ((SgKeywordValExp *) kwe)->value(); -// red_name = NODE_STRING_POINTER(kwe->thellnd); - if(!strcmp(red_name, "sum")) - return(1); - if(!strcmp(red_name, "product")) - return(2); - if(!strcmp(red_name, "max")) - return(3); - if(!strcmp(red_name, "min")) - return(4); - if(!strcmp(red_name, "and")) - return(5); - if(!strcmp(red_name, "or")) - return(6); - if(!strcmp(red_name, "neqv")) - return(7); - if(!strcmp(red_name, "eqv")) - return(8); - if(!strcmp(red_name, "maxloc")) - return(9); - if(!strcmp(red_name, "minloc")) - return(10); - - return(0); -} - -int RedFuncNumber_2(int num) -{ //MAXLOC: 9=>11, MINLOC: 10=>12 - return(num>8 ? num+2 : num); -} - -int VarType_RTS(SgSymbol *var) -{int t; - t=TestType(var->type()); - if(t==7) //LOGICAL - t=(bind_==0) ? 2 : 1; //there is not LOGICAL type in RTS - return(t); -} - -int VarType(SgSymbol *var) -{ if(IS_POINTER_F90(var) ) - return(0); - else - return (TestType(var->type())); -} - -int TestType_DVMH(SgType *type) -{ - if(!type) - return(-1); - - SgArrayType *artype = isSgArrayType(type); - if(artype) - type = artype->baseType(); - switch(type->variant()) - { - case T_BOOL: - case T_INT: return(1); - - - case T_FLOAT: - case T_DOUBLE: return(3); - - - case T_COMPLEX: - case T_DCOMPLEX: return(5); - - - default: return(-1); - } - -} - -int TestType_RTS(SgType *type) -{ int t; - t=TestType(type); - if(t==7) //LOGICAL - t=(bind_==0) ? 2 : 1; //there is not LOGICAL type in RTS - return (t); -} - -int TestType(SgType *type) -{ int len; - SgArrayType *artype; - - if(!type) - return(0); - - artype=isSgArrayType(type); - if(artype) - type = artype->baseType(); - len = TypeSize(type); /*16.04.04*/ - //len = IS_INTRINSIC_TYPE(type) ? 0 : TypeSize(type); - //len = (TYPE_RANGES(type->thetype)) ? type->length()->valueInteger() : 0; 14.03.03 - if(bind_ == 0) - switch(type->variant()) { - case T_BOOL: if (len == 4) return(7); /*14.11.06 type LOGICAL was introduced in debuger*/ - else return(0); - - case T_INT: if (len == 4) return(1); /*3.11.06 2 => 1 */ - else return(0); - - case T_FLOAT: if (len == 8) return(4); - else if(len == 4) return(3); - else return(0); - - case T_DOUBLE: if (len == 8) return(4); - else return(0); - - case T_COMPLEX: if (len ==16) return(6); - else if(len == 8) return(5); - else return(0); - - case T_DCOMPLEX:if (len ==16) return(6); - else return(0); - - default: return(0); - } - if(bind_ == 1) - switch(type->variant()) { - case T_BOOL: if (len == 8) return(2); - else if(len == 4) return(7); /*14.11.06 type LOGICAL was introduced in debuger*/ - else return(0); - case T_INT: if (len == 8) return(2); - else if(len == 4) return(1); - else return(0); - case T_FLOAT: if (len == 8) return(4); - else if(len == 4) return(3); - else return(0); - case T_DOUBLE: if (len == 8) return(4); - else return(0); - - case T_COMPLEX: if (len ==16) return(6); - else if(len == 8) return(5); - else return(0); - case T_DCOMPLEX:if (len ==16) return(6); - else return(0); - default: return(0); - } - return(0); -} - -/*RTS2*/ -#define rt_UNKNOWN (-1) -#define rt_CHAR 0 -#define rt_INT 1 -#define rt_LONG 2 -#define rt_FLOAT 3 -#define rt_DOUBLE 4 -#define rt_FLOAT_COMPLEX 5 -#define rt_DOUBLE_COMPLEX 6 -#define rt_LOGICAL 7 -#define rt_LLONG 8 -#define rt_UCHAR 9 -#define rt_UINT 10 -#define rt_ULONG 11 -#define rt_ULLONG 12 -#define rt_SHORT 13 -#define rt_USHORT 14 - -int TestType_RTS2(SgType *type) -{ int len; - SgArrayType *artype; - - if(!type) - return(rt_UNKNOWN); - - artype=isSgArrayType(type); - if(artype) - type = artype->baseType(); - len = TypeSize(type); - if(bind_ == 0) - switch(type->variant()) { - case T_BOOL: if (len == 4) return(rt_LOGICAL); - else if(len == 2) return(rt_USHORT); - else if(len == 1) return(rt_CHAR); - else return(rt_UNKNOWN); - - case T_INT: if (len == 4) return(rt_INT); - else if(len == 2) return(rt_SHORT); - else if(len == 1) return(rt_CHAR); - else return(rt_UNKNOWN); - - case T_FLOAT: if (len == 8) return(rt_DOUBLE); - else if(len == 4) return(rt_FLOAT); - else return(rt_UNKNOWN); - - case T_DOUBLE: if (len == 8) return(rt_DOUBLE); - else return(rt_UNKNOWN); - - case T_COMPLEX: if (len ==16) return(rt_DOUBLE_COMPLEX); - else if(len == 8) return(rt_FLOAT_COMPLEX); - else return(rt_UNKNOWN); - - case T_DCOMPLEX:if (len ==16) return(rt_DOUBLE_COMPLEX); - else return(rt_UNKNOWN); - case T_STRING: - case T_CHAR: if (len == 1) return(rt_CHAR); - else return(rt_UNKNOWN); - - default: return(rt_UNKNOWN); - } - if(bind_ == 1) - switch(type->variant()) { - - case T_BOOL: if (len == 8) return(rt_ULONG); - else if(len == 4) return(rt_LOGICAL); - else if(len == 2) return(rt_USHORT); - else if(len == 1) return(rt_CHAR); - else return(rt_UNKNOWN); - case T_INT: if (len == 8) return(rt_LONG); - else if(len == 4) return(rt_INT); - else if(len == 2) return(rt_SHORT); - else if(len == 1) return(rt_CHAR); - else return(rt_UNKNOWN); - case T_FLOAT: if (len == 8) return(rt_DOUBLE); - else if(len == 4) return(rt_FLOAT); - else return(rt_UNKNOWN); - case T_DOUBLE: if (len == 8) return(rt_DOUBLE); - else return(rt_UNKNOWN); - - case T_COMPLEX: if (len ==16) return(rt_DOUBLE_COMPLEX); - else if(len == 8) return(rt_FLOAT_COMPLEX); - else return(rt_UNKNOWN); - case T_DCOMPLEX:if (len ==16) return(rt_DOUBLE_COMPLEX); - else return(rt_UNKNOWN); - case T_STRING: - case T_CHAR: if (len == 1) return(rt_CHAR); - else return(rt_UNKNOWN); - - default: return(rt_UNKNOWN); - } - return(rt_UNKNOWN); -} - -SgExpression *TypeSize_RTS2(SgType *type) -{ - SgArrayType *artype=isSgArrayType(type); - if(artype) - type = artype->baseType(); - int it = TestType_RTS2(type); - SgExpression *ts = it >= 0 ? &SgUMinusOp(*ConstRef(it)) : ConstRef_F95(TypeSize(type)); - return(ts); -} - -int DVMType() -{return(2);} - -int NameIndex(SgType *type) -{int len; - len = TypeSize(type); //IS_INTRINSIC_TYPE(type) ? 0 : TypeSize(type); - switch ( type->variant()) { - case T_INT: return (GETAI); - case T_FLOAT: return((len == 8) ? GETAD : GETAF); - case T_BOOL: return (GETAL); - case T_DOUBLE: return (GETAD); - case T_COMPLEX: return (GETAC); - case T_DCOMPLEX: return (GETAC); - case T_STRING: return (GETACH); - case T_CHAR: return (GETACH); - default: return (GETAI); - } -} - -SgType *Base_Type(SgType *type) -{ return ( isSgArrayType(type) ? type->baseType() : type);} - -void doLoopStmt(SgStatement *st) -{ - SgStatement *dost, *contst; - SgValueExp c1(1); - SgLabel *loop_lab; - SgSymbol *sio; - int i; -//!!! - nio = 3; -//!!! - sio = st->expr(0)->lhs()->symbol(); - buf_use[TypeIndex(sio->type()->baseType())] = 1; -// SgSymbol * dovar = new SgVariableSymb("IDVM01",*SgTypeInt(), *func); - loop_lab = GetLabel(); - contst = new SgStatement(CONT_STAT); - dost= new SgForStmt(*loop_var[0], c1.copy(), c1.copy(), c1.copy(), *contst); - BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; - (dost->lexNext())->setLabel(*loop_lab); - for(i=1; i<3; i++){ - dost= new SgForStmt(*loop_var[i], c1.copy(), c1.copy(), c1.copy(), - *dost); - BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; - } - - st->insertStmtAfter(*dost); - for(i=0; i<3; i++) - contst->lexNext()->extractStmt(); - //dost->lexNext()->lexNext()->lexNext()->extractStmt(); - //dost->lexNext()->lexNext()->lexNext()->extractStmt(); - - // generating the construction IF () THEN < > ELSE < > ENDIF - // and then insert it before CONTINUE statement - /* SgStatement *if_stmt =new SgIfStmt(*(current->controlParent())->expr(0) , *current); - contst -> insertStmtBefore(*if_stmt); - */ - cur_st = contst; -} - -SgExpression *ReplaceParameter(SgExpression *e) -{ - if(!e) - return(e); - if(e->variant() == CONST_REF) { - SgConstantSymb * sc = isSgConstantSymb(e->symbol()); - if(!sc->constantValue()) - { Err_g("An initialization expression is missing: %s",sc->identifier(),267); - return(e); - } - return(ReplaceParameter(&(sc->constantValue()->copy()))); - } - e->setLhs(ReplaceParameter(e->lhs())); - e->setRhs(ReplaceParameter(e->rhs())); - return(e); -} - -SgExpression *ReplaceFuncCall(SgExpression *e) -{ - if(!e) - return(e); - if(isSgFunctionCallExp(e) && e->symbol()) {//function call - if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"number_of_processors") || !strcmp(e->symbol()->identifier(),"actual_num_procs") || !strcmp(e->symbol()->identifier(),"number_of_nodes"))) { //NUMBER_OF_PROCESSORS() or // ACTUAL_NUM_PROCS() or NUMBER_OF_NODES() - SgExprListExp *el1,*el2; - if(!strcmp(e->symbol()->identifier(),"number_of_processors")) - el1 = new SgExprListExp(*ParentPS()); - else - el1 = new SgExprListExp(*CurrentPS()); - el2 = new SgExprListExp(*ConstRef(0)); - e->setSymbol(fdvm[GETSIZ]); - fmask[GETSIZ] = 1; - el1->setRhs(el2); - e->setLhs(el1); - return(e); - } - - if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"processors_rank"))) { - //PROCESSORS_RANK() - SgExprListExp *el1; - el1 = new SgExprListExp(*ParentPS()); - e->setSymbol(fdvm[GETRNK]); - fmask[GETRNK] = 1; - e->setLhs(el1); - return(e); - } - - if(!strcmp(e->symbol()->identifier(),"processors_size")) { - //PROCESSORS_SIZE() - SgExprListExp *el1; - el1 = new SgExprListExp(*ParentPS()); - e->setSymbol(fdvm[GETSIZ]); - fmask[GETSIZ] = 1; - el1->setRhs(*(e->lhs())+(*ConstRef(0))); //el1->setRhs(e->lhs()); - e->setLhs(el1); - return(e); - } - } - e->setLhs(ReplaceFuncCall(e->lhs())); - e->setRhs(ReplaceFuncCall(e->rhs())); - return(e); -} - -SgExpression *Calculate(SgExpression *e) -{ SgExpression *er; - er = ReplaceParameter( &(e->copy())); - if(er->isInteger()) - return( new SgValueExp(er->valueInteger())); - else - return(ReplaceFuncCall(e)); -} - -int ExpCompare(SgExpression *e1, SgExpression *e2) -{//compares two expressions -// returns 1 if they are textually identical - if(!e1 && !e2) // both expressions are null - return(1); - if(!e1 || !e2) // one of them is null - return(0); - if(e1->variant() != e2->variant()) // variants are not equal - return(0); - switch (e1->variant()) { - case INT_VAL: - return(NODE_IV(e1->thellnd) == NODE_IV(e2->thellnd)); - case BOOL_VAL: - return(NODE_BOOL_CST(e1->thellnd) == NODE_BOOL_CST(e2->thellnd)); - case FLOAT_VAL: - case DOUBLE_VAL: - case CHAR_VAL: - case STRING_VAL: - return(!strcmp(NODE_STR(e1->thellnd),NODE_STR(e2->thellnd))); - case COMPLEX_VAL: - return(ExpCompare(e1->lhs(),e2->lhs()) && ExpCompare (e1->rhs(),e2->rhs())); - case CONST_REF: - case VAR_REF: - return(e1->symbol() == e2->symbol()); - case ARRAY_REF: - case FUNC_CALL: - if(e1->symbol() == e2->symbol()) - return(ExpCompare(e1->lhs(),e2->lhs())); // compares subscript/argument lists - else - return(0); - case EXPR_LIST: - {SgExpression *el1,*el2; - for(el1=e1,el2=e2; el1&&el2; el1=el1->rhs(),el2=el2->rhs()) - if(!ExpCompare(el1->lhs(),el2->lhs())) // the corresponding elements of lists are not identical - return(0); - if(el1 || el2) //one list is shorter than other - return(0); - else - return(1); - } - case MINUS_OP: //unary operations - case NOT_OP: - return(ExpCompare(e1->lhs(),e2->lhs())); // compares operands - default: - return(ExpCompare(e1->lhs(),e2->lhs()) && ExpCompare (e1->rhs(),e2->rhs())); - } -} - -int RemAccessRefCompare(SgExpression *e1, SgExpression *e2) -{ // returns 1 if e2 ArrayRef in current statement is identical the e1 ArrayREf in precedent REMOTE_ACCESS statement - SgExpression *el1, *el2; - if(!e1) // for error situation in REMOTE_ACCESS - return(0); - - if(e1->variant() != e2->variant()) // variants are not equal ( for error situation in REMOTE_ACCESS) - return(0); - - if(e1->symbol() != e2->symbol()) //different array references - return(0); - - if(!e1->lhs()) // whole array in REMOTE_ACCESS - return(1); - - for(el1=e1->lhs(),el2=e2->lhs(); el1&&el2; el1=el1->rhs(),el2=el2->rhs()) //compares subscript lists - if(el1->lhs()->variant() == DDOT) // is ':' element - ; - else - if(!ExpCompare(el1->lhs(),el2->lhs())) // corresponding subscript expressions are not identical - return(0); - if(el1 || el2) //one list is shorter than other - return(0); - else - return(1); -} - -SgExpression * isRemAccessRef(SgExpression *e) - //returns remote-variable with which array reference 'e' consides or NULL -{SgExpression *el; - rem_acc *r; - if(HPF_program && !inparloop){ - //rem_var *rv = (rem_var *) e->attributeValue(0,REMOTE_VARIABLE) ; - if( e->attributeValue(0,REMOTE_VARIABLE)) - return(e); - else - return(NULL); - } -//looking through the remote-access directive/clause list - for(r=rma; r; r=r->next) -//looking through the remote-variable list - for(el=r->rml; el; el=el->rhs()) - if(el->lhs()->attributeValue(0,REMOTE_VARIABLE) && RemAccessRefCompare(el->lhs(), e)) - return(el->lhs()); - return(NULL); -} - -void ChangeRemAccRef(SgExpression *e, SgExpression *rve) -//changes remote-access reference by special buffer reference (multiplicated array i.e.DISTRIBUTE(*,*,...,*)) -// remote-variable attribute saves information about this buffer array -{rem_var *rv = (rem_var *) rve->attributeValue(0,REMOTE_VARIABLE) ; - SgExpression *p = NULL; - SgExpression *el1, *el2,**dov; - SgSymbol *ar; - -ar = e->symbol(); -if(rv->ncolon) { //there are ':'elements in index list of remote variable - //looking through the subscript and index lists - for(el1=rve->lhs(),el2=e->lhs(); el1 && el2; el1=el1->rhs(),el2=el2->rhs()) - if(el1->lhs()->variant() == DDOT) // ':' - p=el2; - else if((dov=IS_DO_VARIABLE_USE(el1->lhs()))){ //do-variable-use - el2->setLhs(*dov); - p=el2; - } - else - //delete corresponding subscript in remote_access reference - if(!p) - e->setLhs(el2->rhs()); - else - p->setRhs(el2->rhs()); - - if(for_kernel || for_host) - { - if(rv->buffer) - e->setSymbol(rv->buffer); /*ACC*/ - } - else - e->setSymbol(baseMemory(ar->type()->baseType())); - if(for_host) /*ACC*/ - return; // is not linearized - - if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) - { - if(rv->buffer) - (e->lhs())->setLhs(*LinearFormB_for_ComputeRegion (rv->buffer, rv->ncolon, e->lhs())); /*ACC*/ - } - else - (e->lhs())->setLhs(*LinearFormB(((rv->amv == 1) ? ar : (SgSymbol *) NULL), rv->index, rv->ncolon, e->lhs())); - (e->lhs())->setRhs(NULL); -} -else { - if(rv->amv == -1) - { - int tInt = TypeIndex(e->symbol()->type()->baseType()); - if(tInt != -1) - e->setSymbol(rmbuf[tInt]); - e->setLhs(new SgExprListExp(*new SgValueExp(rv->index))); - } - else { - if(for_kernel || for_host) - { - if(rv->buffer) - e->setSymbol(rv->buffer); /*ACC*/ - } - else - e->setSymbol(baseMemory(ar->type()->baseType())); - if(for_host) - { /*ACC*/ - e->setLhs (*new SgExprListExp(*new SgValueExp(0))); - return; - } - if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) - { - if(rv->buffer) - (e->lhs())->setLhs(*LinearFormB_for_ComputeRegion (rv->buffer, rv->ncolon, NULL)); /*ACC*/ - } - else - (e->lhs())->setLhs(*LinearFormB(((rv->amv == 1) ? ar : (SgSymbol *) NULL), rv->index, rv->ncolon, NULL)); - (e->lhs())->setRhs(NULL); - } -} -return; -} - -int CreateBufferArray (int rank, SgExpression *rme, int *amview, SgStatement *stmt) -{int ihead,isize,i,j,iamv,ileft,idis; - SgExpression *es,*esz[MAX_DIMS], *elb[MAX_DIMS]; - ihead = ndvm; // allocating array header for buffer array - ndvm+=2*rank+2; - iamv = *amview = ndvm++; - for(es=rme->lhs(),i=0,j=0; es; es=es->rhs(),i++) //looking through the index list - if(es->lhs()->variant() == DDOT) { - //determination of dimension size - esz[j] = ArrayDimSize(rme->symbol(),i+1); - if(esz[j] && esz[j]->variant()==STAR_RANGE) - Error("Assumed-size array: %s",rme->symbol()->identifier(),162,stmt); - if(!esz[j]) //esz[j] == NULL (error situation) - esz[j] = new SgValueExp(1); //for continuing traslation - else - esz[j] = Calculate(esz[j]); - elb[j] = header_ref(rme->symbol(),Rank(rme->symbol())+i+3); - // Exprn(LowerBound(rme->symbol(),i)); - j++; - } - isize = ndvm; - for(j=rank; j; j--) //creating Size Array - doAssignStmtAfter(esz[j-1]); - - /*generating function call:CrtAMV(AMRef,Rank,SizeArray,StaticSign)*/ - doAssignTo_After(DVM000(iamv),CreateAMView(DVM000(isize),rank,0)); //creating the representation of abstact machine - - idis = ndvm; - for(j=rank; j; j--) //creating DisRule Array for DISTRIBUTE(*,*,...,*) - doAssignStmtAfter(new SgValueExp(0)); - /*generating function call:DisAM(AMViewRef,PSRef,ParamCount, AxisArray, DistrParamArray)*/ - doAssignStmtAfter(DistributeAM(DVM000(iamv),CurrentPS(),rank,idis,idis));//distributing - - - ileft = ndvm; - for(j=rank; j; j--) //creating LeftShSizeArray == RightShSizeArray = {0,..,0} - doAssignStmtAfter(new SgValueExp(0)); - - for(j=0; jsymbol(),DVM000(ihead),DVM000(isize),rank,ileft,ileft,0,0)); - //creating distributed array ("replicated") - - - ndvm = isize; - for(j=1; j<=rank; j++) //creating AxisArray = {1,2,..,rank} - doAssignStmtAfter(new SgValueExp(j)); - - ndvm = idis; - for(j=rank; j; j--) //creating CoeffArray = {1,1,...,1} - doAssignStmtAfter(new SgValueExp(1)); - - //ConstArray = {0,0,...,0} - - /*generating call:AlnDa(ArrayHeader,AMViewRef,AxisArray,CoefArray,ConstArray)*/ - doAssignStmtAfter(AlignArray(DVM000(ihead),DVM000(iamv),isize,idis,ileft));//aligning - - - //doAssignTo_After(DVM000(ihead+rank+1),BufferHeaderNplus1(rme,rank,ihead)); - // calculating HEADER(rank+1) - SET_DVM(isize); - return(ihead); -} - -void CopyToBuffer(int rank, int ibuf, SgExpression *rme) -{ int itype,iindex,i,j,from_init,to_init; - SgExpression *es,*ei[MAX_DIMS],*el[MAX_DIMS],*head; - SgValueExp MM1(-1); - - if(!rank) { // copying one element of distributed array to buffer - itype = TypeIndex(rme->symbol()->type()->baseType()); - if(itype == -1) - itype = 0; - SgExpression *are = new SgArrayRefExp(*rmbuf[itype],*new SgValueExp(ibuf));//buffer reference - - for(es=rme->lhs(),i=0; es; es=es->rhs(),i++){ //looking through the index list - ei[i] = &( es->lhs()->copy() - *Exprn( LowerBound(rme->symbol(),i))); - } - iindex = ndvm; - for(j=i; j; j--) - doAssignStmtAfter(ei[j-1]); - - if((head=HeaderRef(rme->symbol())) != NULL) // NULL if array is not distributed (error) - doAssignStmtAfter(ReadWriteElement(head,are,iindex)); - - if(dvm_debug) - InsertNewStatementAfter(D_RmBuf(head,GetAddresMem(are),0,iindex),cur_st,cur_st->controlParent()); - - SET_DVM(iindex); - return; - } - //copying section of distributed array to buffer array - - for(es=rme->lhs(),i=0; es; es=es->rhs(),i++) {//looking through the index list - if(es->lhs()->variant() != DDOT) - ei[i] = &( es->lhs()->copy() - * Exprn(LowerBound(rme->symbol(),i))); //init index - else - ei[i] =& MM1.copy(); // -1 - el[i] = & ei[i]->copy(); //last index - } - from_init = ndvm; - for(j=i; j; j--) - doAssignStmtAfter(ei[j-1]); - for(j=i; j; j--) - doAssignStmtAfter(el[j-1]); - to_init = ndvm; - for(j=rank; j; j-- ) - doAssignStmtAfter(& MM1.copy()); - - if((head=HeaderRef(rme->symbol())) != NULL) // NULL if array is not distributed (error) - doAssignStmtAfter(ArrayCopy(head, from_init, from_init+i, from_init, DVM000(ibuf), to_init, to_init, to_init, 0)); - if(dvm_debug) - InsertNewStatementAfter(D_RmBuf(head,GetAddresMem(DVM000(ibuf)),i,from_init),cur_st,cur_st->controlParent()); - - SET_DVM(from_init); - return; -} - -void RemoteAccessDirective(SgStatement *stmt) -{SgStatement *rmout; - if(inparloop) { - err("The directive is inside the range of PARALLEL loop", 98,stmt); - return; - } - ReplaceContext(stmt->lexNext()); - switch(stmt->lexNext()->variant()) { - case LOGIF_NODE: - rmout = stmt->lexNext()->lexNext()->lexNext(); - break; - case SWITCH_NODE: - rmout = stmt->lexNext()->lastNodeOfStmt()->lexNext(); - break; - case IF_NODE: - rmout = lastStmtOfIf(stmt->lexNext())->lexNext(); - break; - case CASE_NODE: - case ELSEIF_NODE: - err("Misplaced REMOTE_ACCESS directive", 99,stmt); - rmout = stmt->lexNext()->lexNext(); - break; - case FOR_NODE: - case WHILE_NODE: - rmout = lastStmtOfDo(stmt->lexNext())->lexNext(); - break; - case DVM_PARALLEL_ON_DIR: - rmout = lastStmtOfDo(stmt->lexNext()->lexNext())->lexNext(); - break; - default: - rmout = stmt->lexNext()->lexNext(); - break; - } - // adding new element to remote_access directive/clause list - AddRemoteAccess(stmt->expr(0),rmout); - - LINE_NUMBER_AFTER(stmt,stmt); //for tracing - - // looking through the remote variable list - - RemoteVariableList(stmt->symbol(),stmt->expr(0),stmt); -} - -SgExpression *AlignmentListForRemoteDir(int nt, SgExpression *axis[], SgExpression *coef[], SgExpression *cons[]) -{ // case of RTS2 interface - SgExpression *arglist=NULL, *el, *e; - - for(int i=0; isetRhs(arglist); - arglist = el; - } - (el = new SgExprListExp(*ConstRef(nt)))->setRhs(arglist); // add rank to axis list - arglist = el; - return arglist; -} - -void RemoteVariableList1(SgSymbol *group,SgExpression *rml, SgStatement *stmt) -{ SgStatement *if_st,*end_st = NULL; - SgExpression *el, *es; - int nc; //counter of ':' elements of remote-index-list - int n; //counter of elements of remote-index-list - int rank; //rank of remote variable - int ibuf = 0; - int iamv =-1; - if(group){ - if_st = doIfThenConstrForRemAcc(group,cur_st); - end_st = cur_st; //END IF - cur_st = if_st; - } - for(el=rml; el; el= el->rhs()) { - if(!HEADER(el->lhs()->symbol())) //if non-distributed array occurs - Error("'%s' is not distributed array",el->lhs()->symbol()->identifier(),72,stmt); - n = 0; - nc = 0; - // looking through the index list of remote variable - for(es=el->lhs()->lhs(); es; es= es->rhs(),n++) - if(es->lhs()->variant() == DDOT) - nc++; - if((rank=Rank(el->lhs()->symbol())) && rank != n) - Error("Length of remote-index-list is not equal to the rank of remote variable",el->lhs()->symbol()->identifier(),165,stmt); - else - if (nc) { - ibuf = CreateBufferArray(nc,el->lhs(),&iamv, stmt);//creating replicated array - //copying to Buffer Array - CopyToBuffer(nc, ibuf, el->lhs()); - } - else { - ibuf = ++rma->rmbuf_use[TypeIndex(el->lhs()->symbol()->type()->baseType())]; - //copying to buffer - CopyToBuffer(nc, ibuf, el->lhs()); - } - //adding attribute REMOTE_VARIABLE - rem_var *remv = new rem_var; - remv->ncolon = nc; - - remv->index = ibuf; - remv->amv = iamv; - (el->lhs())->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); - } - if(group) - // cur_st = if_st->lastNodeOfStmt(); - cur_st = end_st; -} - -void RemoteVariableList(SgSymbol *group, SgExpression *rml, SgStatement *stmt) -{ SgStatement *if_st,*end_st = NULL; - SgExpression *el, *es,*coef[MAX_DIMS],*cons[MAX_DIMS],*axis[MAX_DIMS], *do_var; - SgExpression *ind_deb[MAX_DIMS]; - int nc; //counter of ':' or do-var-use elements of remote-index-list - int n; //counter of elements of remote-index-list - int rank; //rank of remote variable - int num,use[MAX_DIMS]; - int i,j,st_sign,iaxis,ideb=-1; - SgSymbol *dim_ident[MAX_DIMS],*ar; - int ibuf = 0; - int iamv =0; - int err_subscript = 0; - SgValueExp c0(0),cm1(-1),c1(1); - st_sign = 0; - - if(options.isOn(NO_REMOTE)) - return; - if(IN_COMPUTE_REGION && group) - err("Asynchronous REMOTE_ACCESS clause in compute region",574,stmt); - if(group && parloop_by_handler == 2 && stmt->variant() != DVM_PARALLEL_ON_DIR ) { // case of REMOTE_ACCESS directive - err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); - group = NULL; - } - if(group){ - if_st = doIfThenConstrForRemAcc(group,cur_st); - end_st = cur_st; //END IF - cur_st = if_st; - st_sign = 1; - } - if(stmt->variant() == DVM_PARALLEL_ON_DIR) - for(el=stmt->expr(2),i=0; el; el= el->rhs(),i++){ //do-variable list - //use[i] = 0; - dim_ident[i] = el->lhs()->symbol(); - } - else - i = 0; - - for(el=rml; el; el= el->rhs()) { - if(!HEADER(el->lhs()->symbol())) { //if non-distributed array occurs - Error("'%s' isn't distributed array",el->lhs()->symbol()->identifier(),72,stmt); - doAssignStmtAfter(&c0); - continue; - } - n = 0; - nc = 0; - err_subscript = 0; - for(j=0; jlhs()->lhs(),el->lhs()->symbol(),stmt)) continue; - // looking through the index list of remote variable - for(es=el->lhs()->lhs(); es; es= es->rhs(),n++) - if(es->lhs()->variant() == DDOT){ - axis[n] = &cm1.copy(); - coef[n] = &c0.copy(); - cons[n] = &c0.copy(); - ind_deb[n] = &cm1.copy(); - //init[n] = &c0.copy(); - //last[n] = &c0.copy(); - //step[n] = &c0.copy(); - //dim[nc] = es->lhs(); /*ACC*/ - //dim_num[nc]= n; /*ACC*/ - nc++; - } - else if ((stmt->variant() == DVM_PARALLEL_ON_DIR) && (do_var=isDoVarUse(es->lhs(),use,dim_ident,i,&num,stmt))) { - CoeffConst(es->lhs(), do_var, &coef[n], &cons[n]); - axis[n] = new SgValueExp(num); - TestReverse(coef[n],stmt); - //dim[nc] = es->lhs(); /*ACC*/ - //dim_num[nc]= n; /*ACC*/ - nc++; - if(!coef[n]) { - err("Wrong regular subscript expression", 164,stmt); - err_subscript++; - coef[n] = &c0.copy(); - cons[n] = &c0.copy(); - ind_deb[n] = &c0.copy(); - //init[n] = &c0.copy(); - //last[n] = &c0.copy(); - //step[n] = &c0.copy(); - } else { - // correcting const with lower bound of corresponding array dimension - cons[n] = &(*cons[n] - *Exprn( LowerBound(el->lhs()->symbol(),n))); - ind_deb[n] = &cm1.copy(); - //init[n] = &(init_do[num-1]->copy()); - //last[n] = &(last_do[num-1]->copy()); - //step[n] = &(step_do[num-1]->copy()); - //adding attribute DO_VARIABLE_USE to regular subscript expression - SgExpression **dov = new (SgExpression *); - *dov = do_var; - (es->lhs())->addAttribute(DO_VARIABLE_USE,(void *) dov, sizeof(SgExpression *)); - } - - } else { - axis[n] = &c0.copy(); - coef[n] = &c0.copy(); - cons[n] = parloop_by_handler == 2 ? &es->lhs()->copy() : &(es->lhs()->copy() - *Exprn( LowerBound(el->lhs()->symbol(),n))) ; - ind_deb[n] = &(cons[n]->copy()); - //init[n] = &c0.copy(); - //last[n] = &c0.copy(); - //step[n] = &c0.copy(); - } - rank=Rank(el->lhs()->symbol()); - if(n && rank && rank != n) { - Error("Length of remote-subscript-list is not equal to the rank of remote variable",el->lhs()->symbol()->identifier(),165,stmt); - continue; - } - if(err_subscript) continue; //there is illegal subscript - if(!n) {//remote-subscript-list is absent (whole array is remote data) - for (; n<=rank-1; n++) { - axis[n] = &cm1.copy(); - coef[n] = &c0.copy(); - cons[n] = &c0.copy(); - ind_deb[n] = &cm1.copy(); - //init[n] = &c0.copy(); - //last[n] = &c0.copy(); - //step[n] = &c0.copy(); - //dim[n] = new SgExpression(DDOT); /*ACC*/ - //dim_num[n]= n; /*ACC*/ - } - nc = rank; - } - // allocating array header for buffer array - if(group){ - int nbuf; - nbuf = BUFFER_INDEX(el->lhs()->symbol()); - if(nbuf == maxbuf) - err("Buffer limit exceeded",183,stmt); - ibuf = 2*(nbuf+1)*(rank+1) + 2; - BUFFER_COUNT_PLUS_1(el->lhs()->symbol()) - // buffer_head = HeaderRefInd(el->lhs()->symbol(),ibuf); - ar = el->lhs()->symbol(); - } else { - ibuf = ndvm; - if(nc) - ndvm+=2*nc+2; - else - ndvm+=4; - //buffer_head = DVM000(ibuf); - ar = NULL; - } - // adding attribute REMOTE_VARIABLE - rem_var *remv = new rem_var; - remv->ncolon = nc; - remv->index = ibuf; - remv->amv = group ? 1 : iamv; - remv->buffer = NULL; /*ACC*/ - - (el->lhs())->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); - - // case of RTS2-interface - if(parloop_by_handler==2) { - if(stmt->variant() != DVM_PARALLEL_ON_DIR) { - doCallAfter(RemoteAccess_H2(header_rf(ar,ibuf,1), el->lhs()->symbol(), HeaderRef(el->lhs()->symbol()), AlignmentListForRemoteDir(n,axis,coef,cons))); - } - continue; - } - // creating buffer for remote elements of array - iaxis = ndvm; - if (stmt->variant() == DVM_PARALLEL_ON_DIR) { - for(j=n-1; j>=0; j--) - doAssignStmtAfter(axis[j]); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(coef[j])); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(Calculate(cons[j])); - /* - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(init[j])); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(last[j])); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(step[j])); - */ - doCallAfter(CreateRemBuf( HeaderRef(el->lhs()->symbol()), header_rf(ar,ibuf,1), st_sign,iplp,iaxis,iaxis+n,iaxis+2*n)); - } else { - ideb = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmtAfter(Calculate(ind_deb[j])); - doCallAfter(CreateRemBufP( HeaderRef(el->lhs()->symbol()), header_rf(ar,ibuf,1), st_sign,ConstRef(0),ideb)); - } - //if(nc) - // doAssignTo_After(header_rf(ar,ibuf,nc+2),BufferHeaderNplus1(el->lhs(),nc,ibuf,ar)); - // calculating HEADER(nc+1) - //if(IN_COMPUTE_REGION) /*ACC*/ - // ACC_StoreLowerBoundsOfDvmBuffer(el->lhs()->symbol(), dim, dim_num, nc, ibuf, stmt); - - if(ACC_program) /*ACC*/ - ACC_Before_Loadrb(header_rf(ar,ibuf,1)); - - // loading the buffer - doCallAfter(LoadRemBuf( header_rf(ar,ibuf,1))); - // waiting completion of loading the buffer - doCallAfter(WaitRemBuf( header_rf(ar,ibuf,1))); - - if(IN_COMPUTE_REGION) /*ACC*/ - ACC_Region_After_Waitrb(header_rf(ar,ibuf,1)); - if(group) - //inserting buffer in group - doAssignStmtAfter(InsertRemBuf(GROUP_REF(group,1), header_rf(ar,ibuf,1))); - if(dvm_debug) { - if (stmt->variant() == DVM_PARALLEL_ON_DIR) { - ideb = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(ind_deb[j])); - } - InsertNewStatementAfter(D_RmBuf( HeaderRef(el->lhs()->symbol()),GetAddresDVM( header_rf(ar,ibuf,1)),n,ideb),cur_st,cur_st->controlParent()); - } - //SET_DVM(iaxis); //11.02.25 - } - - if(group) { - cur_st = cur_st->lexNext()->lexNext();//IF THEN after ELSE - doAssignStmtAfter(WaitBG(GROUP_REF(group,1))); - FREE_DVM(1); - //cur_st = if_st->lastNodeOfStmt(); - cur_st = end_st; - } -} - -void IndirectList(SgSymbol *group, SgExpression *rml, SgStatement *stmt) -{ SgStatement *if_st,*end_st = NULL; - SgExpression *el, *es,*cons[MAX_DIMS]; - SgSymbol *mehead; - int nc; //counter of indirect access dimensions - int n; //counter of elements of indirect-subscript-list - int rank; //rank of remote variable - int j,st_sign,icons; - SgSymbol *dim_ident; - int ibuf = 0; - int iamv =0; - SgValueExp c0(0),cm1(-1),c1(1); - st_sign = 0; - if(group){ - if_st = doIfThenConstrForRemAcc(group,cur_st); - end_st = cur_st; //END IF - cur_st = if_st; - st_sign = 1; - } - dim_ident = stmt->expr(2)->lhs()->symbol(); //do-variable - for(el=rml; el; el= el->rhs()) { - if(!HEADER(el->lhs()->symbol())) //if non-distributed array occurs - Error("'%s' isn't distributed array",el->lhs()->symbol()->identifier(),72,stmt); - n = 0; - nc = 0; - // looking through the index list of remote variable - for(es=el->lhs()->lhs(); es; es= es->rhs(),n++) - if ((mehead = isIndirectSubscript(es->lhs(),dim_ident,stmt))) { - nc++; - cons[n] = & SgUMinusOp(*Exprn( LowerBound(el->lhs()->symbol(),n))); - //adding attribute INDIRECT_SUBSCRIPT to irregular subscript expression - SgSymbol **me = new (SgSymbol *); - *me = mehead; - (es->lhs())->addAttribute(INDIRECT_SUBSCRIPT,(void *) me, sizeof(SgSymbol *)); - } else - cons[n] = &(es->lhs()->copy() - *Exprn( LowerBound(el->lhs()->symbol(),n))) ; - - if((rank=Rank(el->lhs()->symbol())) && rank != n) { - Error("Length of indirect-subscript-list is not equal to the rank of remote variable",el->lhs()->symbol()->identifier(),302,stmt); - continue; - } - - // allocating array header for buffer array - ibuf = ndvm; - ndvm+=+4; - if(!mehead || (nc > 1)){ - // err("Illegal indirect reference",stmt); - return; - } - // creating buffer for indirect access elements of array - icons = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmtAfter(Calculate(cons[j])); - doAssignStmtAfter(CreateIndBuf( HeaderRef(el->lhs()->symbol()), DVM000(ibuf), st_sign,HeaderRef(mehead),icons)); - doAssignTo_After(DVM000(ibuf+3),BufferHeader4(el->lhs(),ibuf)); - // calculating HEADER(nc+1) - // loading the buffer - doAssignStmtAfter(LoadIndBuf(DVM000(ibuf))); - if(group) - //inserting buffer in group - doAssignStmtAfter(InsertIndBuf(group,DVM000(ibuf))); - // waiting completion of loading the buffer - doAssignStmtAfter(WaitIndBuf(DVM000(ibuf))); - if(dvm_debug) - InsertNewStatementAfter(D_RmBuf( HeaderRef(el->lhs()->symbol()),GetAddresMem(DVM000(ibuf)),n,icons),cur_st,cur_st->controlParent()); - SET_DVM(icons); - //adding attribute REMOTE_VARIABLE - rem_var *remv = new rem_var; - remv->ncolon = nc; - - remv->index = ibuf; - remv->amv = iamv; - (el->lhs())->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); - - } - if(group) { - cur_st = cur_st->lexNext()->lexNext();//IF THEN after ELSE - doAssignStmtAfter(WaitIG(group)); - FREE_DVM(1); - //cur_st = if_st->lastNodeOfStmt(); - cur_st = end_st; - } -} - - - -void DeleteBuffers(SgExpression *rml) -{ SgExpression *el; - rem_var *remv; - SgStatement *current = cur_st;//store value of cur_st - SgLabel *lab; - //cur_st = cur_st->lexPrev(); - for(el=rml; el; el= el->rhs()) { //looking through the remote variable list - remv = (rem_var *) (el->lhs())->attributeValue(0,REMOTE_VARIABLE); - /* if(remv->ncolon) { - doAssignStmtBefore(DeleteObject(DVM000(remv->index)),current);//delete distributed array - doAssignStmtBefore(DeleteObject(DVM000(remv->amv)),current);//delete abstract machine view - FREE_DVM(2); - } - */ - if(remv && remv->amv == 0){ //buffer is not included in named group - current->insertStmtBefore(*DeleteObject_H(header_rf((SgSymbol *) NULL,remv->index,1)),*current->controlParent()); - } - } - cur_st = current; //restore cur_st -} - -void RemoteAccessEnd() -{int i; - for (i=0; irmbuf_use[i]) ? rma->rmbuf_use[i] : rmbuf_size[i]; //maximum - if(rma->rmout) // REMOTE_ACCESS directive (not clause) - DeleteBuffers(rma->rml); //deleting array buffers - DelRemoteAccess(); //deletes element from remote_access directive/clause list - //and concurently frees scalar buffers - -} - -void AddRemoteAccess(SgExpression *rml, SgStatement *rmout) -{int i; - rem_acc *elem = new rem_acc; - elem->rml = rml; - elem->rmout = rmout; - if(!rma) {// first element - elem->next = NULL; - for(i=0; irmbuf_use[i] = 0; - } - else { - elem->next = rma; - for(i=0; irmbuf_use[i] = rma->rmbuf_use[i]; - } - rma = elem; -} - -void DelRemoteAccess() -{ - if(rma) - rma = rma->next; -} - -SgExpression *isSpecialFormExp(SgExpression *e,int i,int ind,SgExpression *vpart[],SgSymbol *do_var[]) -{ - if(e->variant()==ADD_OP){ - if(isInvariantPart(e->lhs()) && isDependentPart(e->rhs(),do_var)) { - vpart[i] = RenewSpecExp(e->rhs(),e->lhs()->valueInteger(),ind); - return(e->lhs()); - } - if(isInvariantPart(e->rhs()) && isDependentPart(e->lhs(),do_var)) { - vpart[i] = RenewSpecExp(e->lhs(),e->rhs()->valueInteger(),ind); - return(e->rhs()); - } - } - if(isDependentPart(e,do_var)){ - vpart[i] = RenewSpecExp(e,0,ind); - return(new SgValueExp(0)); - } - return(NULL); -} - -int isInvariantPart(SgExpression *e) - { return(e->isInteger());} - -int isDependentPart(SgExpression *e,SgSymbol *do_var[]) -{//!!! temporaly - if(do_var[0]) - ; - if(isSgFunctionCallExp(e)){ - if(!strcmp(e->symbol()->identifier(),"mod") && (e->lhs()->lhs()->variant()==ADD_OP)) - return(1); - } - return(0); -} - -SgExpression *RenewSpecExp(SgExpression *e, int cnst, int ind) -{ if(cnst % 2) - ( e->lhs())->setLhs(*DVM000(ind) + (*new SgValueExp(cnst % 2)) + (*e->lhs()->lhs())); - else - ( e->lhs())->setLhs(*DVM000(ind) + (*e->lhs()->lhs())); - return(e); -} - -int isDistObject(SgExpression *e) -{ - if(!e) - return(0); - if(isSgArrayRefExp(e)) - if(HEADER(e->symbol())) - return(1); - if(e->variant() == ARRAY_OP) - return(isDistObject(e->lhs())); - return(0); -} - -int isListOfArrays(SgExpression *e, SgStatement *st) -{SgExpression *el; - int test = 0; - for(el=e; el; el = el->rhs()) { - if(!(el->lhs()->symbol()->attributes() & DIMENSION_BIT) && !IS_POINTER(el->lhs()->symbol())) { - Error("'%s' is not array",el->lhs()->symbol()->identifier(), 66,st); - test = 1; - } - - if( el->lhs()->lhs() && !((el->lhs()->symbol()->attributes() & TEMPLATE_BIT) || (el->lhs()->symbol()->attributes() & PROCESSORS_BIT))) - Error("Shape specification is not permitted: %s", el->lhs()->symbol()->identifier(), 263, st); - } - return(test); -} - -char * AttrName(int i) -{ switch (i) { - case 0: return("ALIGN"); - case 1: return("DISTRIBUTE"); - case 2: return("TEMPLATE"); - case 3: return("PROCESSORS"); - case 4: return("DIMENSION"); - case 5: return("DYNAMIC"); - case 6: return("SHADOW"); - case 7: return("COMMON"); - default: return("NONE"); - } -} - -int TestShapeSpec(SgExpression *e) -{//temporary - return(isSgValueExp(e)? 1 : 1); -} - -void AddToGroupNameList (SgSymbol *s) -{group_name_list *gs; -//adding the symbol 's' to group_name_list - if(!grname) { - grname = new group_name_list; - grname->symb = s; - grname->next = NULL; - } else { - for(gs=grname; gs; gs=gs->next) - if(gs->symb == s) - return; - gs = new group_name_list; - gs->symb = s; - gs->next = grname; - grname = gs; - } -} - -symb_list *AddToSymbList ( symb_list *ls, SgSymbol *s) -{symb_list *l; -//adding the symbol 's' to symb_list 'ls' - if(!ls) { - ls = new symb_list; - ls->symb = s; - ls->next = NULL; - } else { - /* - for(l=ls; l; l=l->next) - if(l->symb == s) - return; - */ - l = new symb_list; - l->symb = s; - l->next = ls; - ls = l; - } - return(ls); -} - -symb_list *AddNewToSymbList ( symb_list *ls, SgSymbol *s) -{symb_list *l; -//adding the symbol 's' to symb_list 'ls' - if(!ls) { - ls = new symb_list; - ls->symb = s; - ls->next = NULL; - } else { - for(l=ls; l; l=l->next) - if(l->symb == s) - return(ls); - l = new symb_list; - l->symb = s; - l->next = ls; - ls = l; - } - return(ls); -} - -symb_list *AddNewToSymbListEnd ( symb_list *ls, SgSymbol *s) -{symb_list *l, *lprev; -//adding the symbol 's' to symb_list 'ls' - if(!ls) { - ls = new symb_list; - ls->symb = s; - ls->next = NULL; - } else { - for(l=ls; l; lprev=l, l=l->next) - if(l->symb == s) - return(ls); - l = new symb_list; - l->symb = s; - l->next = NULL; - lprev->next = l; - } - return(ls); -} - -symb_list *MergeSymbList(symb_list *ls1, symb_list *ls2) -{ - symb_list *l =ls1; - if(!ls1) - return (ls2); - while(l->next) - l = l->next; - l->next = ls2; - return ls1; -} - -symb_list *CopySymbList(symb_list *ls) -{ - symb_list *l=NULL, *el, *cp=NULL; - while(ls) - { - el = new symb_list; - el->symb = ls->symb; - el->next = NULL; - if(l) - l->next = el; - else - cp = el; - l = el; - ls = ls->next; - } - return cp; -} - -void DeleteSymbList(symb_list *ls) -{symb_list *l; - - while(ls) - { l = ls; - ls =ls->next; - delete l; - } -} - -filename_list *AddToFileNameList ( char *s) -{filename_list *ls; - SgType *tch; - SgExpression *le; - int length; -//adding the name 's' to filename_list 'ls' - if(!fnlist) { - ls = new filename_list; - ls->name = s; - ls->next = NULL; - le = new SgExpression(LEN_OP); - length = strlen(s)+1; - le->setLhs(new SgValueExp(length)); - tch = new SgType(T_STRING,le,SgTypeChar()); - ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); - fnlist = ls; - } else { - for(ls=fnlist; ls; ls=ls->next) - if(ls->name == s) - return(ls); - ls = new filename_list; - ls->name = s; - ls->next = fnlist; - le = new SgExpression(LEN_OP); - length = strlen(s)+1; - le->setLhs(new SgValueExp(length)); - tch = new SgType(T_STRING,le,SgTypeChar()); - ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); - fnlist = ls; - } - return(ls); -} - -filename_list *AddToFileNameList(const char *s_in) -{ - char *s = new char[strlen(s_in) + 1]; - strcpy(s, s_in); - - filename_list *ls; - SgType *tch; - SgExpression *le; - int length; - //adding the name 's' to filename_list 'ls' - if (!fnlist) { - ls = new filename_list; - ls->name = s; - ls->next = NULL; - le = new SgExpression(LEN_OP); - length = strlen(s) + 1; - le->setLhs(new SgValueExp(length)); - tch = new SgType(T_STRING, le, SgTypeChar()); - ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); - fnlist = ls; - } - else { - for (ls = fnlist; ls; ls = ls->next) - if (ls->name == s) - return(ls); - ls = new filename_list; - ls->name = s; - ls->next = fnlist; - le = new SgExpression(LEN_OP); - length = strlen(s) + 1; - le->setLhs(new SgValueExp(length)); - tch = new SgType(T_STRING, le, SgTypeChar()); - ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); - fnlist = ls; - } - return(ls); -} - -void InsertDebugStat(SgStatement *func, SgStatement* &end_of_unit) -{ - SgStatement *stmt,*last, *data_stf, *first,*first_dvm_exec,*last_spec,*last_dvm_entry, *lentry = NULL; - SgStatement *mod_proc; - SgStatement *copy_proc = NULL; - SgStatement *has_contains = NULL; - SgLabel *lab_exec; - stmt_list *pstmt = NULL; - int contains[2]; - int in_on=0; - - //initialization - dsym = NULL; - grname = NULL; - saveall = 0; - maxdvm = 0; - maxhpf = 0; - count_reg = 0; - initMask(); - data_stf = NULL; - inparloop = 0; - inasynchr = 0; - redvar_list = NULL; - goto_list = NULL; - proc_symb = NULL; - task_symb = NULL; - consistent_symb = NULL; - async_symb=NULL; - check_sum = NULL; - loc_templ_symb=NULL; - index_symb = NULL; - in_task_region = 0; - task_ind = 0; - in_task = 0; - task_lab = NULL; - pref_st = NULL; - pipeline = 0; - registration = NULL; - filename_num = 0; - fnlist = NULL; - nloopred = 0; - nloopcons = 0; - wait_list = NULL; - SIZE_function = NULL; - dvm_const_ref = 0; - in_interface = 0; - mod_proc = NULL; - if_goto = NULL; - nifvar = 0; - entry_list = NULL; - dbif_cond = 0; - dbif_not_cond = 0; - last_dvm_entry = NULL; - all_replicated = 0; - IOstat = NULL; - privateall = 0; - - TempVarDVM(func); - initF90Names(); - - first = func->lexNext(); - //get the last node of the program unit(function) - last = func->lastNodeOfStmt(); - end_of_unit = last; - if(!(last->variant() == CONTROL_END)) - printf(" END Statement is absent\n"); -//********************************************************************** -// Specification Directives Processing -//********************************************************************** -// follow the statements of the function in lexical order -// until first executable statement - for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { - if (!isSgExecutableStatement(stmt)) //is Fortran specification statement -// isSgExecutableStatement: -// FALSE - for specification statement of Fortan 90 -// TRUE - for executable statement of Fortan 90 - { - //!!!debug - // printVariantName(stmt->variant()); - // printf("\n"); - // printf("%s %d\n",stmt->lineNumber(), - // analizing SAVE statement - if(stmt->variant()==SAVE_DECL) { - if (!stmt->expr(0)) //SAVE without name-list - saveall = 1; - else if(IN_MAIN_PROGRAM) - pstmt = addToStmtList(pstmt, stmt); //for extracting and replacing by SAVE without list - continue; - } - // deleting SAVE-attribute from Type Declaration Statement (for replacing by SAVE without list) - if(IN_MAIN_PROGRAM && isSgVarDeclStmt(stmt)) - DeleteSaveAttribute(stmt); - - if(IN_MODULE && stmt->variant() == PRIVATE_STMT && !stmt->expr(0)) - privateall = 1; - - if(debug_regim) { - if(stmt->variant()==COMM_STAT) { - SgExpression *ec, *el; - SgSymbol *sc; - for(ec=stmt->expr(0); ec; ec=ec->rhs()) // looking through COMM_LIST - for(el=ec->lhs(); el; el=el->rhs()) { - sc = el->lhs()->symbol(); - if(sc){ - SYMB_ATTR(sc->thesymb)= SYMB_ATTR(sc->thesymb) | COMMON_BIT; - if(IS_ARRAY(sc)) - registration = AddNewToSymbList( registration, sc); - } - } - continue; - } - - // registrating arrays from variable list of declaration statement - if( isSgVarDeclStmt(stmt) || isSgVarListDeclStmt(stmt)) { - RegistrationList(stmt); - continue; - } - } - - - if(isSgVarDeclStmt(stmt)) VarDeclaration(stmt);// for analizing object list and changing variant of declaration statement by VAR_DECL_90 - if((stmt->variant() == DATA_DECL) || (stmt->variant() == STMTFN_STAT)) { - if(stmt->variant()==STMTFN_STAT) - DECL(stmt->expr(0)->symbol()) = 2; //flag of statement function name - - if(!data_stf) - data_stf = stmt; //first statement in data-or-function statement part - continue; - } - - if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR) { - stmt = InterfaceBlock(stmt); //stmt= stmt->lastNodeOfStmt(); - continue; - } - - if( stmt->variant() == USE_STMT) { - if(stmt->lexPrev() != func && stmt->lexPrev()->variant()!=USE_STMT) - err("Misplaced USE statement", 639, stmt); - continue; - } - if(stmt->variant() == STRUCT_DECL){ - StructureProcessing(stmt); - stmt=stmt->lastNodeOfStmt(); - continue; - } - - continue; - } - if ((stmt->variant() == FORMAT_STAT)) - { - continue; - } - - -// processing the DVM Specification Directives - - switch(stmt->variant()) { - case DVM_REDUCTION_GROUP_DIR: - //if (dvm_debug) - if (debug_regim) - {SgExpression * sl; - for(sl=stmt->expr(0); sl; sl = sl->rhs()) - AddToGroupNameList(sl->lhs()->symbol()); - } - //including the DVM specification directive to list - pstmt = addToStmtList(pstmt, stmt); - continue; - - case(DVM_INDIRECT_GROUP_DIR): - case(DVM_REMOTE_GROUP_DIR): - if (debug_regim && !options.isOn(NO_REMOTE)) - {SgExpression * sl; - for(sl=stmt->expr(0); sl; sl = sl->rhs()){ - SgArrayType *artype; - artype = new SgArrayType(*SgTypeInt()); - artype->addRange(*new SgValueExp(3)); - sl->lhs()->symbol()->setType(artype); - AddToGroupNameList(sl->lhs()->symbol()); - } - } - //including the DVM specification directive to list - pstmt = addToStmtList(pstmt, stmt); - continue; - case(DVM_POINTER_DIR): - if(debug_regim) - {SgExpression *el; - SgStatement **pst = new (SgStatement *); - SgSymbol *sym; - *pst = stmt; - for(el = stmt->expr(0); el; el=el->rhs()){ // name list - sym = el->lhs()->symbol(); // name - sym->addAttribute(POINTER_, (void *) pst, sizeof(SgStatement *)); - } - } - //including the DVM specification directive to list - pstmt = addToStmtList(pstmt, stmt); - continue; - case(ACC_ROUTINE_DIR): - case(ACC_DECLARE_DIR): - case(HPF_PROCESSORS_STAT): - case(HPF_TEMPLATE_STAT): - case(DVM_DYNAMIC_DIR): - case(DVM_SHADOW_DIR): - case(DVM_ALIGN_DIR): - case(DVM_DISTRIBUTE_DIR): - case(DVM_VAR_DECL): - case(DVM_TASK_DIR): - case(DVM_INHERIT_DIR): - case(DVM_HEAP_DIR): - case(DVM_ASYNCID_DIR): - case(DVM_CONSISTENT_DIR): - case(DVM_CONSISTENT_GROUP_DIR): - //including the DVM specification directive to list - pstmt = addToStmtList(pstmt, stmt); - continue; - } -// all declaration statements are processed, -// current statement is executable (F77/DVM) - break; - } - - //TempVarDVM(func); - - for(;pstmt; pstmt= pstmt->next) - Extract_Stmt(pstmt->st);// extracting DVM Specification Directives - - first_exec = stmt; // first executable statement - - // testing procedure (-dbif2 regim) - if(debug_regim && dbg_if_regim>1 && ((func->variant() == PROC_HEDR) || (func->variant() == FUNC_HEDR)) && !pstmt && !isInternalOrModuleProcedure(func) && !lookForDVMdirectivesInBlock(first_exec,func->lastNodeOfStmt(),contains) && !contains[0] && !contains[1]) - copy_proc = CreateCopyOfExecPartOfProcedure(); - - lab_exec = first_exec->label(); // store the label of first ececutable statement - BIF_LABEL(first_exec->thebif) = NULL; - last_spec = stmt->lexPrev(); - where = first_exec; - ndvm = 1; // ndvm is number of first free element of array "dvm000" - nhpf = 1; // nhpf is number of first free element of array "hpf000" - -//generating assign statement -// dvm000(1) = fname(file_name) -//function 'fname' tells the name of source file to DVM run-time system - InsertNewStatementBefore(D_Fname(),first_exec); - - first_dvm_exec = last_spec->lexNext(); //first DVM function call - if(IN_MODULE){ - if(debug_regim ) { - mod_proc = CreateModuleProcedure(cur_func,first_exec,has_contains); - where = mod_proc->lexNext(); - end_of_unit = where; - } else { - first_dvm_exec = last_spec->lexNext(); - goto EXEC_PART_; - } - } - - if(func->variant() == PROG_HEDR) { // MAIN-program -//generating a call statement -// call dvmlf(line_number_of_first_executable_statement,source-file-name) - LINE_NUMBER_STL_BEFORE(cur_st,first_exec,first_exec); -//generating the function call which initializes the control structures of DVM run-time system, -// it's inserted in MAIN program) -// dvm000(1) = -// call dvmh_init(dvm000(1)) - RTL_GPU_Init(); - if(dbg_if_regim) - InitDebugVar(); - } - - ndvm = 4; - // first_dvm_exec = last_spec->lexNext(); //first DVM function call - nio = 0; -//generating call (module procedure) and/or assign statements for USE statements - GenForUseStmts(func,where); - - if(debug_regim && grname) { - if(!IN_MODULE) - InitGroups(); - CreateRedGroupVars(); - } - if(debug_regim && registration) { - LINE_NUMBER_BEFORE(cur_func,where); //(first_exec,first_exec); - ArrayRegistration(); // before array registration number of cur_func line - // must be put to debugger - } - if(lab_exec) - first_exec-> setLabel(*lab_exec); //restore label of first executable statement - - last_dvm_entry = first_exec->lexPrev(); - - if(copy_proc) - InsertCopyOfExecPartOfProcedure(copy_proc); - - EXEC_PART_: - - if(IN_MODULE) { - if(!mod_proc && first_exec->variant() == CONTAINS_STMT) - end_of_unit = has_contains = first_exec; - goto END_; - } - -//follow the executable statements in lexical order until last statement -// of the function - for(stmt=first_exec; stmt ; stmt=stmt->lexNext()) { - cur_st = stmt; - if(isACCdirective(stmt)) - { pstmt = addToStmtList(pstmt, stmt); - continue; - } - switch(stmt->variant()) { - case CONTROL_END: - if(stmt == last) { - if(func->variant() == PROG_HEDR) // for MAIN program - RTLExit(stmt); - goto END_; - } - break; - case CONTAINS_STMT: - if(func->variant() == PROG_HEDR) // for MAIN program - RTLExit(stmt); - has_contains = end_of_unit = stmt; - goto END_; - break; - case RETURN_STAT: - if(dvm_debug || perf_analysis ) - goto_list = addToStmtList(goto_list, stmt); - - if(stmt->lexNext() == last) - goto END_; - break; - case STOP_STAT: - if(stmt->expr(0)){ - SgStatement *print_st; - InsertNewStatementBefore(print_st=PrintStat(stmt->expr(0)),stmt); - ReplaceByIfStmt(print_st); - } - RTLExit(stmt); - if(stmt->lexNext() == last) - goto END_; - break; - /* - case PAUSE_NODE: - err("PAUSE statement is not permitted in FDVM", 93,stmt); - break; - case ENTRY_STAT: - if(debug) - err("ENTRY statement is not permitted in FDVM", stmt); - break; - */ - case EXIT_STMT: - //if(dvm_debug || perf_analysis ) - // EXIT statement is added to list for debugging (exit the loop) - // goto_list = addToStmtList(goto_list, stmt); - break; - - case ENTRY_STAT: - GoRoundEntry(stmt); - //BeginBlockForEntry(stmt); - entry_list=addToStmtList(entry_list,stmt); - break; - - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case WHILE_NODE: // DO WHILE (...) - /*case ELSEIF_NODE: // ELSE IF...*/ - if(dvm_debug) - DebugExpression(stmt->expr(0),stmt); - if((dvm_debug || perf_analysis) && stmt->variant()==ARITHIF_NODE ) - goto_list = addToStmtList(goto_list, stmt); - break; - - case LOGIF_NODE: // Logical IF - if( !stmt->lineNumber()) {//inserted statement - stmt = stmt->lexNext(); - break; - } - if(dvm_debug){ - if(HPF_program && inparloop) - IsLIFReductionOp(stmt, indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator - ReplaceContext(stmt); - DebugExpression(stmt->expr(0),stmt); - } - else if(perf_analysis && IsGoToStatement(stmt->lexNext())) - ReplaceContext(stmt); - - continue; // to next statement - case FORALL_STAT: // FORALL statement - stmt=stmt->lexNext();// statement that is a part of FORALL statement - break; - - case GOTO_NODE: // GO TO - if((dvm_debug || perf_analysis) && stmt->lineNumber() ) - goto_list = addToStmtList(goto_list, stmt); - break; - case COMGOTO_NODE: // Computed GO TO - if(dvm_debug){ - ReplaceContext(stmt); - DebugExpression(stmt->expr(1),stmt); - } else if(perf_analysis) - ReplaceContext(stmt); - if( dvm_debug || perf_analysis ) - goto_list = addToStmtList(goto_list, stmt); - break; - - case ASSIGN_STAT: // Assign statement - {SgSymbol *s; - if(!stmt->lineNumber()) //inserted debug statement - break; - s=stmt->expr(0)->symbol(); - if(s && IS_POINTER(s)){ // left part variable is POINTER - if(isSgFunctionCallExp(stmt->expr(1)) && !strcmp(stmt->expr(1)->symbol()->identifier(),"allocate")){ - if(inparloop) - err("Illegal statement in the range of parallel loop",94,stmt); - if(debug_regim) - //alloc_st = addToStmtList(alloc_st, stmt); - AllocArrayRegistration(stmt); - - } else if( (isSgVarRefExp(stmt->expr(1)) || isSgArrayRefExp(stmt->expr(1))) && stmt->expr(1)->symbol() && IS_POINTER(stmt->expr(1)->symbol())) { - ; - } else - err("Only a value of ALLOCATE function or other POINTER may be assigned to a POINTER",95,stmt); - - break; - } - - if(s && !inparloop && IS_DVM_ARRAY(s) && DistrArrayAssign(stmt)) - break; - if(s && !inparloop && AssignDistrArray(stmt)) - break; - - if(dvm_debug){ - SgStatement *stcur, *after_st = NULL, *stmt1; - if(HPF_program && inparloop) - IsReductionOp(stmt,indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator - ReplaceContext(stmt); - DebugAssignStatement(stmt); - - if(own_exe) //"owner executes" rule - InsertNewStatementAfter(D_Skpbl(),cur_st,cur_st->controlParent()); - else if(!inparloop && !in_on && stmt->expr(0)->symbol() && IS_DVM_ARRAY(stmt->expr(0)->symbol())) - InsertNewStatementAfter(D_Skpbl(),cur_st,cur_st->controlParent()); - own_exe = 0; - stmt = cur_st; - } - } - - break; - - case PROC_STAT: // CALL - if(!stmt->lineNumber()) //inserted debug statement - break; - if(dvm_debug){ - ReplaceContext(stmt); - DebugExpression(NULL,stmt); - } - break; - - case ALLOCATE_STMT: - if(debug_regim) { - AllocatableArrayRegistration(stmt); - stmt=cur_st; - } - break; - - case DEALLOCATE_STMT: - break; - case FOR_NODE: - if (perf_analysis == 4) - SeqLoopBegin(stmt); - if(dvm_debug) - DebugLoop(stmt); - break; - - case DVM_PARALLEL_ON_DIR: - if(!TestParallelWithoutOn(stmt,0)) - { - pstmt = addToStmtList(pstmt, stmt); - break; - } - - if(debug_regim && !dvm_debug) - Reduction_Debug(stmt); - par_do = stmt->lexNext(); // first DO statement of parallel loop - while( isOmpDir (par_do)) //|| isACCdirective(par_do) - { cur_st = par_do; - par_do=par_do->lexNext(); - } - - if(!isSgForStmt(par_do) && (dvm_debug || perf_analysis && perf_analysis != 2)) { - //directive is ignored - err("PARALLEL directive must be followed by DO statement",97,stmt); - break; - } - - if(dvm_debug){ //debugging mode - if(inparloop){ - err("Nested PARALLEL directives are not permitted", 96,stmt); - break; - } - - inparloop = 1; - if(!ParallelLoop_Debug(stmt)) // error in PARALLEL directive - inparloop = 0; - - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - // setting stmt on last DO statement of parallel loop nest - } - - else if(perf_analysis && perf_analysis != 2) { - inparloop = 1; - - //generating call to 'bploop' function of performance analizer - // (begin of parallel interval) - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st,stmt->controlParent()); - - if(perf_analysis == 4) - SkipParLoopNest(stmt); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } - else // dvm_debug == 0 && perf_analysis == 0 or 2, i.e. standard mode - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; - - case HPF_INDEPENDENT_DIR: - if(dvm_debug){ //debugging mode - if(inparloop){ - //illegal nested INDEPENDENT directive is ignored - pstmt = addToStmtList(pstmt, stmt); //including the HPF directive to list - break; - } - par_do = stmt->lexNext();// first DO statement of parallel loop - indep_st = stmt; - if(!isSgForStmt(par_do)) { - err("INDEPENDENT directive must be followed by DO statement",97,stmt); - //directive is ignored - break; - } - inparloop = 1; - IEXLoopAnalyse(func); - if(!IndependentLoop_Debug(stmt)) // error in INDEPENDENT directive - inparloop = 0; - } - - else if(perf_analysis && perf_analysis != 2) { - inparloop = 1; - par_do = stmt->lexNext();// first DO statement of parallel loop - indep_st = stmt; - //generating call to 'bploop' function of performance analizer - // (begin of parallel interval) - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st,stmt->controlParent()); - SkipIndepLoopNest(stmt); - } - else {// dvm_debug == 0 && perf_analysis == 0 or 2, i.e. standard mode - par_do = stmt->lexNext();// first DO statement of parallel loop - SkipIndepLoopNest(stmt); // to extract nested INDEPENDENT directives - } - //including the HPF directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; // setting stmt on last DO statement of parallel loop nest - break; - - case DVM_REDUCTION_WAIT_DIR: - if(debug_regim) { - - SgExpression *rg = new SgVarRefExp(stmt->symbol()); - LINE_NUMBER_AFTER(stmt,stmt); - doCallAfter(DeleteObject_H(rg)); - doAssignTo_After(rg, new SgValueExp(0)); - //Extract_Stmt(stmt); // extracting DVM-directive - doCallAfter( D_DelRG(DebReductionGroup( rg->symbol()))); - } - wait_list = addToStmtList(wait_list, stmt); - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st;//setting stmt on last inserted statement - break; - case DVM_ASYNCHRONOUS_DIR: - dvm_debug=0; - pstmt = addToStmtList(pstmt, stmt); - break; - case DVM_ENDASYNCHRONOUS_DIR: - dvm_debug=(cur_fragment && cur_fragment->dlevel)? 1 : 0; - pstmt = addToStmtList(pstmt, stmt); - break; - case DVM_REDUCTION_START_DIR: - case DVM_SHADOW_GROUP_DIR: - case DVM_SHADOW_START_DIR: - case DVM_SHADOW_WAIT_DIR: - case DVM_REMOTE_ACCESS_DIR: - case DVM_NEW_VALUE_DIR: - case DVM_REALIGN_DIR: - case DVM_REDISTRIBUTE_DIR: - case DVM_ASYNCWAIT_DIR: - case DVM_F90_DIR: - case DVM_CONSISTENT_START_DIR: - case DVM_CONSISTENT_WAIT_DIR: - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; - -//Debugging Directive - case DVM_INTERVAL_DIR: - if (perf_analysis > 1){ - //generating call to 'binter' function of performance analizer - // (begin of user interval) - - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter(St_Binter(OpenInterval(stmt),Value_F95(stmt->expr(0))), cur_st,cur_st->controlParent()); - } - pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list - stmt = cur_st; - break; - - case DVM_ENDINTERVAL_DIR: - if (perf_analysis > 1){ - //generating call to 'einter' function of performance analizer - // (end of user interval) - - if(!St_frag){ - err("Unmatched directive",182,stmt); - break; - } - if(St_frag && St_frag->begin_st && (St_frag->begin_st->controlParent() != stmt->controlParent())) - err("Misplaced directive",103,stmt); //interval must be a block - LINE_NUMBER_AFTER(stmt,stmt); - InsertNewStatementAfter(St_Einter(INTERVAL_NUMBER,INTERVAL_LINE), cur_st, stmt->controlParent()); - CloseInterval(); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } - else - pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list - break; - - case DVM_EXIT_INTERVAL_DIR: - if (perf_analysis > 1){ - //generating calls to 'einter' function of performance analizer - // (exit from user intervals) - - if(!St_frag){ - err("Misplaced directive",103,stmt); - break; - } - ExitInterval(stmt); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } - else - pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list - break; - - case DVM_OWN_DIR: - if(dvm_debug && stmt->lexNext()->variant() == ASSIGN_STAT) - own_exe = 1; - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; - case DVM_DEBUG_DIR: - { int num; - if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) - err("Illegal fragment number",181,stmt); - else if(debug_fragment || perf_fragment) - BeginDebugFragment(num,stmt); - - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - } - break; - - case DVM_ENDDEBUG_DIR: - { int num; - if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) - err("Illegal fragment number",181,stmt); - else if((cur_fragment && cur_fragment->No != num) || !cur_fragment && (debug_fragment || perf_fragment)) - err("Unmatched directive",182,stmt); - else { - if(cur_fragment && cur_fragment->begin_st && (stmt->controlParent() != cur_fragment->begin_st->controlParent())) - //test of nesting blocks - err("Misplaced directive",103,stmt); - EndDebugFragment(num); - } - - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - } - break; - - case DVM_TRACEON_DIR: - InsertNewStatementAfter(new SgCallStmt(*fdvm[TRON]),stmt,stmt->controlParent()); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_TRACEOFF_DIR: - InsertNewStatementAfter(new SgCallStmt(*fdvm[TROFF]),stmt,stmt->controlParent()); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_BARRIER_DIR: - doAssignStmtAfter(Barrier()); - FREE_DVM(1); - LINE_NUMBER_AFTER(stmt,stmt); - Extract_Stmt(stmt);// extracting DVM-directive - stmt = cur_st; - break; - - case DVM_CHECK_DIR: - if(check_regim) { - cur_st = Check(stmt); - Extract_Stmt(stmt); // extracting DVM-directive - stmt = cur_st; - } else - pstmt = addToStmtList(pstmt, stmt); - break; - - case DVM_TASK_REGION_DIR: - task_region_st = stmt; - in_task_region++; - if(dvm_debug){ - //task_region_st = stmt; - //task_region_parent = stmt->controlParent(); //to test nesting blocks - //task_lab = (SgLabel *) NULL; - task_ind = ndvm++; - DebugTaskRegion(stmt); - } - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - break; - - case DVM_END_TASK_REGION_DIR: - if(dvm_debug) - CloseTaskRegion(task_region_st,stmt); - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - in_task_region--; - break; - case DVM_ON_DIR: - if(dvm_debug) { - if( stmt->expr(0)->symbol() && IS_DVM_ARRAY(stmt->expr(0)->symbol())) - in_on++; - else if(in_task_region) { - LINE_NUMBER_AFTER(stmt,stmt); - doAssignTo_After(DVM000(task_ind),ReplaceFuncCall(stmt->expr(0)->lhs()->lhs())); - InsertNewStatementAfter(D_Iter_ON(task_ind,TypeDVM()),cur_st,stmt->controlParent()); - } - } - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - stmt = cur_st; - break; - case DVM_END_ON_DIR: - pstmt = addToStmtList(pstmt, stmt); - if(dvm_debug && in_on) { - SgStatement *std = dbg_if_regim ? CreateIfThenConstr(DebugIfCondition(),D_Skpbl()) : D_Skpbl(); - InsertNewStatementAfter(std,stmt,stmt->controlParent()); - stmt =lastStmtOf(std); - in_on--; - } - break; - - /* case DVM_INDIRECT_ACCESS_DIR: */ - case DVM_MAP_DIR: - case DVM_RESET_DIR: - case DVM_PREFETCH_DIR: - case DVM_PARALLEL_TASK_DIR: - case DVM_LOCALIZE_DIR: - case DVM_SHADOW_ADD_DIR: - case DVM_IO_MODE_DIR: - case DVM_TEMPLATE_CREATE_DIR: - case DVM_TEMPLATE_DELETE_DIR: - //including the DVM directive to list - pstmt = addToStmtList(pstmt, stmt); - break; -//Input/Output statements - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - if(perf_analysis) - stmt = Any_IO_Statement(stmt); - break; - case DVM_CP_CREATE_DIR: /*Chek Point*/ - CP_Create_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case DVM_CP_SAVE_DIR: - CP_Save_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case DVM_CP_LOAD_DIR: - CP_Load_Statement(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; - case DVM_CP_WAIT_DIR: - CP_Wait(stmt, WITH_ERR_MSG); - stmt = cur_st; - break; /*Chek Point*/ - - default: - break; - } - - { SgStatement *end_stmt; - end_stmt = isSgLogIfStmt(stmt->controlParent()) ? stmt->controlParent() : stmt; - - if(inparloop && isParallelLoopEndStmt(end_stmt,par_do)) { // is last statement of parallel loop - SgStatement *go_stmt = NULL; - inparloop = 0; // closing parallel loop nest - //replacing the label of DO statements locating above parallel loop in nest, - // which is ended by stmt, - // by new label and inserting CONTINUE with this label - ReplaceDoNestLabel_Above(end_stmt, par_do, GetLabel()); - if(debug_regim && HPF_program) - INDReductionDebug(); - if(dvm_debug) { - CloseDoInParLoop(end_stmt); //on debug regim end_stmt==stmt - end_stmt = cur_st; - if(dbg_if_regim) { - // generating GO TO statement: GO TO begin_lab - // and inserting it after last statement of parallel loop nest - go_stmt = new SgGotoStmt(*begin_lab); - cur_st->insertStmtAfter(*go_stmt,*par_do->controlParent()); - cur_st = go_stmt; // GO TO statement - } - // generating call statement : call dendl(...) - CloseParLoop(end_stmt->controlParent(),cur_st,end_stmt); - if(dbg_if_regim) - //setting label of ending parallel loop nest - (go_stmt->lexNext())->setLabel(*end_lab); - if(irg) { - // generating statement: - // call dvmh_delete_object(RedGroupRef) // dvm000(i) = delobj(RedGroupRef) - doCallAfter(DeleteObject_H(redgref)); - if(idebrg) - doCallAfter( D_DelRG(DVM000(idebrg))); - } - } else if(perf_analysis == 4) - SeqLoopEndInParLoop(end_stmt,stmt); - - if(perf_analysis && perf_analysis != 2) { - // generating call eloop(...) - end of parallel interval - //(performance analyzer function) - InsertNewStatementAfter(St_Enloop(INTERVAL_NUMBER,INTERVAL_LINE),cur_st,cur_st->controlParent()); - CloseInterval(); - if(perf_analysis != 4) - OverLoopAnalyse(func); - } - - stmt = cur_st; - if(dvm_debug) - {SET_DVM(iplp);} - continue; - } - - if(isDoEndStmt_f90(end_stmt)) { - if(dvm_debug) - CloseLoop(stmt); // on debug regim stmt=end_stmt - else if (perf_analysis && close_loop_interval) - SeqLoopEnd(end_stmt,stmt); - stmt = cur_st; - } - } - } - -END_: - - // for declaring dvm000(N) is used maximal value of ndvm - SET_DVM(ndvm); - cur_st = first_dvm_exec; - if(last_dvm_entry) - lentry = last_dvm_entry->lexNext(); - if(!IN_MODULE) { - InitRemoteGroups(); - //InitFileNameVariables(); - if(debug_regim) { - InitRedGroupVariables(); - WaitDirList(); - } - DoStmtsForENTRY(first_dvm_exec,lentry); - fmask[FNAME] = 0; - stmt = data_stf ? data_stf->lexPrev() : first_dvm_exec->lexPrev(); - DeclareVarDVM(stmt,stmt); - CheckInrinsicNames(); - } else { - if(mod_proc) - MayBeDeleteModuleProc(mod_proc,end_of_unit); - fmask[FNAME] = 0; - nloopred = nloopcons = MAX_RED_VAR_SIZE; - stmt= mod_proc ? has_contains->lexPrev() : first_dvm_exec->lexPrev(); - DeclareVarDVM(stmt, (mod_proc ? mod_proc : stmt)); - } - first_dvm_exec->extractStmt(); //extract fname() call - for(;pstmt; pstmt= pstmt->next) - Extract_Stmt(pstmt->st);// extracting DVM+ACC Directives - if(debug_regim) - if(cur_func->expr(2) && cur_func->expr(2)->variant()==PURE_OP) - cur_func->setExpression(2, NULL); // removing PURE attribute from procedure header - return; -} - -void VarDVM(SgStatement * func ) - { SgArrayType *typearray; - typearray =new SgArrayType(*SgTypeInt()); //typearray-> addRange(N); - dvmbuf = new SgVariableSymb("dvm000", *typearray, *func); - } - -void RegistrateArg(SgExpression *ele) -{ - SgExpression *el, *e; - e = ele->lhs(); //argument - if(!e) - return; - - if(isSgArrayRefExp(e)) { - if(!(e->lhs())) // argument is whole array (array name) - return; - el=e->lhs()->lhs(); //first subscript of argument - //testing: is first subscript of ArrayRef a POINTER - if((isSgVarRefExp(el) || isSgArrayRefExp(el)) && IS_POINTER(el->symbol())){ - if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) - heap_point = HeapList(heap_point,e->symbol(),el->symbol()); - } - } - return; -} - -SgExpression *CalcLinearForm(SgSymbol *ar, SgExpression *el, SgExpression *erec) -{ - int i; - SgExpression *ei, *index_list=NULL, *head_ref; - for(i=0; el; el=el->rhs(),i++) - { - ei = &(el->lhs()->copy()); - ei = new SgExprListExp(*DvmType_Ref(ei)); - ei->setRhs(index_list); - index_list = ei; - } - - if(erec) { - head_ref = new SgExpression(RECORD_REF); - head_ref->setLhs(erec); - head_ref->setRhs( new SgArrayRefExp(*ar, *new SgValueExp(1))); - } - else - head_ref = HeaderRef(ar); - return (CalculateLinear(head_ref,i,index_list)); - -} - -void DistArrayRef(SgExpression *e, int modified, SgStatement *st) -{ SgSymbol *ar; - SgExpression *rme, *erec=NULL; - int *h; - int is_record_ref = 0; - //replace distributed array reference A(I1,I2,...,In) by - // n - // ( Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik)) - // k=2 - // is I0000M if A is of type integer - // R0000M if A is of type real - // D0000M if A is of type double precision - // C0000M if A is of type complex - // L0000M if A is of type logical - - // modified == 1 for variable in left part of assign statement - - hpf_ind = 0; - if (isSgRecordRefExp(e)) { - erec = e->lhs(); - e->setType(e->rhs()->type()); - NODE_CODE(e->thellnd) = ARRAY_REF; - ar = e->rhs()->symbol(); - e->setLhs(e->rhs()->lhs()); - e->setSymbol(ar); - is_record_ref = 1; - } - else - ar = e -> symbol(); - if(IS_POINTER(ar)){ - Error("Illegal POINTER reference: '%s'",ar->identifier(),138,st); - return; - } - h = HEADER(ar); - if(h && isSgArrayType(e->type())) - { Error("Illegal distributed array reference: %s",ar->identifier(),335,st); - return; - } - - if(h || is_record_ref) { //distributed array reference - if(!is_record_ref && *h > 1) - Error("Illegal template reference: '%s'",ar->identifier(),167,st); - if(HPF_program && inparloop && modified && !IND_target) - IND_target = IND_ModifiedDistArrayRef(e,st); - if(HPF_program && inparloop && !modified ) { - if(!IND_target_R) - IND_target_R = IND_ModifiedDistArrayRef(e,st); - IND_UsedDistArrayRef(e,st); - return; - } - if(!modified && !is_record_ref && (rma || HPF_program) && (rme=isRemAccessRef(e))) - // is remote variable reference - ChangeRemAccRef(e,rme); - - else { - /* if(!inparloop && !own_exe) - Error("Distributed array element reference outside the range of parallel loop: '%s'",ar->identifier(),cur_st); */ - - if(isPrivateInRegion(ar)) //private array in loop of region - return; // array reference is not changed !!! - if(for_host) //if(IN_COMPUTE_REGION && inparloop && !for_kernel && options.isOn(O_HOST) ) - return; // array reference is not changed !!! - if(for_kernel) /*ACC*/ - ; - else if(opt_base && inparloop && !HPF_program) - e->setSymbol( *ARRAY_BASE_SYMBOL(ar)); - else - e->setSymbol(baseMemory(ar->type()->baseType())); - if(!e->lhs()) - Error("No subscripts: %s", ar->identifier(),171,st); - else { - (e->lhs())->setLhs( (INTERFACE_RTS2 && !inparloop) ? *CalcLinearForm(ar,e->lhs(),erec) : *LinearForm(ar,e->lhs(),erec)); - (e->lhs())->setRhs(NULL); - } - } - /*ACC*/ - } else { // replicated array in region - if(for_host) - return; // array reference is not changed !!! - if(!for_kernel) /*ACC*/ - e->setSymbol(baseMemory(ar->type()->baseType())); - if(!e->lhs()) - Error("No subscripts: %s", ar->identifier(),171,st); - else - { if(DUMMY_FOR_ARRAY(ar) && *DUMMY_FOR_ARRAY(ar)!=NULL) // for case of syntax error in PARALLEL directive - { (e->lhs())->setLhs(*LinearForm(*DUMMY_FOR_ARRAY(ar),e->lhs(),NULL)); - (e->lhs())->setRhs(NULL); - } - } - - } - -} - - -void GoRoundEntry(SgStatement *stmt) -{SgLabel *lab; -if((stmt->lexPrev()->variant() == RETURN_STAT) || (stmt->lexPrev()->variant() == STOP_STAT) ||(stmt->lexPrev()->variant() == GOTO_NODE)) // going round is - return; - -if(!(lab=stmt->lexNext()->label())) {//next statement has not label - lab = GetLabel(); - (stmt->lexNext())->setLabel(*lab); -} -stmt->insertStmtBefore(* new SgGotoStmt(*lab)); -return; -} -void BeginBlockForEntry(SgStatement *stmt) -{if(stmt) - return; - return; -} -int TestLeftPart(symb_list *new_red_var_list, SgExpression *le) -{symb_list *ls; - if(!le) - return(0); - if(isDistObject(le)) - return(1); - if(le->variant() == ARRAY_OP) - return(TestLeftPart(new_red_var_list,le->lhs())); - if(le->symbol()){ - for(ls= new_red_var_list; ls; ls=ls->next) - if( le->symbol() == ls->symb) - return(1); - return(0); - } - else - return(0); -} -int isInSymbList(symb_list *ls,SgSymbol *s) -{symb_list *l; - for(l=ls; l; l=l->next) - if(s == l->symb) - return(1); - return(0); -} - -void TestReverse(SgExpression *e,SgStatement *st) -{ - if(e && e->isInteger() && (e->valueInteger() < 0)) - err("Reverse is not supported",163,st); - return; -} - -void LineNumber(SgStatement *st) -{st->insertStmtAfter(*D_Lnumb(st->lineNumber()),*st->controlParent());} - - -int PointerRank(SgSymbol *p) -{int rank ; - SgExpression *el; - rank = 0; - for(el= (*POINTER_DIR(p))->expr(1); el; el=el->rhs()) - rank++; - return (rank); -} - -SgType * PointerType(SgSymbol *p) -{return( (*POINTER_DIR(p))->expr(2)->type());} - -void AssignPointer(SgStatement *ass) -{int r; - SgSymbol *pl, *pr; - //SgExpression *head_new, *head; - //ifst=ndvm; - pl = ass->expr(0)->symbol(); - pr = ass->expr(1)->symbol(); - /* if(IS_DVM_ARRAY(pl)) - Error("POINTER '%s' in left part of assign statement has DISTRIBUTE or ALIGN attribute",pl->identifier(), 172,ass);*//*28.12.99*/ - /* if(!IS_DVM_ARRAY(pr)) - Error("POINTER '%s' in right part of assign statement has not DISTRIBUTE or ALIGN attribute",pr->identifier(), ass);*/ - r = PointerRank(pl); - if(PointerRank(pr) != r) - err("Pointers are of different rank", 173,ass); - if(PointerType(pr) != PointerType(pl)) - err("Pointers are of different type", 174,ass); - TestArrayRef(ass->expr(0),ass); - TestArrayRef(ass->expr(1),ass); - - /*LINE_NUMBER_AFTER(ass,ass);*/ - /* - head_new = (ass->expr(0)->lhs()) ? AddFirstSubscript(ass->expr(0),new SgValueExp(1)) : HeaderRefInd(pl,1); - head = (ass->expr(1)->lhs()) ? AddFirstSubscript(ass->expr(1),new SgValueExp(1)) : HeaderRefInd(pr,1); - doAssignStmtAfter(AddHeader(head_new,head)); - */ - /* - doAssignStmtAfter(AddHeader(PointerHeaderRef(ass->expr(0),1),PointerHeaderRef(ass->expr(1),1))); - CopyHeader(ass->expr(0),ass->expr(1),r); - SET_DVM(ifst); - */ - return; -} - -void AddFirstSubscript(SgExpression *ea, SgExpression *ei) -{SgExpression *el,*efirst; - if(!ei || !ea) - return; - el = ea->lhs(); - efirst = new SgExprListExp(*ei); - efirst -> setRhs(el); - ea -> setLhs(efirst); -} -/* -SgExpression * PointerHeaderRef(SgExpression *pe, int ind) - // P => P(ind) - // P(i,j,...) => P(ind,i,j,...) -{SgSymbol *p; - if(!(p=pe->symbol())) - return (pe); - if(p->attributes() & DIMENSION_BIT){ // POINTER p declared as array - SgExpression *ef,*cpe; - if(!pe->lhs()) - return (pe); - cpe = & (pe->copy()); - ef = new SgExprListExp(* new SgValueExp(ind)); - ef->setRhs(cpe->lhs()); - cpe->setLhs(ef); - return(cpe); - } - else - return(HeaderRefInd(p,ind)); -} -*/ - -SgExpression * PointerHeaderRef(SgExpression *pe, int ind) - // P => HEAP(P+ind-1) - // P(i,j,...) => HEAP(P(i,j,...)+ind-1) -{ SgExpression *ef,*cpe; - if(!(pe->symbol())) - return (pe); - if(!heap_ar_decl) - return(pe); //error: HEAP isn't declared - cpe = new SgArrayRefExp(*heap_ar_decl->symbol()); - ef = (ind == 1) ? new SgExprListExp(pe->copy()) : new SgExprListExp(pe->copy()+(*new SgValueExp(ind-1))); - cpe->setLhs(ef); - return(cpe); -} - - -void CopyHeader(SgExpression *ple, SgExpression *pre, int rank) -{ //int i; - // for(i=0; isymbol())) - return (0); - if((s->attributes() & DIMENSION_BIT) && !e->lhs()) { // s declared as array - Error("No subscripts: %s", s->identifier(),171,stmt); - return(0); - } - return(1); -} - -void AddDistSymbList(SgSymbol *s) -{ symb_list *ds; - if(!dsym) { - dsym = new symb_list; - dsym->symb = s; - dsym->next = NULL; - } else { - ds = new symb_list; - ds->symb = s; - ds->next = dsym; - dsym = ds; - } -} - -void StoreLowerBoundsPlus(SgSymbol *ar,SgExpression *arref) -// generating assign statements to -//store lower bounds of array in Header(rank+3:2*rank+2) -//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 -//and to set the flag to 0: array is not distributed yet -{int i,rank; - SgExpression *le; - rank = Rank(ar); - if(!IS_TEMPLATE(ar) && !IS_POINTER(ar)) - doAssignTo(header_section(ar,2,rank+1), new SgValueExp(1)); // coefficient's initialization - - for(i=0;iattributes() & POSTPONE_BIT) - doAssignTo(!arref ? header_ref(ar,HEADER_SIZE(ar)) : PointerHeaderRef(arref,HEADER_SIZE(ar)), new SgValueExp(0)); - // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet - } -} - -void StoreLowerBoundsPlusFromAllocate(SgSymbol *ar,SgExpression *arref,SgExpression *lbound) -// generating assign statements to -//store lower bounds of array in Header(rank+3:2*rank+2) -//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 -//and to set the flag to 0: array is not distributed yet -{int i,rank; - SgExpression *le; - rank = Rank(ar); - for(i=0;icopy()); - if(lbound->lhs()) - le->lhs()->setLhs(Calculate(&(lbound->lhs()->lhs()->copy()+ *new SgValueExp(i)))); - else - le->setLhs(new SgExprListExp(*new SgValueExp(i+1))); - - doAssignTo(!arref ? header_ref(ar,rank+3+i) : PointerHeaderRef(arref,rank+3+i), le) ; - } - if(!IS_TEMPLATE(ar)) { - doAssignTo(!arref ? header_ref(ar,HSIZE(rank)+1) : PointerHeaderRef(arref,HSIZE(rank)+1), new SgValueExp(HSIZE(rank)+2)); - // initializing HEADER(2*rank+3) - counter of remote access buffers - if(ar->attributes() & POSTPONE_BIT) - doAssignTo(!arref ? header_ref(ar,HEADER_SIZE(ar)) : PointerHeaderRef(arref,HEADER_SIZE(ar)), new SgValueExp(0)); - // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet - } -} - - -void StoreLowerBoundsPlusOfAllocatable(SgSymbol *ar,SgExpression *desc) -// generating assign statements to -//store lower bounds of ALLOCATABLE array in Header(rank+3:2*rank+2) -//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 -//and to set the flag to 0: array is not distributed yet -{int i,rank; - SgExpression *le,*el; - rank = Rank(ar); - doAssignTo(header_section(ar,2,rank+1), new SgValueExp(1)); // coefficient's initialization - for(i=0,el=desc->lhs();el;i++,el=el->rhs()) { - le = (el->lhs()->variant() == DDOT) ? &el->lhs()->lhs()->copy() : new SgValueExp(1) ; - doAssignTo(header_ref(ar,rank+3+i), le) ; - } - if(!IS_TEMPLATE(ar)) { - doAssignTo(header_ref(ar,HSIZE(rank)+1), new SgValueExp(HSIZE(rank)+2)); - // initializing HEADER(2*rank+3) - counter of remote access buffers - if(ar->attributes() & POSTPONE_BIT) - doAssignTo(header_ref(ar,HEADER_SIZE(ar)), new SgValueExp(0)); - // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet - } -} - - -void StoreLowerBoundsPlusOfAllocatableComponent(SgSymbol *ar,SgExpression *desc, SgExpression *struct_) -// generating assign statements to -//store lower bounds of ALLOCATABLE array in Header(rank+3:2*rank+2) -//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 -//and to set the flag to 0: array is not distributed yet -{int i,rank; - SgExpression *le,*el; - rank = Rank(ar); - doAssignTo(header_section_in_structure(ar,2,rank+1,struct_), new SgValueExp(1)); // coefficient's initialization - - for(i=0,el=desc->lhs();el;i++,el=el->rhs()) { - le = (el->lhs()->variant() == DDOT) ? &el->lhs()->lhs()->copy() : new SgValueExp(1) ; - doAssignTo(header_ref_in_structure(ar,rank+3+i,struct_), le) ; - } - doAssignTo(header_ref_in_structure(ar,HSIZE(rank)+1,struct_), new SgValueExp(HSIZE(rank)+2)); - // initializing HEADER(2*rank+3) - counter of remote access buffers - if(ar->attributes() & POSTPONE_BIT) - doAssignTo(header_ref_in_structure(ar,HEADER_SIZE(ar),struct_), new SgValueExp(0)); - // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet - -} - -void ReplaceLowerBound(SgSymbol *ar, int i) -//replace i-th lower bound of array 'ar' with Header(rank+3+i) reference in Symbol Table -// Li : Ui => Header(rank+3+i) : Ui -//i=0,...,rank-1 -{SgExpression *e; - SgArrayType *artype; - artype = isSgArrayType(ar->type()); - if(artype) { - e = artype->sizeInDim(i); - if(e->lhs() && e->rhs()) // Li : Ui - if(!(ReplaceParameter(&e->lhs()->copy())->isInteger())) - e->setLhs(header_ref(ar,Rank(ar)+3+i)); - } -} - -void ReplaceArrayBounds(SgSymbol *ar) -{int i,rank; - rank = Rank(ar); - if( IS_DUMMY(ar)) - for(i=0; i9){ - if(ic == 16) - return(&(*new SgVarRefExp(Iconst[8])+(*new SgVarRefExp(Iconst[8])))); - else if(ic-9 < 10) - return(&(*new SgVarRefExp(Iconst[ic-9])+(*new SgVarRefExp(Iconst[9])))); - else - return(&(*new SgVarRefExp(Iconst[9])+(*new SgValueExp(ic-9)))); - // err("Compiler bug. Integer constant > 9", 0,cur_st); - return(new SgValueExp(ic)); - } - return(new SgVarRefExp(Iconst[ic])); -} - -SgExpression *SignConstRef(int ic) -{SgExpression *res; - res = (ic < 0) ? &SgUMinusOp(*ConstRef(-ic)) : ConstRef(ic); - return(res); -} - -void TestParamType(SgStatement *stmt) -{SgType *t; - t = stmt->expr(2)->symbol()->type(); - if(isSgArrayType(t) && (t->baseType()->variant() == T_FLOAT && TypeSize(t->baseType())==8 || t->baseType()->variant() == T_DOUBLE) && Rank(stmt->expr(2)->symbol())==2) - return ; - Error("Illegal type of parameter array '%s'",stmt->expr(2)->symbol()->identifier(),615,stmt); -} - -SgExpression *CountOfTasks(SgStatement *st) -{SgExpression *e; - e = st->expr(0)->lhs()->lhs(); - if(e->variant()==DDOT && !e->lhs() && !e->rhs()) //whole task's array - return(ReplaceFuncCall(ArrayDimSize(st->expr(0)->symbol(),1))); - else //section of task's array - { err("Section/element of task array. Not implemented yet.",614,st); - return(new SgValueExp(0)); - } -} - -void ReconfPS( stmt_list *pstmt) -{ int rank; - SgSymbol *pr; - SgExpression *size_array, *le; - stmt_list *lst; - //looking through the DVM specification directive (pstmt) - for(lst=pstmt; lst; lst=lst->next) - if(lst->st->variant() == HPF_PROCESSORS_STAT) - for (le=lst->st->expr(0); le; le = le->rhs()) { //looking through the processor list - pr= le->lhs()->symbol(); - proc_symb = AddToSymbList(proc_symb, pr); - LINE_NUMBER_BEFORE(lst->st,where); - // for tracing set the global variable of LibDVM to - // line number of directive PROCESSORS - rank = Rank(pr); - if(!rank) { // is not array P => P(1) - size_array = dvm_array_ref(); - doAssignStmt(new SgValueExp(1)); - rank = 1; - } else - size_array = doSizeArrayD(pr,lst->st); - - // pr = reconf(PSRef, rank, SizeArray, StaticSign) - // reconf() creates processor system - doAssignTo(new SgVarRefExp(pr),Reconf(size_array, rank, 0)); - } -} - -SgExpression *CurrentPS () -{SgExpression *ps; - if(in_task_region) - ps = new SgArrayRefExp(*task_array, *new SgValueExp(1),*DVM000(task_ind)); - /* else if(fmask[GETAM] == 0) // not GETVM but GETAM !! - ps = GetProcSys(ConstRef(0)); //ConstRef(0); constant = 0 - else - ps = DVM000(3); - */ - else - ps = ConstRef(0); - return(ps); - -} - -SgExpression *CurrentAM () -{SgExpression *am; - am = ConstRef(0); //DVM000(2); //ConstRef(0); //GetAM(); - return(am); -} - -SgExpression *ParentPS () -{ return( GetProcSys(&SgUMinusOp(*ConstRef(1))));} - -SgExpression *PSReference(SgStatement *st) -{SgExpression *target,*es,*le[MAX_DIMS],*re[MAX_DIMS]; - SgValueExp c1(1); - int ile,ips,rank,j,i; - - target = (st->variant() == DVM_MAP_DIR) ? st->expr(1) : st->expr(2); - if(!target) - return( CurrentPS()); - /* - if(st->variant() == DVM_REDISTRIBUTE_DIR){ - target = target->lhs(); - if(target->variant() == NEW_VALUE_OP) - return( CurrentPS()); - } - */ - if(target->symbol()->attributes() & PROCESSORS_BIT){ - if(!target->lhs()) - return(target); - // return( new SgVarRefExp(target->symbol())); - - for(es=target->lhs(),j=0; es; es=es->rhs(),j++){ //looking through the subscript list - if(j==MAX_DIMS) { - Error("Too many dimensions specified for %s", target->symbol()->identifier(),43,st); - break; - } - if(es->lhs()->variant() == DDOT) { - //determination of dimension bounds - if(!es->lhs()->lhs() && !es->lhs()->rhs()){ - le[j] = new SgValueExp(0); - re[j] = &(*Exprn(UpperBound(target->symbol(),j)) - *Exprn(LowerBound(target->symbol(),j))); - } else if(!es->lhs()->lhs() && es->lhs()->rhs()) { - le[j] = new SgValueExp(0); - re[j] = &(*es->lhs()->rhs() - *Exprn(LowerBound(target->symbol(),j))); - } else if(es->lhs()->lhs() && !es->lhs()->rhs()) { - le[j] = &(*es->lhs()->lhs() - *Exprn(LowerBound(target->symbol(),j))); - re[j] = &(*Exprn(UpperBound(target->symbol(),j)) - *Exprn(LowerBound(target->symbol(),j))); - } else if(es->lhs()->lhs() && es->lhs()->rhs()) { - le[j] = &(*es->lhs()->lhs() - *Exprn(LowerBound(target->symbol(),j))); - re[j] = &(*es->lhs()->rhs() - *Exprn(LowerBound(target->symbol(),j))); - } - } else { - le[j] = &(*es->lhs() - *Exprn(LowerBound(target->symbol(),j))); - re[j] = &le[j]->copy(); - } - } - rank = Rank(target->symbol()); - if(rank && rank != j) - Error("Wrong number of subscripts specified for %s", target->symbol()->identifier(),140,st); - - ile = ndvm; - for(i=0; isymbol()), ile, ile+j, 0)); - return (DVM000(ips)); - } - - if(target->symbol()->attributes() & TASK_BIT) - return(TaskPS(target,st)); - return( CurrentPS()); -} - -SgExpression *TaskPS(SgExpression *target,SgStatement *st) -{ - if(!target->lhs() || target->lhs()->rhs()) //there are no subscript or >1 - Error("Wrong number of subscripts specified for %s", target->symbol()->identifier(),140,st); - return( new SgArrayRefExp(*target->symbol(), *new SgValueExp(1),*target->lhs()->lhs())); -} - -SgExpression *hasNewValueClause(SgStatement *stdis) -{SgExpression *e; - e = stdis->expr(2); - if(!e) // NEW_VALUE clause is absent - return (e); - e = e->lhs(); - if(e->variant() == NEW_VALUE_OP) - return(e); - else if(e->rhs()) - return(e->rhs()->lhs()); - return(NULL); -} - -SgExpression *hasOntoClause(SgStatement *stdis) -{SgExpression *target; - SgSymbol *tsymb; - target = stdis->expr(2); - if(!target) //ONTO clause is absent - return (target); - if(isSgExprListExp(target)){ - target = target->lhs(); - if(target->variant() == NEW_VALUE_OP) - return(NULL); - } - tsymb = target->symbol(); - if(!(tsymb->attributes() & DIMENSION_BIT)) - Error("'%s' isn't array",tsymb->identifier(),66,stdis); - if(stdis->variant() == DVM_DISTRIBUTE_DIR){ - if(!(tsymb->attributes() & PROCESSORS_BIT)) - Error("'%s' hasn't PROCESSORS attribute",tsymb->identifier(),176,stdis); - } else // REDISTRIBUTE directive - if(!(tsymb->attributes() & PROCESSORS_BIT) && !(tsymb->attributes() & TASK_BIT)) - Error("'%s' hasn't PROCESSORS/TASK attribute",tsymb->identifier(),176,stdis); - return(target); -} - -int RankOfSection(SgExpression *are) -{int rank; -// SgExpression *el; -//int ndim; - if(!are) - return(0); - if(are->symbol()->attributes() & TASK_BIT) - return(0); - rank = Rank(are->symbol()); - if(!are->lhs()) - return(rank ? rank : 1 ); - - return (rank); - /*for(el=are->lhs(),ndim=0; el; el = el->rhs(), ndim++) - ; - return(ndim <= rank ? ndim : rank); - */ -} - -void CreateTaskArray(SgSymbol *ts) -{int isize,iamv; - SgExpression *le,*re, *e; - SgArrayType *artype; - SgSymbol **tsk_amv = new (SgSymbol *); - SgSymbol **tsk_ind = new (SgSymbol *); - SgSymbol **tsk_renum_array = new (SgSymbol *); - SgSymbol **tsk_lps = new (SgSymbol *); - SgSymbol **tsk_hps = new (SgSymbol *); - - isize = ndvm++; - SgStatement *dost,*as; - nio = (nio < 1 ) ? 1: nio; - artype = isSgArrayType(ts->type()); - doAssignTo(DVM000(isize),ReplaceFuncCall(&artype->sizeInDim(0)->copy())); - iamv = ndvm; - task_ps=iamv; - //doAssignStmt(CreateAMView(DVM000(isize), 1, 0)); - *tsk_amv = TaskAMVSymbol(ts); - doAssignTo(new SgVarRefExp(*tsk_amv),CreateAMView(DVM000(isize), 1, 0)); - //loop_lab = GetLabel(); - le = new SgArrayRefExp(*ts,*new SgValueExp(2),*new SgVarRefExp(loop_var[0])); - *tsk_renum_array = TaskRenumArraySymbol(ts); - e = &(*new SgArrayRefExp(**tsk_renum_array,*new SgVarRefExp(loop_var[0])) - *new SgValueExp(1)); - re = GetAMR(new SgVarRefExp(*tsk_amv),e); - as = new SgAssignStmt(*le,*re); - dost= new SgForStmt(loop_var[0], new SgValueExp(1), DVM000(isize), new SgValueExp(1), as); - //BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; - //as->setLabel(*loop_lab); - where->insertStmtBefore(*dost,*where->controlParent()); - //as->lexNext()->extractStmt(); - //le = DVM000(iamv+1); - //re = &(*new SgVarRefExp(loop_var[0]) - *new SgValueExp(1)); //dvm000(...)=i-1 - /* initializing renumeration array */ - le = new SgArrayRefExp(**tsk_renum_array,*new SgVarRefExp(loop_var[0])); - re = new SgVarRefExp(loop_var[0]); - as->insertStmtBefore(*new SgAssignStmt(*le,*re)); - //SET_DVM(isize); - // index = new int; - // *index = task_ps; - // adding the attribute (TASK_INDEX) to TASK symbol - // ts->addAttribute(TASK_INDEX, (void *) index, sizeof(int)); - // adding the attribute (TSK_SYMBOL) to TASK symbol - ts->addAttribute(TSK_SYMBOL, (void*) tsk_amv, sizeof(SgSymbol *)); - *tsk_ind = TaskIndSymbol(ts); - // adding the attribute (TSK_IND_VAR) to TASK symbol - ts->addAttribute(TSK_IND_VAR, (void*) tsk_ind, sizeof(SgSymbol *)); - - // adding the attribute (TSK_RENUM_ARRAY) to TASK symbol - ts->addAttribute(TSK_RENUM_ARRAY, (void*) tsk_renum_array, sizeof(SgSymbol *)); - *tsk_lps = TaskLPsArraySymbol(ts); - // adding the attribute (TSK_LPS_ARRAY) to TASK symbol - ts->addAttribute(TSK_LPS_ARRAY, (void*) tsk_lps, sizeof(SgSymbol *)); - *tsk_hps = TaskHPsArraySymbol(ts); - // adding the attribute (TSK_HPS_ARRAY) to TASK symbol - ts->addAttribute(TSK_HPS_ARRAY, (void*) tsk_hps, sizeof(SgSymbol *)); - return; -} - -int LoopVarType(SgSymbol *var,SgStatement *st) -{ int len; - SgType *type; - - type = var->type(); - if(!type) - return(0); - len = TypeSize(type); /*16.04.04 */ - /*len = IS_INTRINSIC_TYPE(type) ? 0 : TypeSize(type);*/ - //len = (TYPE_RANGES(type->thetype)) ? type->length()->valueInteger() : 0; 14.03.03 - if(bind_ == 0) - switch(type->variant()) { - case T_INT: return((len == 2) ? 2 : 0); // (long = int) - default: - { Error("Illegal type of do-variable '%s'",var->identifier(),178,st); - return(0); - } - } - if(bind_ == 1) - switch(type->variant()) { - case T_INT: if (len == 8) return(0); - else if(len == 2) return(2); - else return(1); - - default: { Error("Illegal type of do-variable '%s'",var->identifier(),178,st); - return(0); - } - } - return(0); -} - -int LocVarType(SgSymbol *var,SgStatement *st) -{ int len; - SgType *type; - if(!var) - return(0); - type = var->type(); - if(!type) - return(0); - if (isSgArrayType(type)) - type = type->baseType(); - len = TypeSize(type); /*16.04.04 */ - if(bind_ == 0) - switch(type->variant()) { - case T_INT: if(len == 4) return(0); // (long = int) - else if(len == 2) return(2); - else if(len == 1) return(3); - else - { err("Wrong operand of MAXLOC/MINLOC",149,st); - return(0); - } - - default: - { err("Wrong operand of MAXLOC/MINLOC",149,st); - return(0); - } - } - if(bind_ == 1) - switch(type->variant()) { - case T_INT: if (len == 8) return(0); - else if(len == 4) return(1); - else if(len == 2) return(2); - else if(len == 1) return(3); - else - { err("Wrong operand of MAXLOC/MINLOC",149,st); - return(0); - } - default: { err("Wrong operand of MAXLOC/MINLOC",149,st); - return(0); - } - } - return(0); -} - - -int TypeDVM() -{return(0);} - -void StartTask(SgStatement *stmt) -{SgStatement *if_stmt, *st; - SgExpression *ei; - ei = stmt->expr(0)->lhs()->lhs(); - doAssignTo_After(DVM000(task_ind),ReplaceFuncCall(ei)); - if(!isSgVarRefExp(ei) && !isSgValueExp(ei)) - ei = DVM000(task_ind); - st = (stmt->variant()==DVM_ON_DIR) ? new SgGotoStmt(*task_lab) : new SgStatement(CYCLE_STMT); - if_stmt = new SgLogIfStmt(SgEqOp(*RunAM(new SgArrayRefExp(*(stmt->expr(0)->symbol()), -*new SgValueExp(2),*ei)),*new SgValueExp(0) ),*st); - cur_st->insertStmtAfter(*if_stmt); - cur_st = if_stmt->lexNext(); // CYCLE statement or GOTO statement - (cur_st->lexNext())-> extractStmt(); //extract ENDIF - if(dvm_debug) - if( stmt->variant()==DVM_ON_DIR) - InsertNewStatementAfter(D_Iter_ON(task_ind,TypeDVM()),cur_st,stmt->controlParent()); - - return; -} - -void InitGroups() -{ group_name_list *sl; - for(sl=grname; sl; sl=sl->next) - if(!IS_SAVE(sl->symb)) - /* if (sl->symb->variant() == REF_GROUP_NAME){ - doAssignTo(new SgArrayRefExp(*sl->symb,*new SgValueExp(1)),new SgValueExp(0)); - doAssignTo(new SgArrayRefExp(*sl->symb,*new SgValueExp(2)),new SgValueExp(0)); - doAssignTo(new SgArrayRefExp(*sl->symb,*new SgValueExp(3)),new SgValueExp(0)); - } else */ - if (sl->symb->variant() == REDUCTION_GROUP_NAME || sl->symb->variant() == CONSISTENT_GROUP_NAME) - doAssignTo(new SgVarRefExp(*sl->symb),new SgValueExp(0)); - -} -void CreateRedGroupVars() -{ group_name_list *sl; - SgSymbol *rgs; - - for(sl=grname; sl; sl=sl->next) - //if(!IS_SAVE(sl->symb)) ??? - if (sl->symb->variant() == REDUCTION_GROUP_NAME || sl->symb->variant() == CONSISTENT_GROUP_NAME) { - SgSymbol **ss = new (SgSymbol *); - rgs = new SgVariableSymb(RedGroupVarName(sl->symb), *new SgArrayType(*SgTypeInt()), *cur_func); - *ss = rgs; - (sl->symb)->addAttribute( RED_GROUP_VAR, (void *) ss, sizeof(SgSymbol *)); - } -} - -void InitShadowGroups() -{ group_name_list *sl; - for(sl=grname; sl; sl=sl->next) - if(!IS_SAVE(sl->symb)) - if (sl->symb->variant() == SHADOW_GROUP_NAME) - doAssignTo_After(new SgVarRefExp(*sl->symb),new SgValueExp(0)); -} - - -void InitRemoteGroups() -{stmt_list *stl; -for(stl=pref_st; stl; stl=stl->next) { -doAssignTo_After(new SgArrayRefExp(*stl->st->symbol(),*new SgValueExp(1)),new SgValueExp(0)); -doAssignTo_After(new SgArrayRefExp(*stl->st->symbol(),*new SgValueExp(2)),new SgValueExp(0)); -doAssignTo_After(new SgArrayRefExp(*stl->st->symbol(),*new SgValueExp(3)),new SgValueExp(0)); -} -} - - -void InitRedGroupVariables() -{group_name_list *gl; - int i,nl; - SgSymbol *rgv; - for(gl=grname; gl; gl=gl->next) - if (gl->symb->variant() == REDUCTION_GROUP_NAME || gl->symb->variant() == CONSISTENT_GROUP_NAME) { - rgv = * ((SgSymbol **) (gl->symb)-> attributeValue(0,RED_GROUP_VAR)); - nl = gl->symb->variant() == REDUCTION_GROUP_NAME ? nloopred : nloopcons; - for(i=nl; i; i--) - doAssignTo_After(new SgArrayRefExp(*rgv,*new SgValueExp(i)),new SgValueExp(0)); - } -} - -void WaitDirList() -{stmt_list *stl; - SgStatement *stat; - SgSymbol *rgv, *rg; - int i,nl; - stat = cur_st; - for(stl=wait_list; stl; stl=stl->next) { - cur_st = stl->st; - rg = ORIGINAL_SYMBOL(stl->st->symbol()); - rgv = * ((SgSymbol **) rg -> attributeValue(0,RED_GROUP_VAR)); - nl =(cur_st ->variant() == DVM_CONSISTENT_WAIT_DIR) ? ((cur_st->controlParent()->variant() == PROG_HEDR) ? 0 : nloopcons) : nloopred; - for(i=nl; i; i--) - doAssignTo_After(new SgArrayRefExp(*rgv,*new SgValueExp(i)),new SgValueExp(0)); -} - cur_st = stat; -} - -void InitDebugVar() -{SgStatement *stcall; - int flag; -if(!dbg_var) return; -flag = (only_debug) ? 0 : 1; -doAssignTo_After(new SgVarRefExp(*dbg_var),new SgValueExp(dbg_if_regim)); - cur_st->insertStmtAfter(*(stcall=D_PutDebugVarAdr(dbg_var,flag))); - cur_st = stcall; -} - -void InitFileNameVariables() -{ filename_list *sl; - SgExpression *lenexp,*e; - int length; - SgFunctionSymb *fs = new SgFunctionSymb(FUNCTION_NAME, "char", *SgTypeChar(), *cur_func->controlParent()); - SgFunctionCallExp *fcall = new SgFunctionCallExp(*fs); - fcall->addArg(* new SgValueExp(0)); - if(filename_num>1 && cur_func->variant() != PROG_HEDR) { - file_var_s = new SgVariableSymb(FileNameVar(0), *SgTypeInt(), *cur_func); - cur_st = doIfForFileVariables(file_var_s); - } - for(sl=fnlist; sl; sl=sl->next){ - length = strlen(sl->name)+1; - lenexp = new SgValueExp(length); - e = new SgExpression(ARRAY_OP); - e->setLhs(new SgVarRefExp(*sl->fns)); - e->setRhs(new SgExpression(DDOT,lenexp,lenexp,(SgSymbol *)NULL)); - doAssignTo_After( e, fcall); - } - if(filename_num>1 && cur_func->variant() != PROG_HEDR){ - doAssignTo_After( new SgVarRefExp(*file_var_s), new SgValueExp(1)); - cur_st = cur_st->lexNext(); - } -} - - -void InitHeap(SgSymbol *heap) -//generating assign statement: HEAP(1) = 2 -{ doAssignTo(ARRAY_ELEMENT(heap,1), new SgValueExp(2)); } - -void InitAsyncid() -{symb_list *sl; - for(sl=async_symb; sl; sl=sl->next) - //generating assign statement: ASINCID(1) = 1 - if((IN_COMMON(sl->symb) && IN_MAIN_PROGRAM) || !IN_COMMON(sl->symb)) - doAssignTo(ARRAY_ELEMENT(sl->symb,1), new SgValueExp(1)); - } - -SgExpression * isDoVarUse (SgExpression *e, int use[], SgSymbol *ident[], int ni, int *num, SgStatement *st) -{ - SgExpression *ei; - *num = AxisNumOfDummyInExpr(e, ident, ni, &ei, use, st); - if (*num<=0) - return(NULL); - return(ei); -} - -SgSymbol* isIndirectSubscript (SgExpression *e, SgSymbol *ident, SgStatement *st) -{//temporary - if(e && ident && st) - return(NULL); - return(NULL); -} - - -/* -void InsertRedVarsInGroup(SgExpression *redgref,int irv,int nred) -{int i; - for(i=irv+nred-1; i>=irv; i--) - doAssignStmtAfter(InsertRedVar(redgref,i,iplp)); -} -*/ - -/* -void BeginDebugFragment(int num,SgStatement *stmt) -{fragment_list *curfr; - fragment_list_in *fr; - -// searhing frament - fr=debug_fragment; -//looking through the fragment list of command line - while(fr && (fr->N1 > num || fr->N2 < num) ) - fr=fr->next; - if (fr){ //fragment with number 'num' is found (N1 <= num <= N2) - if(fr->dlevel){ - dvm_debug = 1; - level_debug = fr->dlevel; - } - if(fr->elevel) - perf_analysis = fr->elevel; - curfr = new fragment_list; - curfr->No = num; - if(fr->dlevel) - curfr->dlevel = fr->dlevel; - else - curfr->dlevel = cur_fragment ? cur_fragment->dlevel : 0; - if(fr->elevel) - curfr->elevel = fr->elevel; - else - curfr->elevel = cur_fragment ? cur_fragment->elevel : 0; - curfr->next = cur_fragment; - cur_fragment = curfr; - } else {//fragment with number 'num' is not found - curfr = new fragment_list; - curfr->No = num; - curfr->dlevel = cur_fragment ? cur_fragment->dlevel : 0; - curfr->elevel = cur_fragment ? cur_fragment->elevel : 0; - curfr->next = cur_fragment; - cur_fragment = curfr; - } - return; -} - -void BeginDebugFragment(int num, SgStatement *stmt) -{fragment_list *curfr; - fragment_list_in *fr; - int max_dlevel,max_elevel,is_max; -//determing maximal level - if(stmt) - is_max = MaxLevels(stmt,&max_dlevel,&max_elevel); - else - is_max =0; - -// searhing fragment - fr=debug_fragment; -//looking through the fragment list of command line - while(fr && (fr->N1 > num || fr->N2 < num) ) - fr=fr->next; - if (fr){ //fragment with number 'num' is found (N1 <= num <= N2) - if(fr->dlevel){ - if(fr->dlevel == -1){ - dvm_debug = 0; - level_debug = 0; - } else { - dvm_debug = 1; - level_debug = MinLevel(fr->dlevel,max_dlevel,is_max); - } - } - if(fr->elevel) - if(fr->elevel == -1) - perf_analysis = 0; - else - perf_analysis = MinLevel(fr->elevel,max_elevel,is_max); - curfr = new fragment_list; - curfr->No = num; - curfr->dlevel = level_debug; - curfr->elevel = perf_analysis; - curfr->next = cur_fragment; - cur_fragment = curfr; - } else {//fragment with number 'num' is not found - curfr = new fragment_list; - curfr->No = num; - curfr->dlevel = cur_fragment ? MinLevel(cur_fragment->dlevel,max_dlevel,is_max) : 0; - curfr->elevel = cur_fragment ? MinLevel(cur_fragment->elevel,max_elevel,is_max) : 0; - curfr->next = cur_fragment; - cur_fragment = curfr; - perf_analysis = curfr->elevel; - level_debug = curfr->dlevel; - dvm_debug = level_debug ? 1 : 0; - } - return; -} -*/ - -void BeginDebugFragment(int num, SgStatement *stmt) -{ - fragment_list *curfr; - fragment_list_in *fr; - int max_dlevel, max_elevel, is_max, d_current, e_current, spec_dlevel, spec_elevel; - //determing maximal level of debugging and performance analyzing - if (stmt) - is_max = MaxLevels(stmt, &max_dlevel, &max_elevel); - else - { - is_max = 0; - max_dlevel = max_elevel = 4; - } - - // level specified for surrounding fragment - d_current = cur_fragment ? cur_fragment->dlevel_spec : 0; - e_current = cur_fragment ? cur_fragment->elevel_spec : 0; - - // searhing fragment in 2 lists - fr = debug_fragment; - //looking through the fragment list specified for debugging (-d) in command line - while (fr && (fr->N1 > num || fr->N2 < num)) - fr = fr->next; - if (fr) //fragment with number 'num' is found (N1 <= num <= N2) - spec_dlevel = fr->level; - else - spec_dlevel = d_current; - - fr = perf_fragment; - //looking through the fragment list specified for performance analyze (-e) in command line - while (fr && (fr->N1 > num || fr->N2 < num)) - fr = fr->next; - if (fr) //fragment with number 'num' is found (N1 <= num <= N2) - spec_elevel = fr->level; - else - spec_elevel = e_current; - level_debug = MinLevel(spec_dlevel, max_dlevel, is_max); - dvm_debug = level_debug ? 1 : 0; - perf_analysis = MinLevel(spec_elevel, max_elevel, is_max); - curfr = new fragment_list; - curfr->No = num; - curfr->begin_st = stmt; - curfr->dlevel = level_debug; - curfr->elevel = perf_analysis; - curfr->dlevel_spec = spec_dlevel; - curfr->elevel_spec = spec_elevel; - curfr->next = cur_fragment; - cur_fragment = curfr; -} - -int MinLevel(int level, int max, int is_max) -{ - if (is_max) - return((level > max) ? max : level); - else - return(level); -} - -int MaxLevels(SgStatement *stmt,int *max_dlevel,int *max_elevel) -{ SgExpression *el,*ee; - SgKeywordValExp *kwe; - int n,is_max; - *max_dlevel = 4; - *max_elevel = 4; - is_max =0; - for(el=stmt->expr(1); el; el = el->rhs()) { - ee = el->lhs(); - kwe = isSgKeywordValExp(ee->lhs()); - if (!strcmp(kwe->value(),"d")) { - if((ee->rhs()->variant() != INT_VAL) || (n=ee->rhs()->valueInteger()) < 0) - err("Illegal debug parameter",303,stmt); - else - {*max_dlevel = n; is_max = 1;} - } - else if (!strcmp(kwe->value(),"e")) { - if((ee->rhs()->variant() != INT_VAL) || (n=ee->rhs()->valueInteger()) < 0) - err("Illegal debug parameter",303,stmt); - else - {*max_elevel = n; is_max = 1;} - } - } - return(is_max); -} - -void EndDebugFragment(int num) -{ if(!cur_fragment || cur_fragment->No != num) return; - cur_fragment = cur_fragment->next; - level_debug = cur_fragment->dlevel; - dvm_debug = level_debug ? 1 : 0; - perf_analysis = cur_fragment->elevel; -} - -SgExpression *PointerArrElem(SgSymbol *p,SgStatement *stdis) -{ - SgExpression *el; - for (el = stdis->expr(0); el; el = el->rhs()) - if(el->lhs()->symbol() == p) - return(el->lhs()); - return(NULL); -} - -SgExpression *ReverseDim(SgExpression *desc,int rank) -{int i,ind; -SgExpression *e,*de; - ind = ndvm; - e = desc->lhs(); - for(i= rank-1; i>=0; i--){ - de = &(desc->copy()); - if(e) - de->lhs()->setLhs(Calculate(&(e->lhs()->copy()+ *new SgValueExp(i)))); - else - de->setLhs(new SgExprListExp(*new SgValueExp(i+1))); - doAssignStmt(de); - } -return(DVM000(ind)); -} -/* -SgExpression *DoSubscriptList(SgExpression *are,int ind) -{return(new SgExprListExp(*new SgValueExp(ind)));} - */ - -void EndReduction_Task_Region(SgStatement *stmt) -{ - if(!stmt) return; - // actualizing of reduction variables - if(redgrefts) - ReductionVarsStart(task_red_list); - - if(irgts) { - // generating call statement: - // call strtrd(RedGroupRef) - doCallAfter(StartRed(redgrefts)); - - // generating call statement: - // call waitrd(RedGroupRef) - doCallAfter(WaitRed(redgrefts)); - /*ReductionVarsWait(red_list);*/ - //if(idebrg){ - // if(dvm_debug) - // doAssignStmtAfter( D_CalcRG(DVM000(idebrg))); - // doAssignStmtAfter( D_DelRG (DVM000(idebrg))); - // } - // generating assign statement: - // dvm000(i) = delobj(RedGroupRef) - doCallAfter(DeleteObject_H(redgrefts)); - } -} - - -void Reduction_Task_Region(SgStatement *stmt) -{SgExpression *e; - SgStatement *st2, *st3; - - irgts=0; - redgrefts=NULL; - e=stmt->expr(0); - if(!e) return; - task_red_list = e->lhs(); - if( e->symbol()){ - redgrefts = new SgVarRefExp(e->symbol()); - doIfForReduction(redgrefts,0); - nloopred++; - //stcg = doIfForCreateReduction( e->symbol(),nloopcons,0); - st2 = doIfForCreateReduction( redgrefts->symbol(),nloopred,1); - st3 = cur_st; - cur_st = st2; - ReductionList(task_red_list,redgrefts,stmt,st2,st2,0); - cur_st = st3; - InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); - - } else { - irgts = ndvm; - redgrefts = DVM000(irgts); - doAssignStmtAfter(CreateReductionGroup()); - //!!!??? if(debug_regim){ - // idebcg = ndvm; - // doAssignStmtAfter( D_CreateDebRedGroup()); - //} - - ReductionList(task_red_list,redgrefts,stmt,cur_st,cur_st,0); - } -} - - -int NumberOfElements(SgSymbol *sym, SgStatement *stmt, int err) -{int i,rank,nm; - SgExpression *esize,*numb,*pe; - SgArrayType *artype; - SgValueExp c1(1); - SgSubscriptExp *sbe; - artype=isSgArrayType(sym->type()); - if(artype) - rank = artype->dimension();//array - else - return(1); //scalar variable - numb = &c1; - for(i=1; i<=rank; i++) { //array - //calculating size of i-th dimension - pe = artype->sizeInDim(i-1); - if ((sbe=isSgSubscriptExp(pe)) != NULL){ // [lbound] : [ubound] - - if(err && !sbe->ubound()){ // [lbound] : - Error("Assumed-shape or deffered-shape array: %s",sym->identifier(), 295, stmt); - esize = &(pe->copy()); - } - else if(err && sbe->ubound()->variant() == STAR_RANGE) // ubound = * - Error("Assumed-size array: %s",sym->identifier(), 162, stmt); - - esize = &(((sbe->ubound())->copy()) - (sbe->lbound() ? (sbe->lbound())->copy() : c1 ) + c1); - - } else { // ubound - if(err && pe->variant() == STAR_RANGE) // dim=ubound = * - Error("Assumed-size array: %s",sym->identifier(), 162, stmt); - esize = &(pe->copy()); - } - if(esize) - numb = &(*numb * (*esize)); - } - numb = ReplaceParameter(numb); - if (numb->isInteger()) // calculating length if it is possible - nm = numb->valueInteger(); - else - { Error("Can't calculate array length: %s",sym->identifier(),194,stmt); - nm = 1; - if(err == 2) nm=0; - } - return(nm); - } - - -SgExpression * HeapIndex(SgStatement *st) -{SgSymbol *s; - SgExpression *e; - SgArrayType *artype; - int rank; - s = st->expr(0)->symbol(); - artype=isSgArrayType(s->type()); - if(!artype) - return(new SgValueExp(POINTER_INDEX(s))); - - rank = artype->dimension(); - - if(rank == 1) { - e =&(*new SgValueExp(POINTER_INDEX(s)) + (*st->expr(0)->lhs()->lhs() - *LowerBoundOfDimension(artype,0))* ( *new SgValueExp(HEADER_SIZE(s)))); - return(e); - } - return(new SgValueExp(POINTER_INDEX(s))); -} - -SgExpression * LowerBoundOfDimension(SgArrayType *artype, int i) -{ SgExpression *e,*eb; - SgSubscriptExp *sbe; - e = artype->sizeInDim(i); - if(!e) // pointer declaration error - return(new SgValueExp(1)); - if((sbe=isSgSubscriptExp(e)) != NULL) - eb = & (sbe->lbound()->copy()); - else - eb = new SgValueExp(1); // by default lower bound = 1 - return(eb); -} - - - -SgExpression *AsyncArrayElement(SgExpression *asc, SgExpression *ei) -{SgArrayRefExp *e; - e = new SgArrayRefExp(*ORIGINAL_SYMBOL(asc->symbol()),*ei); - if(asc->lhs()) - e->addSubscript(asc->lhs()->copy()); - return(e); -} - -void AsyncCopyWait(SgExpression * asc) -{SgForStmt *dost; - SgStatement *as,*st; - SgExpression *eas; - SgLabel *loop_lab; - int i; - st = cur_st; - - //doAssignTo_After(ARRAY_ELEMENT(asc,1),new SgValueExp(1)); - doAssignTo_After(AsyncArrayElement(asc,new SgValueExp(1)),new SgValueExp(1)); - nio = (nio <1) ? 1 : nio; - //eas = new SgArrayRefExp(*asc,*new SgVarRefExp(*loop_var[0])); - eas = AsyncArrayElement(asc, new SgVarRefExp(*loop_var[0])); - i = ndvm++; - loop_lab = GetLabel(); - as = new SgAssignStmt(*DVM000(i),*WaitCopy(eas)); - //dost= new SgForStmt(loop_var[0], new SgValueExp(2), ARRAY_ELEMENT(asc,1), new SgValueExp(1), as); - dost= new SgForStmt(loop_var[0], new SgValueExp(2), AsyncArrayElement(asc,new SgValueExp(1)), new SgValueExp(1), as); - BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; - as->setLabel(*loop_lab); - InsertNewStatementAfter(dost, st, st->controlParent()); - as->lexNext()->extractStmt(); - cur_st = as; - - SET_DVM(i); -} - -int isWholeArray(SgExpression *ae) -{ - if(!isSgArrayRefExp(ae)) - return (0); - for(SgExpression *el=ae->lhs(); el; el=el->rhs()) - { - if(el->lhs()->variant() != DDOT) - return (0); - if(el->lhs()->lhs() || el->lhs()->rhs()) - return (0); - continue; - } - return (1); -} - -int DistrArrayAssign(SgStatement *stmt) -{SgExpression *le,*re,*headl,*headr; - int to_init,rl,from_init,rr,dvm_ind,left_whole,right_whole; - SgSymbol *ar; - SgType *typel,*typer; - - re = stmt->expr(1); - le = stmt->expr(0); - if(!isSgArrayRefExp(le)) - return(0); - if(!isSgArrayType(le->type())) - return(0); - if(isSgArrayType(re->type())) - if(!isSgArrayRefExp(re)) - return(0); - else - // assignment statement of kind: = - { - if(only_debug) - return(1); - left_whole = !le->lhs(); - right_whole = !re->lhs(); - CANCEL_RTS2_MODE; // switch to basic RTS interface - ChangeDistArrayRef(le->lhs()); //replacing dvm-array references in subscript list - ChangeDistArrayRef(re->lhs()); - LINE_NUMBER_BEFORE(stmt,stmt); - cur_st = stmt; - dvm_ind = 0; - ar = le->symbol(); - rl = Rank(ar); - typel = ar->type()->baseType(); - headl = HeaderRef(ar); - - SgExpression *left_section_list = ArraySection(le,ar,rl,stmt,to_init); - ar = re->symbol(); - typer = ar->type()->baseType(); - if(!CompareTypes(typel,typer)) - err("Different types of left and right side",620,stmt); - rr = Rank(ar); - headr = HeaderRef(ar); - if(!headr) - { //Warning("'%s' isn't distributed array", ar->identifier(), 72,stmt); - /* - if(re->lhs()) // section - { dvm_ind = HeaderForNonDvmArray(ar,stmt); - headr = DVM000(dvm_ind); - } else // whole array - headr = FirstElementOfSection(re); - */ - dvm_ind = HeaderForNonDvmArray(ar,stmt); - headr = DVM000(dvm_ind); - } - SgExpression *right_section_list = ArraySection(re,ar,rr,stmt,from_init); - if(INTERFACE_RTS2) - { - if(left_whole && right_whole) // whole-array = whole-array - doCallAfter(DvmhArrayCopyWhole(headr,headl)); - else - doCallAfter(DvmhArrayCopy(headr,rr,right_section_list,headl,rl,left_section_list)); - } - else - doAssignStmtAfter(ArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0)); - if(dvm_ind) - doCallAfter(DeleteObject_H(DVM000(dvm_ind))); - SET_DVM(to_init); - RESUMPTION_RTS2_MODE; // return to RTS2 interface - return(1); - } - - // assignment statement of kind: = - if(only_debug) - return(1); - CANCEL_RTS2_MODE; // switch to basic RTS interface - if(INTERFACE_RTS2 && !isWholeArray(stmt->expr(0))) - err("Illegal array statement in -Opl2 mode", 642, stmt); - - ChangeDistArrayRef(stmt->expr(0)->lhs()); //replacing dvm-array references in subscript list - ChangeDistArrayRef(stmt->expr(1)); - - LINE_NUMBER_BEFORE(stmt,stmt); - cur_st = stmt; - ar = le->symbol(); - rl = Rank(ar); - headl = HeaderRef(ar); - typel = ar->type()->baseType(); - headr = TypeFunction(typel,re,KINDFunction(new SgArrayRefExp(*baseMemory(ar->type()->baseType())))); - SgExpression *left_section_list = ArraySection(le,ar,rl,stmt,to_init); - if(INTERFACE_RTS2) - doCallAfter(DvmhArraySetValue(headl,headr)); - else - doAssignStmtAfter(ArrayCopy(headr, to_init, to_init, to_init, headl, to_init, to_init+rl, to_init+2*rl, -1)); - SET_DVM(to_init); - RESUMPTION_RTS2_MODE; // return to RTS2 interface - return(1); -} - -int AssignDistrArray(SgStatement *stmt) -{SgExpression *le,*re,*headl,*headr; - int to_init,rl,from_init,rr,dvm_ind,left_whole,right_whole; - SgSymbol *ar; - SgType *typel,*typer; - re = stmt->expr(1); - le = stmt->expr(0); - if(!isSgArrayRefExp(le) || !isSgArrayType(le->type())) - return(0); - if(!isSgArrayRefExp(re) || !isSgArrayType(re->type()) || !IS_DVM_ARRAY(re->symbol())) - return(0); - - // assignment statement of kind: = - if(only_debug) - return(1); - CANCEL_RTS2_MODE; // switch to basic RTS interface - left_whole = !le->lhs(); - right_whole = !re->lhs(); - - ChangeDistArrayRef(stmt->expr(0)->lhs()); //replacing dvm-array references in subscript list - ChangeDistArrayRef(stmt->expr(1)->lhs()); - - LINE_NUMBER_BEFORE(stmt,stmt); //LINE_NUMBER_AFTER(stmt,stmt); - cur_st = stmt; - ar = le->symbol(); - typel = ar->type()->baseType(); - //Warning("'%s' isn't distributed array", ar->identifier(), 72,stmt); - rl = Rank(ar); - /* - if(le->lhs()) // section - { dvm_ind = HeaderForNonDvmArray(ar,stmt); - headl = DVM000(dvm_ind); - } else // whole array - { dvm_ind = 0; - headl = FirstElementOfSection(le); - } - */ - dvm_ind = HeaderForNonDvmArray(ar,stmt); - headl = DVM000(dvm_ind); - SgExpression *left_section_list = ArraySection(le,ar,rl,stmt,to_init); - ar = re->symbol(); - typer = ar->type()->baseType(); - rr = Rank(ar); - headr = HeaderRef(ar); - if(!headr) { // if there is error of dvm-array specification, header is not created - RESUMPTION_RTS2_MODE; // return to RTS2 interface - return(0); - } - if(!CompareTypes(typel,typer)) - err("Different types of left and right side",620,stmt); - - SgExpression *right_section_list = ArraySection(re,ar,rr,stmt,from_init); - if(INTERFACE_RTS2) - { - if(left_whole && right_whole) // whole-array = whole-array - doCallAfter(DvmhArrayCopyWhole(headr,headl)); - else - doCallAfter(DvmhArrayCopy(headr,rr,right_section_list,headl,rl,left_section_list)); - } - else - doAssignStmtAfter(ArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0)); - - if(dvm_ind) - doCallAfter(DeleteObject_H(DVM000(dvm_ind))); - - SET_DVM(dvm_ind ? dvm_ind : to_init) ; //SET_DVM(to_init); - RESUMPTION_RTS2_MODE; // return to RTS2 interface - return(1); -} - -SgExpression *ArraySection(SgExpression *are, SgSymbol *ar, int rank, SgStatement *stmt, int &init) -{ - SgExpression *el,*einit[MAX_DIMS],*elast[MAX_DIMS],*estep[MAX_DIMS]; - SgExpression *section_list = NULL; - int i,j; - init = ndvm; - if(!are->lhs()) { //MakeSection(are); // A => A(:,:, ...,:) - if(INTERFACE_RTS2) - MakeSection(are); // A => A(:,:, ...,:) - else { - for(j=rank; j; j--) - doAssignStmtAfter(Calculate(new SgValueExp(-1))); - ndvm += 2*rank; - return (section_list);//return(init); - } - } - if(!TestMaxDims(are->lhs(),ar,stmt)) return(0); - for(el=are->lhs(),i=0; el; el=el->rhs(),i++) - Triplet(el->lhs(),ar,i, einit,elast,estep); - if(i != rank){ - Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,stmt); - //return (0); - } - if(INTERFACE_RTS2) - for(j=0; jexpr(1); - if(!isSgArrayRefExp(re)) { - err("Illegal statement in ASYNCHRONOS_ENDASYNCHRONOUS block",901,stmt); - return; - } - - ar = re->symbol(); - typer = ar->type()->baseType(); - ar1=ar; - rr = Rank(ar); - headr = HeaderRef(ar); - if(!TestMaxDims(re->lhs(),ar,stmt)) return; - if(!re->lhs()) MakeSection(re); // A => A(:,:, ...,:) - for(el=re->lhs(),i=0; el; el=el->rhs(),i++) - Triplet(el->lhs(),ar,i, einit,elast,estep); - if(i != rr){ - Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,stmt); - return; - } - from_init = ndvm; - for(j=i; j; j--) - doAssignStmtAfter(Calculate(einit[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(Calculate(elast[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(estep[j-1]); - - le = stmt->expr(0); - if(!isSgArrayRefExp(le)) { - err("Illegal statement in ASYNCHRONOS_ENDASYNCHRONOUS block",901,stmt); - return; - } - ar = le->symbol(); - rl = Rank(ar); - typel = ar->type()->baseType(); - if(!CompareTypes(typel,typer)) - err("Different types of left and right side",620,stmt); - headl = HeaderRef(ar); - if(!TestMaxDims(le->lhs(),ar,stmt)) return; - if(!le->lhs()) MakeSection(le); // A => A(:,:, ...,:) - for(el=le->lhs(),i=0; el; el=el->rhs(),i++) - Triplet(el->lhs(),ar,i, einit,elast,estep); - if(i != rl){ - Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,stmt); - return; - } - to_init = ndvm; - for(j=i; j; j--) - doAssignStmtAfter(Calculate(einit[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(Calculate(elast[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(estep[j-1]); - - if(!headr && !headl) { - err("Both arrays are not distributed", 297,stmt); - return; - } else if(!headr) { - Warning("'%s' isn't distributed array", ar1->identifier(), 72,stmt); - headr = FirstElementOfSection(re); - } else if(!headl) { - Warning("'%s' isn't distributed array", ar->identifier(), 72,stmt); - headl = FirstElementOfSection(le); - } - - doAssignStmtAfter(AsyncArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0, flag)); - - SET_DVM(from_init); -} - -void Triplet(SgExpression *e,SgSymbol *ar,int i, SgExpression *einit[],SgExpression *elast[],SgExpression *estep[]) -{SgValueExp c1(1),c0(0); - - if(e->variant() != DDOT) { //is not triplet - einit[i] = INTERFACE_RTS2 ? e : &(*e-*Exprn(LowerBound(ar,i))); - elast[i] = einit[i]; - estep[i] = &c1.copy(); - return; - } - // is triplet - - if(e->lhs() && e->lhs()->variant() == DDOT) { // there is step - estep[i] = e->rhs(); - e = e->lhs(); - } else - estep[i] = &c1.copy(); - if (!e->lhs()) - einit[i] = INTERFACE_RTS2 ? ConstRef_F95(-2147483648) : &c0.copy(); - else - einit[i] = INTERFACE_RTS2 ? e->lhs() : &(*(e->lhs())-*Exprn(LowerBound(ar,i))); - if (!e->rhs()) - elast[i] = INTERFACE_RTS2 ? ConstRef_F95(-2147483648) : &(*Exprn(UpperBound(ar,i))-*Exprn(LowerBound(ar,i))); - else - elast[i] = INTERFACE_RTS2 ? e->rhs() : &(*(e->rhs())-*Exprn(LowerBound(ar,i))); - - return; -} - -void LowerBoundInTriplet(SgExpression *e,SgSymbol *ar,int i, SgExpression *einit[]) -{ - SgValueExp c1(1),c0(0); - if(e->variant() != DDOT) { //is not triplet - einit[i] = &(e->copy()); - return; - } - // is triplet - if(e->lhs() && e->lhs()->variant() == DDOT) // there is step - e = e->lhs(); - e = e->lhs(); - if (!e) - einit[i] = Exprn(LowerBound(ar,i)); //new SgValueExp(1); - else - einit[i] = &(e->copy()); - return; -} - - -void UpperBoundInTriplet(SgExpression *e,SgSymbol *ar,int i, SgExpression *einit[]) -{ - //SgValueExp c1(1),c0(0); - if(e->variant() != DDOT) { //is not triplet - einit[i] = &(e->copy()); - return; - } - // is triplet - if(e->lhs() && e->lhs()->variant() == DDOT) // there is step - e = e->lhs(); - e = e->rhs(); - if (!e) - einit[i] = Exprn(UpperBound(ar,i)); - else - einit[i] = &(e->copy()); - return; -} - - -int doSectionIndex(SgExpression *esec, SgSymbol *ar, SgStatement *st, int idv[], int ileft, SgExpression *lrec[], SgExpression *rrec[]) -{int i, j, rank, isec, ilow, ihi; - SgExpression *el,*einit[MAX_DIMS],*elast[MAX_DIMS],*estep[MAX_DIMS]; - SgValueExp cM1(-1); - rank = Rank(ar); - isec = ndvm; - for(j=rank; j; j--) - doAssignStmtAfter(&cM1); - if(! esec->lhs()) { //no array section - idv[0] = isec; - idv[1] = idv[0]; - } else { - if(!TestMaxDims(esec->lhs(),ar,st)) return (0); - for(el=esec->lhs(),i=0; el; el=el->rhs(),i++) //looking through the section index list - Triplet(el->lhs(),ar,i, einit,elast,estep); - if(i != rank){ - Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,st); - return(0); - } - - for(j=i; j; j--) - doAssignStmtAfter(Calculate(einit[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(Calculate(elast[j-1])); - - idv[0] = isec+rank; - idv[1] = isec+2*rank; - } - if(!esec->rhs()){ - idv[2] = isec; - idv[3] = ileft; - idv[4] = isec; - idv[5] = ileft+rank; - return(1); - } - ilow=ndvm; - if(!esec->rhs()->lhs()) {//no low shadow section - idv[2] = isec; - idv[3] = ileft; - } else { - if(!TestMaxDims(esec->rhs()->lhs(),ar,st)) return (0); - for(el=esec->rhs()->lhs(),i=0; el; el=el->rhs(),i++)//looking through the section index list - ShadowSectionTriplet(el->lhs(), i, einit,elast,estep,lrec,rrec,0); - if(i != rank){ - Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,st); - return(0); - } - - for(j=i; j; j--) - doAssignStmtAfter(Calculate(einit[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(Calculate(elast[j-1])); - - idv[2] = ilow; - idv[3] = ilow+rank; - } - ihi=ndvm; - if(!esec->rhs()->rhs()) {//no high shadow section - idv[4] = isec; - idv[5] = ileft+rank; - } else { - if(!TestMaxDims(esec->rhs()->rhs(),ar,st)) return (0); - for(el=esec->rhs()->rhs(),i=0; el; el=el->rhs(),i++)//looking through the section index list - ShadowSectionTriplet(el->lhs(), i, einit,elast,estep,lrec,rrec,1); - if(i != rank){ - Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,st); - return(0); - } - - for(j=i; j; j--) - doAssignStmtAfter(Calculate(einit[j-1])); - for(j=i; j; j--) - doAssignStmtAfter(Calculate(elast[j-1])); - - idv[4] = ihi; - idv[5] = ihi+rank; - } - return(1); -} - -void ShadowSectionTriplet(SgExpression *e, int i, SgExpression *einit[], SgExpression *elast[], SgExpression *estep[], SgExpression *lrec[], SgExpression *rrec[], int flag) -{SgValueExp c1(1),c0(0),cM1(-1); - - if(e->variant() != DDOT) { //is not triplet - einit[i] = &(*e-c1.copy()); - elast[i] = einit[i]; - estep[i] = &c1.copy(); - return; - } - // is triplet - - if(e->lhs() && e->lhs()->variant() == DDOT) { // there is step - estep[i] = e->rhs(); - e = e->lhs(); - } else - estep[i] = &c1.copy(); - - if(!e->lhs() && !e->rhs()) { - einit[i] = &cM1.copy(); - elast[i] = (flag == 0 )? lrec[i] : rrec[i]; - return; - } - if(!e->lhs()) - einit[i] = &c0.copy(); - else - einit[i] = &(*(e->lhs())- c1.copy()); - if (!e->rhs()) - elast[i] = &(((flag == 0 )? *lrec[i] : *rrec[i]) - c1.copy()); - else - elast[i] = &(*(e->rhs()) - c1.copy()); - - return; -} - -void DeleteShadowGroups(SgStatement *stmt) -{ group_name_list *sl; - //int i; - //i=0; - for(sl=grname; sl; sl=sl->next) - //if(!IS_SAVE(sl->symb)) /*podd 18.09.07*/ - if (sl->symb->variant() == SHADOW_GROUP_NAME){ - //if(i == 0) - //{ LINE_NUMBER_BEFORE(stmt,stmt);} - //i++; - doIfForDelete(sl->symb,stmt); - } -} - -void DeleteLocTemplate(SgStatement *stmt) -{symb_list *sl; - SgExpression *e; - //if(loc_templ_symb) - //{ LINE_NUMBER_BEFORE(stmt,stmt);} - for(sl=loc_templ_symb; sl; sl=sl->next){ - e = HeaderRef(sl->symb); - if(e) - InsertNewStatementBefore(DeleteObject_H(e),stmt); - } -} - -void RegistrationList(SgStatement *stmt) -{ SgExpression *el; - SgSymbol * s; - int is_assign; - is_assign =0; - for(el=stmt->expr(0); el; el=el->rhs()) { - if(el->lhs()->variant() == ASSGN_OP || el->lhs()->variant() == POINTST_OP) is_assign = 1;//with initial value - s = el->lhs()->symbol(); - if(debug_regim && s && IS_ARRAY(s)) - registration = AddNewToSymbList( registration, s); - } - if(is_assign && stmt->variant() == VAR_DECL && !stmt->expr(2)) - stmt->setVariant(VAR_DECL_90); - return; -} - -SgExpression *DebReductionGroup(SgSymbol *gs) -{ - SgSymbol *rgv; - SgExpression *rgvref; - rgv = * ((SgSymbol **) (ORIGINAL_SYMBOL(gs)) -> attributeValue(0,RED_GROUP_VAR)); - rgvref = new SgArrayRefExp(*rgv,*new SgValueExp(0)); - return(rgvref); -} - -void EndOfProgramUnit(SgStatement *stmt, SgStatement *func, int begin_block) -{ - if(func->variant() == PROG_HEDR) { // for MAIN program - SgStatement *where_st = stmt; - if(begin_block) - where_st = EndBlock_H(stmt); - ExitDataRegionForVariablesInMainProgram(where_st); /*ACC*/ - RTLExit(stmt); - } - else if (func->variant() == PROC_HEDR || func->variant() == FUNC_HEDR) { - SgStatement *stat = stmt; - if(begin_block) - stat = EndBlock_H(stmt); - else - DeleteShadowGroups(stmt); - if(loc_templ_symb) - DeleteLocTemplate(stmt); - acc_return_list = addToStmtList(acc_return_list,stat); //save the point to insert RTSH-calls:dvmh_data_exit - } -} -void InitBaseCoeffs() -{ - if(opt_base && !HPF_program && dsym) { - symb_list *sl; - coeffs * c; - SgExpression *e,*el; - SgType *t; - for(sl=dsym; sl; sl=sl->next) { - c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); - if(!c->use) - continue; - e = new SgVarRefExp(*(c->sc[1])); - t = sl->symb->type()->baseType(); - el = &((*GetAddresMem( new SgArrayRefExp(*baseMemory(t),*new SgValueExp(0))) - *GetAddresMem( new SgArrayRefExp(**ARRAY_BASE_SYMBOL(sl->symb),*new SgValueExp(0)))) / *new SgValueExp(TypeSize(t))); - - doAssignTo_After(e, el); - // rank=Rank(sl->symb); - //for(i=1;i<=rank;i++){ - // eel = new SgExprListExp(* new SgVarRefExp(*(c->sc[1]))); - } - } -} - -void CreateIndexVariables(SgExpression *dol) -{SgExpression *dovar; -// looking through the do_variables list - for(dovar=dol; dovar; dovar=dovar->rhs()) - if(!(INDEX_SYMBOL(dovar->lhs()->symbol()))){ - SgSymbol **s = new (SgSymbol *); - //creating new variable - *s = IndexSymbol(dovar->lhs()->symbol()); - // adding the attribute (INDEX_DELTA) to do-variable symbol - (dovar->lhs()->symbol())->addAttribute(INDEX_DELTA, (void*) s, sizeof(SgSymbol *)); - index_symb = AddToSymbList(index_symb,*s); - } -} - -void doAssignIndexVar(SgExpression *dol,int iout, SgExpression *init[]) -{SgExpression *dovar; - int i; -// looking through the do_variables list - for(dovar=dol,i=0; dovar; dovar=dovar->rhs(),i++){ - if(INDEX_SYMBOL(dovar->lhs()->symbol())) - doAssignTo_After(new SgVarRefExp(*INDEX_SYMBOL(dovar->lhs()->symbol())),&(*DVM000(iout+i) - init[i]->copy())); -} -} - -SgExpression *TestDVMArrayRef(SgExpression *e) -{SgExpression *dovar, *vl, *ei, *el, *coeff, *cons, *eop; - SgSymbol *dim_ident[MAX_DIMS]; - int i,j,k,n,num,use[MAX_DIMS],is; - sum_dvm = NULL; - is = isInSymbList(dvm_ar,e->symbol()); - - if(!HEADER(e->symbol())) return(NULL); - n = Rank(e->symbol()); - sum_dvm = coef_ref(e->symbol(),n+2); - vl = parallel_dir->expr(2); // do_variables list of PARALLEL directive - for(dovar=vl,i=0; dovar; dovar=dovar->rhs(),i++){ - dim_ident[i] = dovar->lhs()->symbol(); - //fprintf(stderr,"%s\n",dovar->lhs()->symbol()->identifier()); - use[i] = 0; - } - //fprintf(stderr,"%d\n",i); - for(el=e->lhs(),k=n+1;el;el=el->rhs(),k--){ - //fprintf(stderr,"%d\n",k); - for(j=0;jlhs(),dim_ident,i,&ei,use,NULL); - //fprintf(stderr,"num%d\n",num); - if(num<0){ - Warning("Maybe incorrect subscript of DVM-array reference: %s",e->symbol()->identifier(),332,cur_st); - return(NULL); - } - if(num == 0) continue; - CoeffConst(el->lhs(),ei,&coeff,&cons); - if(!coeff){ - Warning("Maybe incorrect subscript of DVM-array reference: %s",e->symbol()->identifier(),332,cur_st); - return(NULL); - } - eop = new SgVarRefExp(*INDEX_SYMBOL(dim_ident[num-1])); - - if(k!=(n+1)){ - eop = &((*coef_ref(e->symbol(),k))* (*eop)); - // fprintf(stderr,"%d\n",k); - } - if(coeff->isInteger() && coeff->valueInteger() == 1) - {;} - else - eop = &((coeff->copy()) *(*eop)); - sum_dvm = &(*sum_dvm + (*eop) ); - - } - //do_var=isDoVarUse(es->lhs(),use,dim_ident,i,&num,par_st) - //*num = AxisNumOfDummyInExpr(e, ident, ni, &ei, use, cur_st); - //if (*num<=0) - // return(NULL); - //return(ei); - //sum_dvm->unparsestdout(); - //eop->unparsestdout(); - //fprintf(stderr,"%s%d\n",e->symbol()->identifier(),k); - - if(!is) ChangeArrayCoeff(e->symbol()); - return(sum_dvm); -} - - -void ChangeIndexRefBySum(SgExpression *ve) -{ - SgSymbol *is,*s; - is = *INDEX_SYMBOL(ve->symbol()); - s = ve->symbol(); - NODE_CODE(ve->thellnd) = ADD_OP; - //ve->setVariant(ADD_OP); - ve->setLhs(*new SgVarRefExp(*s)); - //ve->setLhs(ve->copy()); - //ve->setLhs(*new SgValueExp(1)); - ve->setRhs(*new SgVarRefExp(is)); - ve->setSymbol((SgSymbol*) NULL); - //NODE_SYMB(ve->thellnd) = NULL; -} - -void ChangeArrayCoeff(SgSymbol *ar) -{ - - InsertNewStatementBefore(new SgAssignStmt(*coef_ref(ar,0),*sum_dvm),first_do_par); - -} - - -SgSymbol *CreateInitLoopVar(SgSymbol *dovar, SgSymbol *init) -{ - if(INIT_LOOP_VAR(dovar)) - return( *INIT_LOOP_VAR(dovar)); - else { - SgSymbol **s = new (SgSymbol *); - //creating new variable - *s = InitLoopSymbol(dovar,init->type()); - // adding the attribute (INIT_LOOP) to do-variable symbol - dovar->addAttribute(INIT_LOOP, (void*) s, sizeof(SgSymbol *)); - index_symb = AddToSymbList(index_symb,*s); - return(*s); - } -} - - -void ConsistentArrayList (SgExpression *el,SgExpression *gref, SgStatement *st, SgStatement *stmt1, SgStatement *stmt2) -{ SgStatement *last,*last1; - SgExpression *er, *ev, *header = NULL,*size_array; - int nr, ia=-1, sign, re_sign,renew_sign,iaxis,rank; - SgSymbol *var; -// SgValueExp c0(0),c1(1); - last = stmt2; last1 = stmt1; - //looking through the consistent array list - for(er = el; er; er=er->rhs()) { - ev = er->lhs(); // consistent array reference - var = ev->symbol(); - - /* if(st->variant() == DVM_CONSISTENT_GROUP_DIR){ - red_group_var_list=AddToSymbList(red_group_var_list,var); - if(loc_var->symbol()) - red_group_var_list =AddToSymbList(red_group_var_list,loc_var->symbol()); - } - else{ - new_red_var_list=AddToSymbList(new_red_var_list,var); - if(loc_var->symbol()) - new_red_var_list =AddToSymbList(new_red_var_list,loc_var->symbol()); - } - */ - - if(var) - ia = var->attributes(); - - if( isSgArrayRefExp(ev)) { - - if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT)) //06.12.12 - { Error("Illegal object '%s' in CONSISTENT clause ", var->identifier(), 399,st); - // Error("'%s' is distributed array", var->identifier(), 148,st); - continue; - } - - else if(!(ia & CONSISTENT_BIT) ) // 06.12.12 && !(ia & DISTRIBUTE_BIT) && !(ia & ALIGN_BIT) && !(ia & INHERIT_BIT)){ - { Error("Illegal object '%s' in CONSISTENT clause ", var->identifier(), 399,st); - continue; - } - - } else { - err("Illegal object in CONSISTENT clause ", 399,st); - //err("Wrong consistent array",151,st); //??? error number - continue; - } - - if(stmt1 != stmt2) - cur_st = last1; - - if(!only_debug) { - header = new SgArrayRefExp(*(CONSISTENT_HEADER(var)),*new SgValueExp(1)); //HeaderRef(var); - rank = Rank(var); - if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) /*ACC*/ - { int i; - for(i=0;isymbol(),rank+3+i) , Exprn( LowerBound(var,i))) ; - } - size_array = DVM000(ndvm); - - sign = 1; - re_sign = 0; // aligned array may not be redisributed - - // call crtraf (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, StaticSign, ReDistrSign, Memory) - - doCallAfter(CreateDvmArrayHeader(var, header, size_array, rank, sign, re_sign)); - where = cur_st; - doSizeFunctionArray(var,st); - cur_st = where; - } - - //if(debug_regim) { - // debgref = idebrg ? DVM000(idebrg) : DebReductionGroup(gref->symbol()); - // doAssignStmtAfter(D_InsRedVar(debgref,num_red,ev,ntype,ilen, loc_var, ilen+1,locindtype)); - //} - - last1 = cur_st; - - if(stmt1 != stmt2) - cur_st = last; - renew_sign = 0; //???? - if(!only_debug){ - iaxis = ndvm; - //insert array into consistent group - if(st->variant() == DVM_TASK_REGION_DIR){ - doAxisTask(st,ev); - //doAssignStmtAfter(IncludeConsistentTask(gref,header,DVM000(PS_INDEX(st->symbol())),iaxis,re_sign)); - doAssignStmtAfter(IncludeConsistentTask(gref,header,new SgVarRefExp(TASK_SYMBOL(st->symbol())),iaxis,re_sign)); - - } - else {//DVM_PARALLEL_ON_DIR - nr = doAlignIteration(st, ev); - doAssignStmtAfter(InsertConsGroup(gref,header,iplp,iaxis, iaxis+nr, iaxis+2*nr,re_sign)); - } - } - last = cur_st; - } - - return; -} - -void ConsistentArraysStart (SgExpression *el) -{ - SgExpression *er, *ev; - - //looking through the consistent array list - for(er = el; er; er=er->rhs()) { - ev = er->lhs(); // consistent array reference - - if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) { - doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ; - FREE_DVM(1); - } - } -} - -void Consistent_Task_Region(SgStatement *stmt) -{SgExpression *e; - SgStatement *st2, *st3; - - iconsgts=0; - consgrefts=NULL; - e=stmt->expr(1); - if(!e) return; - task_cons_list = e->lhs(); - if( e->symbol()){ - consgrefts = new SgVarRefExp(e->symbol()); - doIfForConsistent(consgrefts); - nloopcons++; - //stcg = doIfForCreateReduction( e->symbol(),nloopcons,0); - st2 = doIfForCreateReduction( consgrefts->symbol(),nloopcons,1); - //stcg = st2; - st3 = cur_st; - cur_st = st2; - ConsistentArrayList(task_cons_list,consgrefts,stmt,st2,st2); - cur_st = st3; - InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); - - } else { - iconsgts = ndvm; - consgrefts = DVM000(iconsgts); - doAssignStmtAfter(CreateConsGroup(1,1)); - //!!!??? if(debug_regim){ - // idebcg = ndvm; - // doAssignStmtAfter( D_CreateDebRedGroup()); - //} - //stcg = cur_st;//store current statement - ConsistentArrayList(task_cons_list,consgrefts,stmt,cur_st,cur_st); - } -} - -void EndConsistent_Task_Region(SgStatement *stmt) -{ - if(!stmt) return; - //LINE_NUMBER_AFTER(stmt,stmt); - // actualizing of consistent arrays - if(consgrefts) - ConsistentArraysStart(task_cons_list); - - if(!iconsgts) return; - - //there is synchronous CONSISTENT clause in TASK_REGION - // generating assign statement: - // dvm000(i) = strtcg(ConsistGroupRef) - doAssignStmtAfter(StartConsGroup(consgrefts)); - - // generating assign statement: - // dvm000(i) = waitcg(ConsistGroupRef) - doAssignStmtAfter(WaitConsGroup(consgrefts)); - - //if(idebcg){ - //if(dvm_debug) - // doAssignStmtAfter( D_CalcRG(DVM000(idebrg))); - //doAssignStmtAfter( D_DelRG (DVM000(idebrg))); - //} - - // generating statement: - // call dvmh_delete_object(ConsistGroupRef) //dvm000(i) = delobj(ConsistGroupRef) - doCallAfter(DeleteObject_H(consgrefts)); -} - -void doAxisTask(SgStatement *st, SgExpression *eref) -{int i,iaxis=-1; - SgExpression *el; - SgSymbol *ar; - ar = eref->symbol(); - for(el=eref->lhs(),i=0; el; el=el->rhs(),i++) - if(el->lhs()->variant() !=DDOT) - iaxis = i; - if(i != Rank(ar)) - Error("Rank of array '%s' isn't equal to the length of subscript list", ar->identifier(), 161,st); - doAssignStmtAfter(new SgValueExp(i-iaxis)); - return; -} - - -void TransBlockData(SgStatement *hedr,SgStatement* &end_of_unit) -{SgStatement* stmt; - end_of_unit = hedr->lastNodeOfStmt(); - for (stmt = hedr; stmt && (stmt != end_of_unit); stmt = stmt->lexNext()) - if(isSgVarDeclStmt(stmt)) VarDeclaration(stmt); - // analizing object list and replacing variant of declaration statement with initialisation by VAR_DECL_90 -} - -void VarDeclaration(SgStatement *stmt) -{ SgExpression *el; - int is_assign; - is_assign =0; - for(el=stmt->expr(0); el; el=el->rhs()) { - if(el->lhs()->variant() == ASSGN_OP || el->lhs()->variant() == POINTST_OP) is_assign = 1;//with initial value - } - if(is_assign && stmt->variant() == VAR_DECL && !stmt->expr(2)) - stmt->setVariant(VAR_DECL_90); - return; -} - -SgExpression *LeftMostField(SgExpression *e) -{SgExpression *ef; - ef = e; - while(ef->variant() == RECORD_REF) - ef = ef->lhs(); - return(ef); -} - -SgExpression *RightMostField(SgExpression *e) -{return(e->rhs());} - -SgStatement *InterfaceBlock(SgStatement *hedr) -{ SgStatement *stmt; - in_interface++; - for(stmt=hedr->lexNext(); stmt->variant()!=CONTROL_END; stmt=stmt->lexNext()) - { - if(stmt->variant() == FUNC_HEDR || stmt->variant() == PROC_HEDR) //may be module procedure statement - stmt = InterfaceBody(stmt); - else if(stmt->variant() != MODULE_PROC_STMT) - err("Misplaced directive/statement", 103, stmt); - } - //if(stmt->controlParent() != hedr) - // Error("Illegal END statement"); - - in_interface--; - return(stmt); -} - -SgStatement *InterfaceBody(SgStatement *hedr) -{ - SgStatement *stmt, *last, *dvm_pred; - symb_list *distsym; - SgSymbol *s = hedr->symbol(); - distsym = NULL; - dvm_pred = NULL; - - if (hedr->expr(2)) - { - if (hedr->expr(2)->variant() == PURE_OP) - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | PURE_BIT; - - else if (hedr->expr(2)->variant() == ELEMENTAL_OP) - SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | ELEMENTAL_BIT; - } - last = hedr->lastNodeOfStmt(); - - for(stmt=hedr->lexNext(); stmt; stmt=stmt->lexNext()) { - if(dvm_pred) - Extract_Stmt(dvm_pred); // deleting preceding DVM-directive - if(stmt == last) break; //end of interface body - dvm_pred = NULL; - - if (!isSgExecutableStatement(stmt)) {//is Fortran specification statement - - if(only_debug){ - if(isSgVarDeclStmt(stmt)) VarDeclaration(stmt);// for analizing object list and replacing variant of statement - continue; - } - //discovering distributed arrays in COMMON-blocks - if(stmt->variant()==COMM_STAT) { - - DeleteShapeSpecDAr(stmt); - if( !DeleteHeapFromList(stmt) ) { //common list is empty - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); //deleting the statement - } - continue; - } - - // deleting distributed arrays from variable list of declaration - // statement and testing are there any group names - if( isSgVarDeclStmt(stmt) || isSgVarListDeclStmt(stmt)) { - - if( !DeleteDArFromList(stmt) ) { //variable list is empty - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); //deleting the statement - } - continue; - } - - if(stmt->variant() == STMTFN_STAT) { - if(stmt->expr(0) && stmt->expr(0)->symbol() && ((!strcmp(stmt->expr(0)->symbol()->identifier(),"number_of_processors")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_rank")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_size")))){ - stmt=stmt->lexPrev(); - stmt->lexNext()->extractStmt(); - //deleting the statement-function declaration named - // NUMBER_OF_PROCESSORS or PROCESSORS_RANK or PROCESSORS_SIZE - } - continue; - } - - if (stmt->variant() == ENTRY_STAT) { - warn("ENTRY among specification statements", 81,stmt); - continue; - } - - if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR){ - stmt=InterfaceBlock(stmt); - continue; - } - - if(stmt->variant() == STRUCT_DECL){ - stmt=stmt->lastNodeOfStmt(); - continue; - } - - if( stmt->variant() == USE_STMT || stmt->variant() == DATA_DECL) - continue; - - continue; - } // end of if(!isSgExecutable... - - if ((stmt->variant() == FORMAT_STAT)) - continue; - -// processing the DVM Specification Directives - - switch(stmt->variant()) { - - case (DVM_VAR_DECL): - { SgExpression *el; - int eda; - eda = 0; - for(el = stmt->expr(2); el; el=el->rhs()) // looking through the attribute list - switch(el->lhs()->variant()) { - case (ALIGN_OP): - case (DISTRIBUTE_OP): - eda = 1; - break; - default: - break; - } - if(eda == 0){ - dvm_pred = stmt; - continue; - } - } - case (DVM_INHERIT_DIR): - case (DVM_ALIGN_DIR): - case (DVM_DISTRIBUTE_DIR): - { - SgExpression *sl; - for(sl=stmt->expr(0); sl; sl=sl->rhs()) //scanning the alignees list - if(!IS_POINTER(sl->lhs()->symbol())) - distsym = AddNewToSymbList(distsym,sl->lhs()->symbol()); - } - dvm_pred = stmt; - continue; - case (ACC_ROUTINE_DIR): - ACC_ROUTINE_Directive(stmt); - dvm_pred = stmt; - continue; - - case (HPF_TEMPLATE_STAT): - case (HPF_PROCESSORS_STAT): - case (DVM_DYNAMIC_DIR): - case (DVM_SHADOW_DIR): - case (DVM_TASK_DIR): - case (DVM_CONSISTENT_DIR): - case (DVM_INDIRECT_GROUP_DIR): - case (DVM_REMOTE_GROUP_DIR): - case (DVM_CONSISTENT_GROUP_DIR): - case (DVM_REDUCTION_GROUP_DIR): - case (DVM_POINTER_DIR): - case (DVM_HEAP_DIR): - case (DVM_ASYNCID_DIR): - case (ACC_DECLARE_DIR): - dvm_pred = stmt; - default: - continue; - } - - break; - } //end of loop - - if(!only_debug) - DeclareVarDVMForInterface(stmt->lexPrev(),distsym); - return(stmt); -} - -void DeleteShapeSpecDAr(SgStatement *stmt) -{ - SgExpression *ec, *el; - SgSymbol *sc; - for(ec=stmt->expr(0); ec; ec=ec->rhs()) // looking through COMM_LIST - for(el=ec->lhs(); el; el=el->rhs()) { - sc = el->lhs()->symbol(); - if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) ) - el->lhs()->setLhs(NULL); - if(sc && !in_interface) { - SYMB_ATTR(sc->thesymb)= SYMB_ATTR(sc->thesymb) | COMMON_BIT; - if((debug_regim || IN_MAIN_PROGRAM) && IS_ARRAY(sc) ) - registration = AddNewToSymbList( registration, sc); - - if( !strcmp(sc->identifier(),"heap")) - heap_ar_decl = new SgArrayRefExp(*heapdvm); - } - if(sc && (sc->attributes() & TEMPLATE_BIT)) - Error("Template '%s' is in COMMON",sc->identifier(),79,stmt); - } -} - -void DeclareVarDVMForInterface(SgStatement *lstat, symb_list *distsymb) -{symb_list *save; - if(!distsymb) return; - save = dsym; //save global variable 'dsym' - list of distributed arrays for procedure - dsym = distsymb; - DeclareVarDVM(lstat,lstat); - dsym = save; //resave global variable 'dsym' -} - -SgExpression *DVMVarInitialization(SgExpression *es) -{SgExpression *einit, *er; - switch(es->symbol()->variant()) { //initialization expression - case ASYNC_ID: einit = new SgValueExp(1); //new SgExpExpression(CONSTRUCTOR_REF); //SgConstExp - break; - default: einit = new SgValueExp(0); - break; - } - er = new SgExpression(ASSGN_OP,es,einit,NULL); - return(er); -} - -SgExpression *FileNameInitialization(SgExpression *es,char *name) -{SgExpression *einit, *er; - einit = new SgExpression(CONCAT_OP,new SgValueExp(name),CHARFunction(0),NULL); - er = new SgExpression(ASSGN_OP,es,einit,NULL); - return(er); -} - -SgStatement *CreateModuleProcedure(SgStatement *mod_hedr, SgStatement *lst, SgStatement* &has_contains) - { mod_attr *attrmod; - SgStatement *last; - SgStatement *st_end ; - SgStatement *st; - SgSymbol *smod; - - attrmod = new mod_attr; - attrmod->symb = NULL; - mod_hedr->symbol()->addAttribute(MODULE_STR, (void *) attrmod, sizeof(mod_attr)); - - // if(mod_hedr->lexNext()->variant() != USE_STMT && !dsym && !task_symb && !proc_symb) - // return(NULL); - - smod = new SgSymbol(PROCEDURE_NAME, ModuleProcName(mod_hedr->symbol()), *mod_hedr); - attrmod->symb = smod; - st = new SgStatement(PROC_HEDR); - st->setSymbol(*smod); - st_end = new SgStatement(CONTROL_END); - - if(lst->variant() != CONTAINS_STMT) { - last = new SgStatement(CONTAINS_STMT); - lst-> insertStmtBefore(*last); - } else - last = lst; - has_contains = last; - //last = (lst->variant() == CONTAINS_STMT) ? lst->lexNext() : lst; - last->insertStmtAfter(*st); - st->insertStmtAfter(*st_end); - return(st); - } - -void GenForUseStmts(SgStatement *hedr,SgStatement *where_st) -{SgStatement *stmt; - for(stmt=hedr->lexNext();stmt->variant() == USE_STMT;stmt=stmt->lexNext()){ - GenCallForUSE(stmt,where_st); - /* - if(!(stmt->expr(0))) - GenCallForUSE(stmt,where_st); - else if(stmt->expr(0)->variant() == ONLY_NODE) - GenForUseList(stmt->expr(0)->lhs(),stmt,where_st); - else { - GenForUseList(stmt->expr(0),stmt,where_st); - GenCallForUSE(stmt,where_st); - } - */ - } - -} - -void GenForUseList(SgExpression *ul,SgStatement *stmt, SgStatement *where_st) -{SgExpression *el, *e; - - for(el=ul; el; el=el->rhs()){ - e = el->lhs(); - if(e->variant() == RENAME_NODE){ - e = e->lhs(); //new symbol reference - } - if(!only_debug && IS_DVM_ARRAY(e->symbol())) - GenDVMArray(e->symbol(),stmt,where_st); - if(debug_regim && IS_ARRAY(e->symbol())) - Registrate_Ar(e->symbol()); - } -} - -void GenDVMArray(SgSymbol *ar, SgStatement *stmt, SgStatement *where_st) -{SgStatement *savest; -//SgExpression *dce; -// SgArrayType *artype; - savest = where; - where = where_st; - //generating - - /* - dce = new SgArrayRefExp(*ar); - artype = isSgArrayType(ar->type()); - dce->setLhs(artype->getDimList()->copy()); - - if(ar->attributes() & POINTER_BIT) - AllocatePointerHeader(ar,where_st); - */ - if( IS_POINTER(ar) || (IN_COMMON(ar) && (ar->scope()->variant() != PROG_HEDR)) || IS_ALLOCATABLE_POINTER(ar)) - return; - if(ar->attributes() & DISTRIBUTE_BIT) { - //determine corresponding DISTRIBUTE statement - SgStatement *dist_st = *(DISTRIBUTE_DIRECTIVE(ar)); - //create distributed array - int idis; - SgExpression *distr_rule_list = doDisRules(dist_st,0,idis); - SgExpression *ps = PSReference(dist_st); - GenDistArray(ar,idis,distr_rule_list,ps,dist_st); - } - - else if(ar->attributes() & ALIGN_BIT) { - //create aligned array - int nr,iaxis; - algn_attr * attr; - align * root, *node,*node_copy, *root_copy = NULL; - SgStatement *algn_st; - SgSymbol *base; - attr = (algn_attr *) ORIGINAL_SYMBOL(ar)->attributeValue(0,ALIGN_TREE); - node = attr->ref; // reference to root of align tree - node_copy = new align; - node_copy->symb = ar; - node_copy->align_stmt = node->align_stmt; - algn_st = node->align_stmt; - if(!algn_st->expr(2)) //postponed aligning - root = NULL; - else { - base = (algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs()->symbol() : (algn_st->expr(2))->symbol();// align_base symbol - root = ((algn_attr *) ORIGINAL_SYMBOL(base)->attributeValue(0,ALIGN_TREE))->ref; - root_copy = new align; - root_copy->symb = Rename(base,stmt); - root_copy->align_stmt = root->align_stmt; - } - iaxis = ndvm; - SgExpression *align_rule_list = doAlignRules(ar,node->align_stmt,0,nr);// creating axis_array, coeff_array and const_array - GenAlignArray(node_copy,root_copy, nr, align_rule_list, iaxis); - /* AllocateAlignArray(ar,dce,stmt);*/ - } - loc_distr = 0; - pointer_in_tree = 0; - where = savest; -} - -SgSymbol *Rename(SgSymbol *ar, SgStatement *stmt) -{SgExpression *el, *e, *eold; - - for(el=stmt->expr(0);el;el=el->rhs()){ - e = el->lhs(); eold = NULL; - if(e->variant() == RENAME_NODE){ - e = e->lhs(); //new symbol reference - eold = el->lhs()->rhs(); //old symbol reference - } -// if(eold && ORIGINAL_SYMBOL(eold->symbol()) == ORIGINAL_SYMBOL(ar)) - if(eold && !strcmp(eold->symbol()->identifier(),ar->identifier())) - return(e->symbol()); - } - return(ar); -} - -void AddAttributeToLastElement(SgExpression *use_list) -{ - SgExpression *el = use_list; - while(el && el->rhs()) - el = el->rhs(); - el->addAttribute(END_OF_USE_LIST, (void*) 1, 0); -} - -void UpdateUseListWithDvmArrays(SgStatement *use_stmt) -{ - SgExpression *el, *coeff_list=NULL; - SgExpression *use_list = use_stmt->expr(0); - SgSymbol *s,*sloc; - int i,r,i0; - i0 = opt_base ? 1 : 2; - if(opt_loop_range) i0=0; - - if(use_list && use_list->variant()==ONLY_NODE) - use_list = use_list->lhs(); - if(use_list) - AddAttributeToLastElement(use_list); - for(el=use_list; el; el=el->rhs()) - { - // el->lhs()->variant() is RENAME_NODE - sloc = el->lhs()->lhs()->symbol(); // local symbol - if(!IS_DVM_ARRAY(sloc)) continue; - r = Rank(sloc); - if(el->lhs()->rhs()) // use symbol reference in renaming_op: local_symbol=>use_symbol - { - s = el->lhs()->rhs()->symbol(); //use symbol - if(strcmp(sloc->identifier(),s->identifier())) // different names - { - // creating variables used for optimisation array references in parallel loop (linearization coefficients) - coeffs *c_new = new coeffs; - CreateCoeffs(c_new,sloc); - // adding the attribute (ARRAY_COEF) to distributed array symbol - sloc->addAttribute(ARRAY_COEF, (void*) c_new, sizeof(coeffs)); - // add renaming_op for all coefficients (2:rank+2) to use_list: coeff_of_sloc=>coeff_of_s - coeffs *c_use = AR_COEFFICIENTS(s); - for(i=i0;i<=r+2;i++) - if(i != r+1) - { - SgExpression *rename = new SgExpression(RENAME_NODE, new SgVarRefExp(c_new->sc[i]), new SgVarRefExp(c_use->sc[i]), NULL); - coeff_list = AddListToList(coeff_list,new SgExprListExp(*rename)); - } - } - } else - { - // add cofficients of use_symbol to use_list - s = el->lhs()->symbol(); //use symbol - coeffs *c_use = AR_COEFFICIENTS(s); - for(i=i0;i<=r+2;i++) - if(i != r+1) - coeff_list = AddListToList(coeff_list,new SgExprListExp(*new SgVarRefExp(c_use->sc[i]))); - } - } - if(coeff_list) - AddListToList(use_list,coeff_list); -} - -void updateUseStatementWithOnly(SgStatement *st_use, SgSymbol *s_func) -{ // add name of s_func to only-list of USE statement - SgExpression *clause = st_use->expr(0); - if(clause && clause->variant() == ONLY_NODE) - { - SgExpression *el = new SgExprListExp(*new SgVarRefExp(s_func)); - if(clause->lhs()) // only-list is not empty - AddListToList(clause->lhs(), el); - else - clause->setLhs(el); - } -} - -void GenCallForUSE(SgStatement *hedr,SgStatement *where_st) -{SgSymbol *smod; - SgStatement *call; - mod_attr *attrm; - smod = hedr->symbol(); - if((attrm=DVM_PROC_IN_MODULE(smod)) && attrm->symb){ - call = new SgCallStmt(*attrm->symb); - where_st->insertStmtBefore(*call); - updateUseStatementWithOnly(hedr,attrm->symb); // add dvm-module-procedure name to only-list - } -} - -SgStatement *MayBeDeleteModuleProc(SgStatement *mod_proc,SgStatement *end_mod) -{ mod_attr *attrm; - //mod_proc->unparsestdout(); - //printf("-----%d %d\n",end_mod->lexPrev()->variant(),end_mod->variant()); end_mod->unparsestdout(); - if(!isSgExecutableStatement(end_mod->lexPrev()) || mod_proc->lexNext()==end_mod ) {// there are not executable statements in module procedure - attrm=DVM_PROC_IN_MODULE(cur_func->symbol()) ; - attrm->symb=NULL; // deleting module procedure reference in attribute - //deleting module procedure - //for(stmt=mod_proc->lexNext(),prev=mod_proc; stmt!=end_mod->lexNext(); stmt=stmt->lexNext()) - //{ prev->extractStmt(); prev = stmt; } - //end_mod->extractStmt(); - //return(NULL); - } - return(mod_proc); -} - -int TestDVMDirectivesInModule(stmt_list *pstmt) -{stmt_list *stmt; - int flag; - flag = 0; - for(stmt=pstmt; stmt; stmt=stmt->next) { - switch(stmt->st->variant()) { - //case HPF_TEMPLATE_STAT: - case DVM_ALIGN_DIR: - case DVM_DISTRIBUTE_DIR: - case HPF_PROCESSORS_STAT: - case DVM_VAR_DECL: - case DVM_TASK_DIR: - flag = 1; - break; - default: - break; - } - } - return(flag); -} - -int TestDVMDirectivesInProcedure(stmt_list *pstmt) -{stmt_list *stmt; - for(stmt=pstmt; stmt; stmt=stmt->next) { - if(stmt->st->variant() != DVM_INHERIT_DIR) - return( 1 ); - } - return ( 0 ); -} - -int TestUseStmts() -{SgStatement *stmt; - mod_attr *attrm; - int flag; - flag =0; - //looking through the USE statements - for(stmt=cur_func->lexNext();stmt->variant() == USE_STMT;stmt=stmt->lexNext()){ - if((attrm=DVM_PROC_IN_MODULE(stmt->symbol())) && attrm->symb) //module has DVM-module-procedure - flag =1; - } - return(flag); -} - -int ArrayAssignment(SgStatement *stmt) -{ - if(isSgArrayRefExp(stmt->expr(0)) || isSgArrayType(stmt->expr(0)->type())) - return(1); - else - return(0); -} - -int DVMArrayAssignment(SgStatement *stmt) -{ - if(HEADER(stmt->expr(0)->symbol()) && isSgArrayType(stmt->expr(0)->type())) - return(1); - else - return(0); -} - -void MakeSection(SgExpression *are) -{int n; - SgArrayRefExp *ae; - if(!(ae=isSgArrayRefExp(are))) return; - for(n = Rank(are->symbol()); n; n--) - ae->addSubscript(*new SgExpression(DDOT)); -} - -void DistributeArrayList(SgStatement *stdis) -{SgExpression *el; - SgSymbol *das; - SgStatement **dst = new (SgStatement *); - - *dst = stdis; - for(el=stdis->expr(0); el; el=el->rhs()){ - das = el->lhs()->symbol(); - das->addAttribute(DISTRIBUTE_, (void *) dst, sizeof(SgStatement *)); - if(das->attributes() & EQUIVALENCE_BIT) - Error("DVM-array cannot be specified in EQUIVALENCE statement: %s", das->identifier(),341,stdis); - } -} - -SgExpression *DebugIfCondition() -{ if(!dbif_cond) - dbif_cond=&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(1)); - return(dbif_cond); -} -/* -SgExpression *DebugIfCondition() -{return(&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(1)));} -*/ - -SgExpression *DebugIfNotCondition() -{ if(!dbif_not_cond) - dbif_not_cond=&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(0)); - return(dbif_not_cond); -} -/* -SgExpression *DebugIfNotCondition() -{return(&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(0)));} -*/ - -SgStatement *LastStatementOfDoNest(SgStatement *first_do) -{SgStatement *last; - last=first_do->lastNodeOfStmt(); - if(last->variant() == FOR_NODE || last->variant() == WHILE_NODE ) - last=LastStatementOfDoNest(last); - - return(last); -} - -void TranslateBlock (SgStatement *stat) -{ - TranslateFromTo(stat,lastStmtOf(stat),0); //0 - without error messages -} - -/* -void TranslateBlock (SgStatement *stat) -SgStatement *stmt, *last, *next; -// last is the statement following last statement of block - - last = lastStmtOf(stat); //podd 03.06.14 stat->lastNodeOfStmt(); - //if (last->variant() == LOGIF_NODE) - // last =last->lexNext(); - //last =last->lexNext(); -*/ - -void TranslateFromTo(SgStatement *first, SgStatement *last, int error_msg) -//TranslateBlock (SgStatement *stat) -{SgStatement *stmt, *out, *next; - SgLabel *lab_on; - SgStatement *in_on = NULL; - char io_modes_str[4] = "\0"; - out =last->lexNext(); - if(only_debug) goto SEQ_PROG; - - for(stmt=first; stmt!=out; stmt=next) { - cur_st = stmt; //printf("TranslateBlock %d %d\n",stmt->lineNumber(), stmt->variant()); - next = stmt->lexNext(); - switch(stmt->variant()) { - case CONTROL_END: - case CONTAINS_STMT: - case RETURN_STAT: - case STOP_STAT: - case PAUSE_NODE: - case ENTRY_STAT: - break; - - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case WHILE_NODE: // DO WHILE (...) - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - ChangeDistArrayRef(stmt->expr(0)); - break; - - case LOGIF_NODE: // Logical IF - - ChangeDistArrayRef(stmt->expr(0)); - break; //continue; // to next statement - - case FORALL_STAT: // FORALL statement - //stmt=stmt->lexNext(); // statement that is a part of FORALL statement - break; - // continue; - - case GOTO_NODE: // GO TO - break; - - case COMGOTO_NODE: // Computed GO TO - ChangeDistArrayRef(stmt->expr(1)); - break; - - case ASSIGN_STAT: // Assign statement - if(IN_COMPUTE_REGION && !inparloop && !in_on) /*ACC*/ - TestDvmObjectAssign(stmt); - ChangeDistArrayRef_Left(stmt->expr(0)); // left part - ChangeDistArrayRef(stmt->expr(1)); // right part - break; - - case PROC_STAT: // CALL - {SgExpression *el; - int i; - // looking through the arguments list - for(el=stmt->expr(0), i=0; el; el=el->rhs(), i++) - ChangeArg_DistArrayRef(el, stmt->symbol(), i); // argument - } - break; - - case ALLOCATE_STMT: - if(!IN_COMPUTE_REGION) - { AllocatableArrayRegistration(stmt); - //stmt=cur_st; - } - break; - - case DEALLOCATE_STMT: - break; - - case DVM_IO_MODE_DIR: - IoModeDirective(stmt,io_modes_str,error_msg); - Extract_Stmt(stmt); // extracting DVM-directive - break; - - case OPEN_STAT: - Open_Statement(stmt,io_modes_str,error_msg); - break; - case CLOSE_STAT: - Close_Statement(stmt,error_msg); - break; //continue; - case INQUIRE_STAT: - Inquiry_Statement(stmt,error_msg); - break; - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - FilePosition_Statement(stmt, error_msg); - break; - case WRITE_STAT: - case READ_STAT: - ReadWrite_Statement(stmt, error_msg); - break; - case PRINT_STAT: - Any_IO_Statement(stmt); - ReadWritePrint_Statement(stmt, error_msg); - break; - case DVM_CP_CREATE_DIR: /*Check Point*/ - CP_Create_Statement(stmt, error_msg); - break; - case DVM_CP_SAVE_DIR: - CP_Save_Statement(stmt, error_msg); - break; - case DVM_CP_LOAD_DIR: - CP_Load_Statement(stmt, error_msg); - break; - case DVM_CP_WAIT_DIR: - CP_Wait(stmt, error_msg); - break; /*Check Point*/ - case FOR_NODE: - ChangeDistArrayRef(stmt->expr(0)); - ChangeDistArrayRef(stmt->expr(1)); - break; - case DVM_ON_DIR: - if(stmt->expr(0)->symbol() && HEADER(stmt->expr(0)->symbol())) - in_on = stmt; - break; - case DVM_END_ON_DIR: - if(in_on) - { - ReplaceOnByIf(in_on,stmt); - Extract_Stmt(in_on); // extracting DVM-directive (ON) - in_on = NULL; - } - Extract_Stmt(stmt); // extracting DVM-directive (END_ON) - - break; - default: - break; - } - } - return; /* podd 07.06.11*/ - -SEQ_PROG: - for(stmt=first; stmt!=out ; stmt=stmt->lexNext()) { - cur_st = stmt; - switch(stmt->variant()) { - case ALLOCATE_STMT: - AllocatableArrayRegistration(stmt); - stmt=cur_st; - break; - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - if(perf_analysis) - stmt = Any_IO_Statement(stmt); - break; - - default: - break; - } - } - -} - -SgStatement *CreateCopyOfExecPartOfProcedure() -{ - if(!debug_regim || dbg_if_regim <= 1) return(NULL); - - return( cur_func->copyPtr() ); -} - - -void InsertCopyOfExecPartOfProcedure(SgStatement *stc) -{ SgStatement *stmt, *stend, *ifst, *cur; - // cur = new SgStatement(DVM_DEBUG_DIR); - ifst = new SgIfStmt(*DebugIfNotCondition(), *new SgStatement(CONT_STAT)); - first_exec->insertStmtBefore(*ifst,*first_exec->controlParent()); - stend=stc->lastNodeOfStmt(); - stmt = stend->lexPrev(); - if(stmt->variant()!=RETURN_STAT) - stmt->insertStmtAfter(*new SgStatement(RETURN_STAT),*stend->controlParent()); - - for(stmt=stc; !isSgExecutableStatement(stmt); stmt=stmt->lexNext()) - {;} - - cur = ifst->lexNext(); - cur->insertStmtAfter(*stmt); - cur->extractStmt(); - TranslateBlock(ifst); - - // for(stmt=first_exec; stmt != stend; stmt=stmt->nextInChildList()) - //stmt=BLOB_VALUE(BLOB_NEXT(BIF_BLOB1(stmt->thebif))) - // { stc = stmt->copyPtr(); -} - -int lookForDVMdirectivesInBlock(SgStatement *first,SgStatement *last,int contains[] ) -{ SgStatement *stmt; - int dvm_dir=0; - contains[0]=0; - contains[1]=0; - for(stmt=first; stmt ; stmt=stmt->lexNext()) { - switch(stmt->variant()) { - case CONTAINS_STMT: - case ENTRY_STAT: - contains[0]=1; - goto END__; - break; - - case DVM_PARALLEL_ON_DIR: - - case DVM_ASYNCHRONOUS_DIR: - case DVM_ENDASYNCHRONOUS_DIR: - case DVM_REDUCTION_START_DIR: - case DVM_REDUCTION_WAIT_DIR: - case DVM_SHADOW_GROUP_DIR: - case DVM_SHADOW_START_DIR: - case DVM_SHADOW_WAIT_DIR: - case DVM_REMOTE_ACCESS_DIR: - case DVM_NEW_VALUE_DIR: - case DVM_REALIGN_DIR: - case DVM_REDISTRIBUTE_DIR: - case DVM_ASYNCWAIT_DIR: - case DVM_F90_DIR: - case DVM_CONSISTENT_START_DIR: - case DVM_CONSISTENT_WAIT_DIR: - - case DVM_INTERVAL_DIR: - case DVM_ENDINTERVAL_DIR: - case DVM_OWN_DIR: - case DVM_DEBUG_DIR: - case DVM_ENDDEBUG_DIR: - case DVM_TRACEON_DIR: - case DVM_TRACEOFF_DIR: - case DVM_BARRIER_DIR: - case DVM_CHECK_DIR: - - case DVM_TASK_REGION_DIR: - case DVM_END_TASK_REGION_DIR: - case DVM_ON_DIR: - case DVM_END_ON_DIR: - case DVM_MAP_DIR: - case DVM_RESET_DIR: - case DVM_PREFETCH_DIR: - case DVM_PARALLEL_TASK_DIR: - case DVM_IO_MODE_DIR: - case DVM_LOCALIZE_DIR: - case DVM_SHADOW_ADD_DIR: - case DVM_TEMPLATE_CREATE_DIR: - case DVM_TEMPLATE_DELETE_DIR: - dvm_dir = 1; - break; - - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - contains[1]=1; - break; - default: - if(isACCdirective(stmt)) /*ACC*/ - dvm_dir = 1; - break; - } - if(stmt == last) break; - } -END__: - return(dvm_dir); -} - -int IsGoToStatement(SgStatement *stmt) -{int vrnt; - vrnt=stmt->variant(); - return(vrnt==GOTO_NODE || vrnt==COMGOTO_NODE || vrnt==ARITHIF_NODE); -} - -void CopyDvmBegin(SgStatement *entry, SgStatement *first_dvm_exec, SgStatement *last) -{ SgStatement *stmt, *current, *cpst; - current = entry; - for(stmt=first_dvm_exec->lexNext(); stmt && stmt != last; stmt=stmt->lexNext()) - { - cpst = &(stmt->copy()); - current->insertStmtAfter(*cpst); - current = cpst; - } -} - -void DoStmtsForENTRY(SgStatement *first_dvm_exec, SgStatement *last_dvm_entry) -{stmt_list *stl; - for(stl=entry_list; stl; stl=stl->next) - CopyDvmBegin(stl->st,first_dvm_exec,last_dvm_entry); -} - -void UnparseFunctionsOfFile(SgFile *f,FILE *fout) -{ - SgStatement *stat,*stmt; - //int i,numfun; - //int i; - //i=0; - //printf("Unparse Functions\n"); -// grab the first statement in the file. - stat = f->firstStatement(); // file header - //numfun = f->numberOfFunctions(); // number of functions - // function is program unit accept BLOCKDATA and MODULE (F90),i.e. - // PROGRAM, SUBROUTINE, FUNCTION - // for(i = 0; i < numfun; i++) { - // func = f -> functions(i); - for( stmt=stat->lexNext();stmt;stmt=stmt->lexNext()) - { //printf("function %d: %s \n", i++,stmt->symbol()->identifier()); - fprintf(fout,"%s",UnparseBif_Char(stmt->thebif,FORTRAN_LANG)); //or C_LANG - //printf("end function %d \n", i); - //i++; - stmt=stmt->lastNodeOfStmt(); - } -} - -void StructureProcessing(SgStatement *stmt) -{ SgStatement *st,*vd, *next_st; - - next_st=stmt->lexNext(); - while(next_st) - { st = next_st; - //printf("%d",st->lineNumber()); - next_st=next_st->lexNext(); - //printf(" : %d\n",next_st->lineNumber()); - switch(st->variant()) - { case(VAR_DECL): - if(only_debug) - { - VarDeclaration(st); - break; - } - vd=st; - while(vd) - vd=ProcessVarDecl(vd); - break;; - case(CONTROL_END): - return; - case(DVM_SHADOW_DIR): - {SgExpression *el; - SgExpression **she = new (SgExpression *); - SgSymbol *ar; - int nw=0; - if(only_debug) - { - st->extractStmt(); - break; - } - // calculate lengh of shadow_list - for(el = st->expr(1); el; el=el->rhs()) - nw++; - *she = st->expr(1); - for(el = st->expr(0); el; el=el->rhs()){ // array name list - ar = el->lhs()->symbol(); //array name - ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); - if (nw!=Rank(ar)) // wrong shadow width list - Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88, st); - } - st->extractStmt(); - break; - - } - - case(DVM_DISTRIBUTE_DIR): - if( !only_debug && (st->expr(1) || st->expr(2))) - err("Only a distribute-directive of kind DISTRIBUTE:: is permitted in a derived type definition",337,st); - st->extractStmt(); - break; - - case(DVM_ALIGN_DIR): - if(!only_debug && (st->expr(1) || st->expr(2))) - err("Only an align-directive of kind ALIGN:: is permitted in a derived type definition",337,st); - st->extractStmt(); - break; - - case(DVM_VAR_DECL): - { SgExpression *el; - if(only_debug) - { - st->extractStmt(); - break; - } - - for(el = st->expr(2); el; el=el->rhs()) // attribute list - switch(el->lhs()->variant()) { - case (ALIGN_OP): - if(el->lhs()->lhs() || el->lhs()->rhs()) - err("Only an align-directive of kind ALIGN:: is permitted in a derived type definition",337,st); - break; - case (DISTRIBUTE_OP): - if(el->lhs()->lhs() || el->lhs()->rhs()) - err("Only a distribute-directive of kind DISTRIBUTE:: is permitted in a derived type definition",337,st); - break; - case (SHADOW_OP): - {SgExpression *eln; - SgExpression **she = new (SgExpression *); - SgSymbol *ar; - int nw=0; - // calculate lengh of shadow_list - for(eln = el->lhs()->lhs() ; eln; eln=eln->rhs()) - nw++; - *she = el->lhs()->lhs(); //shadow specification - for(eln = st->expr(0); eln; eln=eln->rhs()){ // array name list - ar = eln->lhs()->symbol(); //array name - ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); - if (nw!=Rank(ar)) // wrong shadow width list - Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88,st); - } - break; - } - case (DYNAMIC_OP): - default: - break; - } - st->extractStmt(); - break; - } - case(DVM_DYNAMIC_DIR): - st->extractStmt(); - break; - default: - break; - } - } - -} - -SgStatement *ProcessVarDecl(SgStatement *vd) -{ SgExpression *el, *elb, *e, *e2; - SgSymbol *s; - SgType *t; - SgStatement *std; - int ia; - el=vd->expr(0); - elb=NULL; - while(el) - { - s = el->lhs()->symbol(); - if(!s) s=el->lhs()->lhs()->symbol(); // there is initialisation:POINTST_OP/ASSGN_OP - if(!s) return(NULL); - ia = s->attributes(); - if(!(ia & DISTRIBUTE_BIT) && !(ia & ALIGN_BIT)) - { elb=el; - el=el->rhs(); - } else - break; - } - if(!el) - { - VarDeclaration(vd); - return(NULL); - } - if(elb) - { elb->setRhs(NULL); - std = &(vd->copy()); - std->setExpression(0,*vd->expr(0)); - vd->insertStmtBefore(*std); - VarDeclaration(std); - } - - if(!(ia & POINTER_BIT)) - //Error("Inconsistent declaration of identifier '%s'",s->identifier(),16,vd); - Warning("DISTRIBUTE or ALIGN attribute dictates POINTER attribute '%s'",s->identifier(),336,vd); - //create new statement for s and insert before statement vd - // new SgVarDeclStmt(SgExpression &varRefValList, SgExpression &attributeList, SgType &type); - e = el->lhs()->symbol() ? el->lhs() : el->lhs()->lhs(); - e=new SgExprListExp(e->copy()); - e->lhs()->setLhs(new SgExpression(DDOT)); - //e->setRhs(NULL); - e2= new SgExprListExp(*new SgExpression(POINTER_OP)); - if(len_DvmType) - { SgExpression *le; - le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(len_DvmType)); - t = new SgType(T_INT, le, SgTypeInt()); - - } else - t = SgTypeInt(); - - std = new SgVarDeclStmt(*e,*e2,*t); - vd->insertStmtBefore(*std); - if(el->rhs()) - { vd->setExpression(0,*(el->rhs())); - return(vd); - } else - { vd->extractStmt(); - return(NULL); - } -} - -void MarkCoeffsAsUsed() -{ symb_list *sl; - coeffs * c; - for(sl=dsym; sl; sl=sl->next) - { c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); - c->use = 1; - } -} - -int isInternalOrModuleProcedure(SgStatement *header_st) -{ - if((header_st->variant()==FUNC_HEDR || header_st->variant()==PROC_HEDR) && - (header_st->controlParent()->variant() == MODULE_STMT || header_st->controlParent()->variant() != GLOBAL) ) - return 1; - else - return 0; - -} - -int TestMaxDims(SgExpression *list, SgSymbol *ar, SgStatement *stmt) -{ - int ndim = 0; - SgExpression *el; - for( el=list; el; el=el->rhs()) - ndim++; - if(ndim>MAX_DIMS) - { - if(stmt) - Error("Too many dimensions specified for '%s'",ar->identifier(),43,stmt); - return 0; - } - else - return 1; -} - - -void AnalyzeAsynchronousBlock(SgStatement *dir) -{ - SgStatement *st,*end_dir=NULL, *stmt; - int contains[2]; - int f90_dir_flag = 0; - if(dir->lexNext()->variant()==DVM_F90_DIR ) - f90_dir_flag = 1; - - SgStatement *end_of_func = cur_func->lastNodeOfStmt(); - st = dir->lexNext(); - while(st != end_of_func) - { - if(st->variant() == DVM_ENDASYNCHRONOUS_DIR) - { - end_dir = st; - break; - } - else - st = st->lexNext(); - } - if(!end_dir) - { - err("Missing END ASYNCHRONOUS directive", 108, st); - return; - } - - st = dir->lexNext(); - - if(f90_dir_flag) - { - while (st->variant() == DVM_F90_DIR) - st = st->lexNext(); - if(!lookForDVMdirectivesInBlock(st, end_dir, contains ) || contains[0] || contains[1]) - err("ASYNCHRONOS_ENDASYNCHRONOUS block contains illegal dvm-directive/statement", 901, dir); - - stmt = st; - while(stmt != end_dir) - { - st = stmt; - stmt = lastStmtOf(stmt)->lexNext(); - st->extractStmt(); - } - } - else - { - for(; st != end_dir; st=st->lexNext() ) - if(st->variant() != ASSIGN_STAT || !isSgArrayRefExp(st->expr(0)) || !isSgArrayRefExp(st->expr(1))) - err("Illegal statement/directive in ASYNCHRONOS_ENDASYNCHRONOUS block", 901, st); - } - return; -} - -void Renaming(char *name, SgSymbol *s) -{ - SYMB_IDENT(s->thesymb) = name; -} - -void AddRenameNodeToUseList(SgSymbol *s) -{ - SgSymbol *smod = ORIGINAL_SYMBOL(s)->scope()->symbol(); //module symbol - SgStatement *st, *st_use=NULL, *st_use_only=NULL; - SgExpression *el_use_only=NULL; - for(st=cur_func->lexNext(); st->variant()==USE_STMT; st=st->lexNext()) - { - if(st->symbol() != smod) - continue; - if(!st->expr(0)) - { - st_use = st; - continue; - } - SgExpression *el=st->expr(0); - if(el->variant()==ONLY_NODE) - for(el = el->lhs(); el; el=el->rhs()) - { - if(el->lhs()->symbol() && el->lhs()->symbol()==ORIGINAL_SYMBOL(s)) - { - st_use_only = st; el_use_only=el; - break; - } - } - else - st_use = st; - } - SgExpression *er = new SgExpression(RENAME_NODE, new SgVarRefExp(s), new SgVarRefExp(ORIGINAL_SYMBOL(s))); - if(st_use_only) - el_use_only->setLhs(er); - else if(st_use) - st_use->setExpression(0, AddElementToList(st_use->expr(0),er)); -} - -void CheckInrinsicNames() -{ - int i; - SgSymbol *s = NULL; - - for(i=0; iidentifier(), cur_func); - if(!s) - continue; - if(IS_BY_USE(s)) - { - if(!strcmp(s->identifier(),ORIGINAL_SYMBOL(s)->identifier())) - AddRenameNodeToUseList(s); - Renaming(Check_Correct_Name(s->identifier()),s); - break; - } - switch (s->variant()) - { - case DEFAULT: - case MODULE_NAME: - case REF_GROUP_NAME: - Error("Object named '%s' should be renamed", s->identifier(), 662, cur_func); - break; - case FUNCTION_NAME: - case ROUTINE_NAME: - case PROCEDURE_NAME: - case PROGRAM_NAME: - if(s->attributes() & INTRINSIC_BIT) - ; - else if(DECL(s)==2) // statement function - Renaming(Check_Correct_Name(s->identifier()),s); - else - Err_g("Object named '%s' should be renamed or declared as INTRINSIC", s->identifier(), 662); - break; - - case SHADOW_GROUP_NAME: - case REDUCTION_GROUP_NAME: - case ASYNC_ID: - case CONSISTENT_GROUP_NAME: - case CONSTRUCT_NAME: - case INTERFACE_NAME: - case NAMELIST_NAME: - case TYPE_NAME: - case CONST_NAME: - Renaming(Check_Correct_Name(s->identifier()),s); - break; - case VARIABLE_NAME: - case LABEL_VAR: - if(IS_DUMMY(s)) - Err_g("Object named '%s' should be renamed", s->identifier(), 662); - else - Renaming(Check_Correct_Name(s->identifier()),s); - break; - case FIELD_NAME: - break; - default: - break; - } - - } -} - -int DvmArrayRefInExpr (SgExpression *e) -{ - if (!e) return 0; - if (isSgArrayRefExp(e) && HEADER(e->symbol())) - return 1; - if (DvmArrayRefInExpr(e->lhs()) || DvmArrayRefInExpr(e->rhs())) - return 1; - else - return 0; -} - -int DvmArrayRefInConstruct (SgStatement *stat) -{ // stat - FORALL or WHERE statement/construct - SgStatement *out_st = lastStmtOf(stat)->lexNext(); - SgStatement *st; - for (st = stat; st != out_st; st = st->lexNext()) - { - if (DvmArrayRefInExpr(stat->expr(0)) || DvmArrayRefInExpr(stat->expr(1)) || DvmArrayRefInExpr(stat->expr(2))) - return 1; - } - return 0; -} - -symb_list *SortingBySize(symb_list *redvar_list) -{//variables of 8 bytes are placed at the beginning of the redvar_list - SgSymbol *sym; - symb_list *sl, *sl_prev; - SgType *type; - for(sl=redvar_list, sl_prev=sl; sl; sl_prev=sl, sl=sl->next) - { - type = isSgArrayType(sl->symb->type()) ? sl->symb->type()->baseType() : sl->symb->type(); - if(TypeSize(type) != 8) continue; - if(sl==redvar_list) continue; - sl_prev->next=sl->next; - sl->next=redvar_list; - redvar_list=sl; - sl=sl_prev; - } - return redvar_list; -} \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/funcall.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/funcall.cpp deleted file mode 100644 index 68d9ee8..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/funcall.cpp +++ /dev/null @@ -1,4999 +0,0 @@ - -/**************************************************************\ -* Fortran DVM * -* * -* Generating LibDVM Function Calls * -\**************************************************************/ - -#include "dvm.h" - - -/**************************************************************\ -* Run_Time Library initialization and completion * -\**************************************************************/ -void RTLInit () -{ -//generating assign statement -// dvm000(1) = linit(InitParam) -// (standart initialization : InitParam = 0) -// and inserting it before first executable statemen - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RTLINI]); - fmask[RTLINI] = 1; - if(deb_mpi) - fe->addArg(*ConstRef(2)); - else - fe->addArg(*ConstRef(0)); - doAssignStmt(fe); - //ndvm--; // the result of RTLIni isn't used - return; -} - -void RTLExit (SgStatement *st ) - -{ -//generating CALL statement to close all opened files: clfdvm() -//and inserting it before statement 'st' - LINE_NUMBER_BEFORE(st,st); - InsertNewStatementBefore(CloseFiles(),st); - if(INTERFACE_RTS2) - // call dvmh_exit(ExitCode) - InsertNewStatementBefore(Exit_2(0),st); - else - { - //generating call statement - // call dvmh_finish() - InsertNewStatementBefore(RTL_GPU_Finish(),st); - //generating call statement - // call lexit(UsersRes) - // UsersRes - result of ending user's program - // !!! temporary : 0 - // and inserting it before statement 'st' - SgCallStmt *call = new SgCallStmt(*fdvm[RTLEXI]); - fmask[RTLEXI] = 2; - call->addArg(*ConstRef(0)); - InsertNewStatementBefore(call,st); - } - return; -} -/**************************************************************\ -* Checking Fortran and C data type compatibility * -\**************************************************************/ -void TypeControl() -{ int n ; - SgCallStmt *call = new SgCallStmt(*fdvm[TPCNTR]); - /*SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TPCNTR]);*/ - fmask[TPCNTR] = 2; - n = (bind_ == 1 ) ? 6 : 5; -//generating assign statement for arguments of 'tpcntr' function - doAssignStmt(ConstRef(n)); //Number of types - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(0)))); - TypeMemory(SgTypeInt()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(0)))); - TypeMemory(SgTypeBool()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(0)))); - TypeMemory(SgTypeFloat()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(0)))); - TypeMemory(SgTypeDouble()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(0)))); - TypeMemory(SgTypeChar()); - if(bind_ == 1) - doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(1)))); - if(bind_ == 1) - doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(2)))); - doAssignStmt(ConstRef(TypeSize(SgTypeInt()))); - doAssignStmt(ConstRef(TypeSize(SgTypeBool()))); - doAssignStmt(ConstRef(TypeSize(SgTypeFloat()))); - doAssignStmt(ConstRef(TypeSize(SgTypeDouble()))); - doAssignStmt(ConstRef(TypeSize(SgTypeChar()))); - if(bind_ == 1) - doAssignStmt(ConstRef( DVMTypeLength())); - doAssignStmt(ConstRef(VarType_RTS(Imem))); - doAssignStmt(ConstRef(VarType_RTS(Lmem))); - doAssignStmt(ConstRef(VarType_RTS(Rmem))); - doAssignStmt(ConstRef(VarType_RTS(Dmem))); - doAssignStmt(ConstRef(5)); - if(bind_ == 1) - doAssignStmt(ConstRef( DVMType())); -//generating assign statement -// and inserting it before first executable statement -// dvm000(i) = tpcntr(Number,FirstAddr[],NextAddr[],Len[],Type[]) - call -> addArg(*DVM000(1)); - call -> addArg(*DVM000(2)); - call -> addArg(*DVM000(2+n)); - call -> addArg(*DVM000(2+2*n)); - call -> addArg(*DVM000(2+3*n)); - where->insertStmtBefore(*call,*where->controlParent()); - //inserting 'call' statement before 'where' statement - cur_st = call; - /*doAssignStmt(fe);*/ - SET_DVM(1); - return; -} - -void TypeControl_New() -{ int n, k ; - /* SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TPCNTR]);*/ /*18.02.03*/ - SgCallStmt *call = new SgCallStmt(*fdvm[FTCNTR]); - fmask[FTCNTR] = 2; - n = (bind_ == 1 ) ? 6 : 5; -//generating assign statement for arguments of 'ftcntr' function - doAssignStmt(ConstRef(n)); //Number of types - if(bind_ == 1) - doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(0)))); - TypeMemory(SgTypeInt()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(0)))); - TypeMemory(SgTypeBool()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(0)))); - TypeMemory(SgTypeFloat()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(0)))); - TypeMemory(SgTypeDouble()); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(0)))); - TypeMemory(SgTypeChar()); - /*if(bind_ == 1) - doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(1))));*/ - if(bind_ == 1) - doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(2)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(1)))); - doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(1)))); - /*if(bind_ == 1) - doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(2))));*/ - if(bind_ == 1) - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(0)),new SgValueExp(DVMTypeLength())); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(1)),new SgValueExp(TypeSize(SgTypeInt()))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(2)),new SgValueExp(TypeSize(SgTypeBool()))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(3)),new SgValueExp(TypeSize(SgTypeFloat()))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(4)),new SgValueExp(TypeSize(SgTypeDouble()))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(5)),new SgValueExp(TypeSize(SgTypeChar()))); -// doAssignStmt(ConstRef(TypeSize(SgTypeInt()))); -// doAssignStmt(ConstRef(TypeSize(SgTypeBool()))); -// doAssignStmt(ConstRef(TypeSize(SgTypeFloat()))); -// doAssignStmt(ConstRef(TypeSize(SgTypeDouble()))); -// doAssignStmt(ConstRef(TypeSize(SgTypeChar()))); - /*if(bind_ == 1) - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(6)),new SgValueExp(DVMTypeLength()));*/ -// doAssignStmt(ConstRef( DVMTypeLength())); - if(bind_ == 1) - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(10)),new SgValueExp(DVMType())); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(11)),new SgValueExp(VarType_RTS(Imem))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(12)),new SgValueExp(VarType_RTS(Lmem))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(13)),new SgValueExp(VarType_RTS(Rmem))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(14)),new SgValueExp(VarType_RTS(Dmem))); - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(15)),new SgValueExp(5)); - -// doAssignStmt(ConstRef(VarType(Imem))); -// doAssignStmt(ConstRef(VarType(Lmem))); -// doAssignStmt(ConstRef(VarType(Rmem))); -// doAssignStmt(ConstRef(VarType(Dmem))); -// doAssignStmt(ConstRef(5)); - /* if(bind_ == 1) - doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(16)),new SgValueExp(DVMType())); */ - -// doAssignStmt(ConstRef( DVMType())); -//generating assign statement -// and inserting it before first executable statement -// dvm000(i) = tpcntr(Number,FirstAddr[],NextAddr[],Len[],Type[]) - //fe -> addArg(*new SgValueExp(n)); //(*DVM000(1)); - //fe -> addArg(*DVM000(2)); - //fe -> addArg(*DVM000(2+n)); - //fe -> addArg(*DVM000(2+2*n)); - //fe -> addArg(*DVM000(2+3*n)); - //doAssignStmt(fe); - k = (bind_ == 1 ) ? 0 : 1; - call -> addArg(*new SgValueExp(n)); //(*DVM000(1)); - call -> addArg(*DVM000(2)); - call -> addArg(*DVM000(2+n)); - call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k))); - call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k+10))); -// call -> addArg(*DVM000(2+2*n)); -// call -> addArg(*DVM000(2+3*n)); - where->insertStmtBefore(*call,*where->controlParent()); - //inserting 'call' statement before 'where' statement - cur_st = call; - SET_DVM(1); - return; -} -/**************************************************************\ -* Requesting processor system * -\**************************************************************/ -void GetVM () -{ - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETVM]); - fmask[GETVM] = 1; -//generating assign statement -// and inserting it before first executable statement -// dvm000(3) = getps(AMRef) - fe -> addArg(*DVM000(2)); // dvm000(2) - AMReference - doAssignStmt(fe); - return; - /* -// generating assign statement -// and inserting it before first executable statement -// dvm000(3) = 0 //PSRef == 0 means current processor system - doAssignStmt(new SgValueExp(0)); - return; - */ -} - -SgExpression * GetProcSys (SgExpression * amref) -{ - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETVM]); - fmask[GETVM] = 1; -//generating function call: getps(AMRef) - fe -> addArg(*amref); // AMReference - return(fe); -} - - -SgExpression *Reconf(SgExpression *size_array, int rank, int sign) -{ - SgFunctionCallExp *fe; - // SgValueExp dPS(3); - -// generating function call: -// psview(PSRef, rank, SizeArray, StaticSign) - fe = new SgFunctionCallExp(*fdvm[PSVIEW]); - fmask[PSVIEW] = 1; - fe->addArg(*CurrentPS()); //DVM000(3);//dvm000(3) - current processor system reference - fe -> addArg(*ConstRef(rank));// Rank - fe -> addArg(*size_array); // SizeArray - fe -> addArg(*ConstRef(sign)); // StaticSign - return(fe); -} - -SgExpression *CrtPS(SgExpression *psref, int ii, int il, int sign) -{ - SgFunctionCallExp *fe; - -// generating function call: -// crtps(PSRef, InitIndexArray[], LastIndexArray[], StaticSign) - fe = new SgFunctionCallExp(*fdvm[CRTPS]); - fmask[CRTPS] = 1; - fe->addArg(*psref); // PSRef - fe -> addArg(*DVM000(ii)); // InitIndexArray - fe -> addArg(*DVM000(il)); // LastIndexArray - fe -> addArg(*ConstRef(sign)); // StaticSign - return(fe); -} -/**************************************************************\ -* Program blocks * -\**************************************************************/ -int BeginBlock () -{ int ib; - SgExpression *re = new SgFunctionCallExp(*fdvm[BEGBL]); - fmask[BEGBL] = 1; -//generating assign statement -// dvm000(1) = BegBl() -// and inserting it before first executable statement - ib = ndvm; - doAssignStmt(re); - return(ib); -} - -void BeginBlock_H () -{ -//inserting Subroutine Call: dvmh_scope_start() - doCallStmt(ScopeStart()); - return; -} - -SgStatement *EndBlock_H (SgStatement * st) -{ - SgStatement *call = ScopeEnd(); - LINE_NUMBER_BEFORE(st,st); -//inserting Subroutine Call: dvmh_scope_end() -//before 'st' statement - InsertNewStatementBefore(call,st); - return(call); -} - -void EndBlock (SgStatement * st) -{ -//generating assign statement -// dvm000(i) = EndBl(BlockRef) -// and inserting it before current statement - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ENDBL]); - fmask[ENDBL] = 1; - //fe -> addArg(* DVM000(1)); - LINE_NUMBER_BEFORE(st,st); - doAssignStmtBefore(fe,st); - return; -} - -SgExpression * EndBl(int n) -{ -//generating Function Call: -// EndBl(BlockRef) - - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[ENDBL]); - fmask[ENDBL] = 1; - fe->addArg(*DVM000(n)); - return(fe); -} - -/**************************************************************\ -* Abstract machine creating and mapping * -\**************************************************************/ -void Get_AM () -{ - SgExpression *re = new SgFunctionCallExp(*fdvm[GETAM]); - fmask[GETAM] = 1; -//generating assign statement -// and inserting it before first executable statement -// dvm000(2) = GetAM() - doAssignStmt(re); - return; -} - -SgExpression *GetAM () -{ - SgExpression *re = new SgFunctionCallExp(*fdvm[GETAM]); - fmask[GETAM] = 1; -//generating function call: GetAM() - return(re); -} - -SgExpression *CreateAMView(SgExpression *size_array, int rank, int sign) { - SgFunctionCallExp *fe; - SgValueExp dAM(2); - //SgArrayType *artype; - SgExpression *arg; - //algn_attr *atrAT; - if(sign != 2) - loc_distr = 1; - else - sign = 1; -// generating function call: -// CrtAMV(AMRef, rank, SizeArray, StaticSign) - fe = new SgFunctionCallExp(*fdvm[CRTAMV]); - fmask[CRTAMV] = 1; - arg = CurrentAM(); //new SgArrayRefExp(*dvmbuf, dAM); //dvm000(2) - AMRef - fe->addArg(*arg); - - - arg = ConstRef(rank); // Rank - fe -> addArg(*arg); - fe -> addArg(*size_array); // SizeArray - fe -> addArg(*ConstRef(sign)); // StaticSign - return(fe); -} - -SgExpression * DistributeAM (SgExpression *amv, SgExpression *psref, int count, int idisars, int iparam) { -// creating function call: -// DisAM(AMViewRef,PSRef, ParamCount,AxisArray, DistrParamArray) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DISAM]); // DisAM function call - fmask[DISAM] = 1; - fe->addArg( amv->copy()); - fe->addArg( * psref); // PSRef - fe->addArg( * ConstRef (count)); - fe->addArg( * DVM000(idisars)); - fe->addArg( * DVM000(iparam)); - return(fe); -} - -SgStatement *RedistributeAM(SgExpression *ref, SgExpression *psref, int count, int idisars,int sign) { -// creating subroutine call: -// redis(AMViewRef,PSRef, ParamCount,AxisArray, DistrParamArray, NewSign) - SgCallStmt *call = new SgCallStmt(*fdvm[RDISAM]); - fmask[RDISAM] = 2; - call->addArg( ref->copy()); - call->addArg( * psref ); // PSRef - /*fe->addArg( * ConstRef(0)); */ // current PSRef - call->addArg( * ConstRef (count)); - call->addArg( * DVM000(idisars)); - call->addArg( * DVM000(idisars+count)); - call->addArg( * ConstRef(sign)); - return(call); -} - -SgExpression *GetAMView(SgExpression *headref) - { SgFunctionCallExp *fe; -// creating function call: -// getamv(HeaderRef) - fe = new SgFunctionCallExp(*fdvm[GETAMV]); - fmask[GETAMV] = 1; - fe->addArg(* headref); - return(fe); -} - -SgExpression *GetAMR(SgExpression *amvref, SgExpression *index) - { SgFunctionCallExp *fe; -// creating function call: -// getamr(AMViewRef,IndexArray) - fe = new SgFunctionCallExp(*fdvm[GETAMR]); - fmask[GETAMR] = 1; - fe->addArg(* amvref); - fe->addArg(* index); - return(fe); -} - -SgExpression * GenBlock (SgExpression *psref, SgExpression *amv, int iweight, int icount) - { -// creating function call: -// genbli(PSRef,AMViewRef, AxisWeightArray, AxisCount) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[GENBLI]); // genbli function call - fmask[GENBLI] = 1; - fe->addArg( * psref); // PSRef - fe->addArg( amv->copy() ); - fe->addArg( * DVM000(iweight)); - fe->addArg( * ConstRef(icount)); - return(fe); -} - -SgExpression * WeightBlock(SgExpression *psref, SgExpression *amv, int iweight, int iwnumb, int icount) - { -// creating function call: -// setelw(PSRef,AMViewRef, LoadWeightArray, WeightNumberArray,Count) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[SETELW]); // setelw() function call - fmask[SETELW] = 1; - fe->addArg( * psref); // PSRef - fe->addArg( amv->copy() ); - fe->addArg( * DVM000(iweight)); - fe->addArg( * DVM000(iwnumb)); - fe->addArg( * ConstRef(icount)); - return(fe); -} - -SgExpression * MultBlock (SgExpression *amv, int iaxisdiv, int n) - { -// creating function call: -// blkdiv(AMViewRef, AxisDivArray, AMVAxisCount) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[BLKDIV]); // blkdiv function call - fmask[BLKDIV] = 1; - - fe->addArg( amv->copy() ); - fe->addArg( * DVM000(iaxisdiv)); - fe->addArg( * ConstRef(n)); - return(fe); -} -/**************************************************************\ -* Distributed array creating and mapping * -\**************************************************************/ -SgExpression *CreateDistArray(SgSymbol *das, SgExpression *array_header, SgExpression *size_array, int rank, int ileft, int iright, int sign, int re_sign) -{ -// creates function call: -// CrtDA (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, -// StaticSign, ReDistrSign, LeftBSizeArray,RightBSizeArray) - SgFunctionCallExp *fe; - SgExpression *arg; - SgType *t; - loc_distr =1; - if(IS_POINTER(das)) - t = PointerType(das); - else - t = (das->type())->baseType(); - if(t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING){ - fe = new SgFunctionCallExp(*fdvm[CRTDA]); // crtda function call - fmask[CRTDA] = 1; - } else { - fe = new SgFunctionCallExp(*fdvm[CRTDA9]); // crtda9 function call - fmask[CRTDA9] = 1; - } - fe->addArg(* array_header); - fe->addArg(*ConstRef(1)); //ExtHdrSign = 1 for Fortran - arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : GetAddresMem(new SgArrayRefExp(*baseMemory(t))) ; //SgArrayRefExp(*baseMemory(t)) - //TypeMemory(t); // marking this type memory use - fe->addArg(*arg); //Base - arg = ConstRef(rank); - fe->addArg(*arg); //Rank - arg = ConstRef(TypeSize(t)); - //arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING )? &SgUMinusOp(*ConstRef( TestType_RTS(t))) : ConstRef(TypeSize(t)); - fe->addArg(*arg); //TypeSize - fe->addArg(size_array->copy()); //Size_array - fe->addArg(*ConstRef(sign)); //StaticSign - fe->addArg(*ConstRef(re_sign)); // ReDistrSign - fe->addArg(*DVM000(ileft)); - fe->addArg(*DVM000(iright)); - return(fe); -} - -SgExpression *AlignArray (SgExpression *array_handle, - SgExpression *template_handle, - int iaxis, - int icoeff, - int iconst) -//creating function call: -// AlgnDA (ArrayHeader, PatternRef, AxisArray, CoeffArray, ConstArray) -{ - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[ALGNDA]); // AlgnDA function call - fmask[ALGNDA] = 1; - fe->addArg( array_handle->copy()); - fe->addArg( template_handle->copy()); - fe->addArg( *dvm_ref(iaxis)); - fe->addArg( *dvm_ref(icoeff)); - fe->addArg( *dvm_ref(iconst)); - return(fe); -} - -SgStatement *RealignArr (SgExpression *array_header, - SgExpression *pattern_ref, - int iaxis, - int icoeff, - int iconst, - int new_sign ) -//creating subroutine call: -// realn (ArrayHeader, PatternRef, AxisArray, CoeffArray, ConstArray, NewSign) -{ - SgCallStmt *call = new SgCallStmt(*fdvm[REALGN]); - fmask[REALGN] = 2; - call->addArg( array_header->copy()); - call->addArg( pattern_ref->copy()); - call->addArg( *dvm_ref(iaxis)); - call->addArg( *dvm_ref(icoeff)); - call->addArg( *dvm_ref(iconst)); - call->addArg( *ConstRef(new_sign)); - return(call); -} - -/**************************************************************\ -* CONSISTENT(replicated) array creating * -\**************************************************************/ -SgExpression *CreateConsistArray(SgSymbol *cas, SgExpression *array_header, SgExpression *size_array, int rank, int sign, int re_sign) -{ -// creates function call: -// crtraf or crtra9 (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, StaticSign, ReDistrSign, Memory) -// - SgFunctionCallExp *fe; - SgExpression *arg; - SgType *t; - loc_distr =1; - - t = (cas->type())->baseType(); - if(t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING){ - fe = new SgFunctionCallExp(*fdvm[CRTRDA]); // crtraf function call - fmask[CRTRDA] = 1; - } else { - fe = new SgFunctionCallExp(*fdvm[CRTRA9]); // crtra9 function call - fmask[CRTRA9] = 1; - } - fe->addArg(* array_header); - fe->addArg(*ConstRef(0)); //ExtHdrSign = 0 for consistent array - //fe->addArg(*ConstRef(1)); //ExtHdrSign = 1 for Fortran - arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING) ? new SgArrayRefExp(*cas) : GetAddresMem(new SgArrayRefExp(*baseMemory(t)));//new SgArrayRefExp(*Imem); SgArrayRefExp(*baseMemory(t)) - //TypeMemory(t); // marking this type memory use - fe->addArg(*arg); //Base - arg = ConstRef(rank); - fe->addArg(*arg); //Rank - arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING) ? &SgUMinusOp(*ConstRef( TestType_RTS(t))) : ConstRef(TypeSize(t)); - //arg = ConstRef(TypeSize(t)); - fe->addArg(*arg); //TypeSize - fe->addArg(size_array->copy()); //Size_array - fe->addArg(*ConstRef(sign)); //StaticSign - fe->addArg(*ConstRef(re_sign)); // ReDistrSign - arg= new SgArrayRefExp(*cas); - fe->addArg(*GetAddresMem(arg)); - return(fe); -} - -SgStatement *CreateDvmArrayHeader(SgSymbol *cas, SgExpression *array_header, SgExpression *size_array, int rank, int sign, int re_sign) -{ -// creates subroutine call: -// crtraf or crtra9 (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, StaticSign, ReDistrSign, Memory) -// - SgCallStmt *call; - SgExpression *arg; - SgType *t; - int test_type; - loc_distr =1; - - t = (cas->type())->baseType(); - test_type = TestType_RTS(t); - if(test_type) { - call = new SgCallStmt(*fdvm[CRTRDA]); // crtraf function call - fmask[CRTRDA] = 2; - } else { - call = new SgCallStmt(*fdvm[CRTRA9]); // crtra9 function call - fmask[CRTRA9] = 2; - } - call->addArg(* array_header); - if(!IN_COMPUTE_REGION && !parloop_by_handler) - call->addArg(*ConstRef(0)); //ExtHdrSign = 0 for consistent array - else - call->addArg(*ConstRef(1)); //ExtHdrSign = 1 for dvm array in region - arg = (test_type) ? (HEADER_OF_REPLICATED(cas) ? new SgArrayRefExp(*baseMemory(t)) : new SgArrayRefExp(*cas)) : GetAddresMem(new SgArrayRefExp(*baseMemory(t)));//new SgArrayRefExp(*Imem); SgArrayRefExp(*baseMemory(t)) - call->addArg(*arg); //Base - arg = ConstRef(rank); - call->addArg(*arg); //Rank - arg = (test_type) ? &SgUMinusOp(*ConstRef(test_type)) : ConstRef(TypeSize(t)); - - call->addArg(*arg); //TypeSize - call->addArg(size_array->copy()); //Size_array - call->addArg(*ConstRef(sign)); //StaticSign - call->addArg(*ConstRef(re_sign)); // ReDistrSign - arg = new SgArrayRefExp(*cas); - call->addArg(*GetAddresMem(arg)); // Memory - return(call); -} - -/**************************************************************\ -* Parallel Loop Defining * -\**************************************************************/ -/* -int CreateParLoop(int rank) -{ -//generating assign statement: -// dvm000(i) = crtpl( Rank) -// return: i - index in "dvm000" array for LoopRef - int il; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTPLP]); - fmask[CRTPLP] = 1; - fe -> addArg( * ConstRef(rank)); - il = ndvm; - doAssignStmtAfter(fe); - return(il); -} -*/ -SgExpression *CreateParLoop(int rank) -{ -//generating Function Call: -// crtpl( Rank) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTPLP]); - fmask[CRTPLP] = 1; - fe -> addArg( * ConstRef(rank)); - return(fe); -} - - -SgExpression *doLoop(int iloopref) -{ -//generating Function Call: -// dopl(LoopRef) - - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DOLOOP]); - fmask[DOLOOP] = 1; - fe->addArg(*DVM000(iloopref)); - return(fe); -} - - -SgStatement * BeginParLoop (int iloopref,SgExpression *header, int rank, int iaxis, int nr, int iinp, int iout) -{ -//creating subroutine call: -// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[], -// LoopVarAdrArray[], LoopVarTypeArray[], InpInitIndexArray[], InpLastIndexArray[], -// InpStepArray[], -// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[]) - - SgCallStmt *call= new SgCallStmt(*fdvm[BEGPLP]); - fmask[BEGPLP] = 2; - call->addArg(*DVM000(iloopref)); - call->addArg(*header); - call->addArg(*DVM000(iaxis)); - call->addArg(*DVM000(iaxis+nr)); - call->addArg(*DVM000(iaxis+2*nr)); - call->addArg(*DVM000(iinp)); - call->addArg(*DVM000(iinp+rank)); - call->addArg(*DVM000(iinp+2*rank)); - call->addArg(*DVM000(iinp+3*rank)); - call->addArg(*DVM000(iinp+4*rank)); - call->addArg(*DVM000(iout)); - call->addArg(*DVM000(iout+rank)); - call->addArg(*DVM000(iout+2*rank)); - return(call); -} - -SgStatement *EndParLoop(int iloopref) -{ -//generating Subroutine Call: -// EndPL(LoopRef) - - SgCallStmt *call= new SgCallStmt(*fdvm[ENDPLP]); - fmask[ENDPLP] = 2; - call->addArg(*DVM000(iloopref)); - return(call); -} - -SgStatement *BoundFirst(int iloopref, SgExpression *gref) -{ -//generating Subroutine Call: -// exfrst(LoopRef,BoundGroupRef) - - SgCallStmt *call= new SgCallStmt(*fdvm[BFIRST]); - fmask[BFIRST] = 2; - call->addArg(*DVM000(iloopref)); - call->addArg(gref->copy()); - return(call); -} - -SgStatement *BoundLast(int iloopref, SgExpression *gref) -{ -//generating Subroutine Call: -// imlast(LoopRef,BoundGroupRef) - - SgCallStmt *call= new SgCallStmt(*fdvm[BLAST]); - fmask[BLAST] = 2; - call->addArg(*DVM000(iloopref)); - call->addArg(gref->copy()); - return(call); -} - -/**************************************************************\ -* Reduction * -\**************************************************************/ -SgExpression * CreateReductionGroup() -{ -//generating function call: -// CrtRG(StaticSign,DelRVSign) - - //int ig; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTRG]); - fmask[CRTRG] = 1; - fe->addArg(* ConstRef(1)); //StaticSign = 1 - fe->addArg(* ConstRef(1)); //DelRVSign = 1 - //ig = ndvm; - //doAssignTo_After(gref,fe); - return(fe); -} - -SgExpression *ReductionVar(int num_red, SgExpression *red_array, int ntype, int length, SgExpression *loc_array, int loc_length, int sign) -{ -//generating function call: -// crtrdf(RedFuncNumb, RedArray, RedArrayType, RedArrayLength, LocArray, LocElmLength, StaticSign) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[REDVARF]); - fmask[REDVARF] = 1; - //fe = new SgFunctionCallExp(*fdvm[REDVAR]); - //fmask[REDVAR] = 1; - fe->addArg(*ConstRef(num_red)); - fe->addArg(*GetAddresMem(red_array)); - //fe->addArg(red_array->copy()); //!!!It must be: *GetAddresMem(red_array) - fe->addArg(*ConstRef(ntype)); - fe->addArg(*DVM000(length)); - fe->addArg(loc_array->copy()); - fe->addArg(*DVM000(loc_length)); - fe->addArg(*ConstRef(sign)); - return(fe); -} - -SgStatement *InsertRedVar(SgExpression *gref, int irv, int iplp) -{ -//creating subroutine call: -// insred(RedGroupRef, RedVarRef, PSSpaceRef, RenewSign) - SgCallStmt *call = new SgCallStmt(*fdvm[INSRV]); - fmask[INSRV] = 2; - call->addArg(gref->copy()); - call->addArg(*dvm_ref(irv)); - if(iplp) - call->addArg(*dvm_ref(iplp)); - else - call->addArg(*ConstRef(0)); - call->addArg(*ConstRef(0)); - return(call); -} - -SgExpression *LocIndType(int irv, int type) -{ -//creating function call: -// lindtp(RedVarRef, LocIndType) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[LINDTP]); - fmask[LINDTP] = 1; - fe->addArg(*DVM000(irv)); - fe->addArg(*ConstRef(type)); - return(fe); -} - -SgStatement *LoopReduction(int ilh, int num_red, SgExpression *red_array, int ntype, SgExpression *length, SgExpression *loc_array, SgExpression *loc_length) -{//creating Subroutine Call: - // dvmh_loop_reduction(const DvmType *pCurLoop, const DvmType *pRedType, void *arrayAddr, const DvmType *pVarType, const DvmType *pArrayLength, - // void *locAddr, const DvmType *pLocSize) - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_RED]); - fmask[LOOP_RED] = 2; - call->addArg(*DVM000(ilh)); - call->addArg(*ConstRef(num_red)); - call->addArg(red_array->copy()); //GetAddresMem(red_array) - call->addArg(*ConstRef(ntype)); - call->addArg(*DvmType_Ref(length)); - call->addArg(loc_array->copy()); - call->addArg(*DvmType_Ref(loc_length)); - return(call); -} - -SgExpression *SaveRedVars(SgExpression *gref) -{ -//creating function call: -// SaveRV(RedGroupRef) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[SAVERV]); - fmask[SAVERV] = 1; - fe->addArg(gref->copy()); - return(fe); -} - -SgStatement *StartRed(SgExpression *gref) -{ -//creating subroutine call: -// strtrd(RedGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[STARTR]); - fmask[STARTR] = 2; - call->addArg(gref->copy()); - return(call); -} - -SgStatement *WaitRed(SgExpression *gref) -{ -//creating subroutine call: -// waitrd(RedGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[WAITR]); - fmask[WAITR] = 2; - call->addArg(gref->copy()); - return(call); -} - -SgExpression *DelRG(SgExpression *gref) -{ -//creating function call: -// DelRG(RedGroupRef) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DELRG]); - fmask[DELRG] = 1; - fe->addArg(gref->copy()); - return(fe); -} - -/**************************************************************\ -* Shadow edge operations * -\**************************************************************/ -void CreateBoundGroup(SgExpression *gref) -{ -//generating assign statement: -// dvm000(i) = crtshg(StaticSign) - int st_sign; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTSHG]); - fmask[CRTSHG] = 1; - st_sign = (HPF_program && one_inquiry) ? 1 : 0; - //StaticSign = 1 if -Honeq option is specified for HPF program, - //StaticSign = 0 if other - fe->addArg(* ConstRef(st_sign)); - //ibg = ndvm; - doAssignTo_After(gref,fe); - return; -} - -SgStatement *InsertArrayBound(SgExpression *gref, SgExpression *head, int ileft, int iright, int corner) -{ -//creating subroutine call: -// inssh(BounddGroupRef, ArrayHeader[], LeftBSize[], RightBSize[],CornerSign) - SgCallStmt *call = new SgCallStmt(*fdvm[DATOSHG]); - fmask[DATOSHG] = 2; - call->addArg(gref->copy()); - call->addArg(*head); - call->addArg(*DVM000(ileft)); - call->addArg(*DVM000(iright)); - call->addArg(*ConstRef(corner)); - return(call); -} - -SgStatement *InsertArrayBoundDep(SgExpression *gref, SgExpression *head, int ileft, int iright, int max, int ishsign) -{ -//creating subroutine call: -// insshd(BounddGroupRef, ArrayHeader[], LeftBSize[], RightBSize[],MaxShadowCount,ShadowSignArray[]) - SgCallStmt *call = new SgCallStmt(*fdvm[INSSHD]); - fmask[INSSHD] = 2; - call->addArg(gref->copy()); - call->addArg(*head); - call->addArg(*DVM000(ileft)); - call->addArg(*DVM000(iright)); - call->addArg(*ConstRef(max)); - call->addArg(*DVM000(ishsign)); - return(call); -} - -SgStatement *InsertArrayBoundSec(SgExpression *gref, SgExpression *head, int ilsec, int irsec, int iilowshs, int illowshs, int iihishs,int ilhishs, int max, int ishsign) -{ -//creating subroutine call: -// incshd(BounddGroupRef, ArrayHeader[], InitDimIndex[], LastDimIndex[],InitLowShdIndex[], -// LastLowShdIndex[], InitHiShdIndex[], LastHiShdIndex[],LeftBSize[], RightBSize[],MaxShadowCount,ShadowSignArray[]) - SgCallStmt *call = new SgCallStmt(*fdvm[INCSHD]); - fmask[INCSHD] = 2; - call->addArg(gref->copy()); - call->addArg(*head); - call->addArg(*DVM000(ilsec)); - call->addArg(*DVM000(irsec)); - call->addArg(*DVM000(iilowshs)); - call->addArg(*DVM000(illowshs)); - call->addArg(*DVM000(iihishs)); - call->addArg(*DVM000(ilhishs)); - call->addArg(*ConstRef(max)); - call->addArg(*DVM000(ishsign)); - return(call); -} - - -SgStatement *AddBound( ) -{ -//creating subroutine call: -// addbnd() - SgCallStmt *call = new SgCallStmt(*fdvm[ADDBND]); - fmask[ADDBND] = 2; - return(call); -} - -SgStatement *AddBoundShadow(SgExpression *head,int ileft,int iright ) -{ -//creating subroutine call: -// addshd( ArrayHeader[], LeftBSize[], RightBSize[]) - SgCallStmt *call = new SgCallStmt(*fdvm[ADDSHD]); - fmask[ADDSHD] = 2; - call->addArg(*head); - call->addArg(*DVM000(ileft)); - call->addArg(*DVM000(iright)); - return(call); -} - -SgStatement *StartBound(SgExpression *gref) -{ -//creating subroutine call: -// strtsh(BoundGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[STARTSH]); - fmask[STARTSH] = 2; - call->addArg(gref->copy()); - return(call); -} - -SgStatement *WaitBound(SgExpression *gref) -{ -//creating subroutine call: -// waitsh(BoundGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[WAITSH]); - fmask[WAITSH] = 2; - call->addArg(gref->copy()); - return(call); -} - -SgStatement *SendBound(SgExpression *gref) -{ -//creating subroutine call: -// sendsh(BoundGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[SENDSH]); - fmask[SENDSH] = 2; - call->addArg(gref->copy()); - return(call); -} - -SgStatement *ReceiveBound(SgExpression *gref) -{ -//creating subroutine call: -// recvsh(BoundGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[RECVSH]); - fmask[RECVSH] = 2; - call->addArg(gref->copy()); - return(call); -} - -SgStatement *InitAcross(int acrtype,SgExpression *oldg, SgExpression *newg) -{ -//creating subroutine call: -// across(AcrossType,OldShadowGroupRef,NewShadowGroupRef,GroupNumber) - SgCallStmt *call = new SgCallStmt(*fdvm[ACROSS]); - fmask[ACROSS] = 2; - call->addArg(*ConstRef(acrtype)); - call->addArg(*oldg); - call->addArg(*newg); - call->addArg(*new SgVarRefExp(Pipe)); - return(call); -} - - -SgExpression *DelBG(SgExpression *gref) -{ -//creating function call: -// DelShG(BoundGroupRef) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DELSHG]); - fmask[DELSHG] = 1; - fe->addArg(gref->copy()); - return(fe); -} - -/**************************************************************\ -* Copying distributed arrays * -\**************************************************************/ -SgExpression *DA_CopyTo_A(SgExpression *head, SgExpression *toar, int init_ind, int last_ind, int step_ind, int regim) -{ -//generating Function Call: -// ArrCpy(ArrayHeader,FromInitIndexArray,FromLastIndexArray,FromStepArray, -// Array, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRCPY]); - fmask[ARRCPY] = 1; - fe->addArg(head->copy()); - fe->addArg(*DVM000(init_ind)); - fe->addArg(*DVM000(last_ind)); - fe->addArg(*DVM000(step_ind)); - - fe->addArg(toar->copy()); - fe->addArg(*DVM000(init_ind)); //is ignored for CopyRegim=2 - fe->addArg(*DVM000(last_ind)); //is ignored for CopyRegim=2 - fe->addArg(*DVM000(step_ind)); //is ignored for CopyRegim=2 - - fe->addArg(* ConstRef(regim)); // CopyRegim - return(fe); -} - -SgExpression *A_CopyTo_DA( SgExpression *fromar, SgExpression *head, int init_ind, int last_ind, int step_ind, int regim) -{ -//generating Function Call: -// ArrCpy(Array, FromInitIndexArray,FromLastIndexArray,FromStepArray, -// ArrayHeader, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRCPY]); - fmask[ARRCPY] = 1; - - fe->addArg(fromar->copy()); - fe->addArg(*DVM000(init_ind)); //is ignored for CopyRegim=2 - fe->addArg(*DVM000(last_ind)); //is ignored for CopyRegim=2 - fe->addArg(*DVM000(step_ind)); //is ignored for CopyRegim=2 - - fe->addArg(head->copy()); - fe->addArg(*DVM000(init_ind)); - fe->addArg(*DVM000(last_ind)); - fe->addArg(*DVM000(step_ind)); - - fe->addArg(* ConstRef(regim)); // CopyRegim - return(fe); -} - -SgExpression *ArrayCopy(SgExpression *from_are, int from_init, int from_last, int from_step, SgExpression *to_are, int to_init, int to_last, int to_step, int regim) -{ -//generating Function Call: -// ArrCpy(ArrayHeader,FromInitIndexArray,FromLastIndexArray,FromStepArray, -// Array, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRCPY]); - fmask[ARRCPY] = 1; - - fe->addArg(from_are->copy()); - fe->addArg(*DVM000(from_init)); - fe->addArg(*DVM000(from_last)); - fe->addArg(*DVM000(from_step)); - - fe->addArg(to_are->copy()); - fe->addArg(*DVM000(to_init)); - fe->addArg(*DVM000(to_last)); - fe->addArg(*DVM000(to_step)); - - fe->addArg(* SignConstRef (regim)); // CopyRegim - - return(fe); -} - -SgExpression *ReadWriteElement(SgExpression *from, SgExpression *to, int ind) -{ -//generating Function Call: -// rwelm(FromArrayHeader, To, IndexArray); - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RWELMF]); - fmask[RWELMF] = 1; - //SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RWELM]); - //fmask[RWELM] = 1; - - fe->addArg(from->copy()); - fe->addArg(*GetAddresMem(to)); - //fe->addArg(to->copy());//!!!it must be: *GetAddresMem(to) - fe->addArg(*DVM000(ind)); - return(fe); -} - -SgExpression *AsyncArrayCopy(SgExpression *from_are, int from_init, int from_last, int from_step, SgExpression *to_are, int to_init, int to_last, int to_step, int regim, SgExpression *flag) -{ -//generating Function Call: -// aarrcp(ArrayHeader,FromInitIndexArray,FromLastIndexArray,FromStepArray, -// Array, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim,CopyFlag) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[AARRCP]); - fmask[AARRCP] = 1; - - fe->addArg(from_are->copy()); - fe->addArg(*DVM000(from_init)); - fe->addArg(*DVM000(from_last)); - fe->addArg(*DVM000(from_step)); - - fe->addArg(to_are->copy()); - fe->addArg(*DVM000(to_init)); - fe->addArg(*DVM000(to_last)); - fe->addArg(*DVM000(to_step)); - - fe->addArg(* SignConstRef (regim)); // CopyRegim - fe->addArg(flag->copy()); - return(fe); -} - -SgExpression *WaitCopy(SgExpression *flag) -{ -//creating function call: -// waitcp(CopyFlag) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[WAITCP]); - fmask[WAITCP] = 1; - fe->addArg(flag->copy()); - return(fe); -} - -/**************************************************************\ -* Tasking * -\**************************************************************/ -SgStatement *MapAM(SgExpression *am, SgExpression *ps) -{ -//generating Subroutine Call: -// mapam(AMRef,PSRef) -//creating task (mapping abstract mashine) - SgCallStmt *call = new SgCallStmt(*fdvm[MAPAM]); - fmask[MAPAM] = 2; - - call->addArg(*am); - call->addArg(*ps); - return(call); -} - -SgExpression *RunAM(SgExpression *am) -{ -//generating Function Call: -// runam(AMRef) -//starting task - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RUNAM]); - fmask[RUNAM] = 1; - - fe->addArg(*am); - return(fe); -} - -SgStatement *StopAM() -{ -//generating Subroutine Call: -// stopam() -//stoping task - SgCallStmt *call = new SgCallStmt(*fdvm[STOPAM]); - fmask[STOPAM] = 2; - return(call); -} - -SgStatement *MapTasks(SgExpression *taskCount,SgExpression *procCount,SgExpression *params,SgExpression *low_proc,SgExpression *high_proc,SgExpression *renum) -{ -//generating Subroutine Call: -// map_tasks(long taskCount,long procCount,double params,long low_proc,long high_proc,long renum) - SgCallStmt *call = new SgCallStmt(*fdvm[MAP_TASKS]); - fmask[MAP_TASKS] = 2; - call -> addArg(*taskCount); - call -> addArg(*procCount); - call -> addArg(*params); - call -> addArg(*low_proc); - call -> addArg(*high_proc); - call -> addArg(*renum); - return(call); -} -/**************************************************************\ -* Remote access * -\**************************************************************/ -/* -SgExpression *LoadBG(SgSymbol *group) -{ -//generating Function Call: -// loadbg(GroupRef,RenewSign) -//loading buffers of group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADBG]); - fmask[LOADBG] = 1; - - fe->addArg(*GROUP_REF(group,1)); - fe->addArg(*ConstRef(1)); - return(fe); -} - -SgExpression *WaitBG(SgSymbol *group) -{ -//generating Function Call: -// waitbg(GroupRef) -//waiting of completion of loading buffers of the group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITBG]); - fmask[WAITBG] = 1; - - fe->addArg(*GROUP_REF(group,1)); - return(fe); -} -*/ - -SgExpression *LoadBG(SgExpression *gref) -{ -//generating Function Call: -// loadbg(GroupRef,RenewSign) -//loading buffers of group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADBG]); - fmask[LOADBG] = 1; - - fe->addArg(*gref); - fe->addArg(*ConstRef(1)); - return(fe); -} - -SgExpression *WaitBG(SgExpression *gref) -{ -//generating Function Call: -// waitbg(GroupRef) -//waiting of completion of loading buffers of the group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITBG]); - fmask[WAITBG] = 1; - - fe->addArg(*gref); - return(fe); -} - -SgExpression *CreateBG(int st_sign,int del_sign) -{ -//generating Function Call: -// crtbg(StaticSign,DelBufSign) -//creating group of buffers - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTBG]); - fmask[CRTBG] = 1; - - fe->addArg(*ConstRef(st_sign)); - fe->addArg(*ConstRef(del_sign)); - return(fe); -} -/* -SgExpression *InsertRemBuf(SgSymbol *group, SgExpression *buf) -{ -//generating Function Call: -// insrb(GroupRef,BufferHeader[]) -//inserting buffer in the group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSRB]); - fmask[INSRB] = 1; - - fe->addArg(*GROUP_REF(group,1)); - fe->addArg(*buf); - return(fe); -} -*/ - -SgExpression *InsertRemBuf(SgExpression *gref, SgExpression *buf) -{ -//generating Function Call: -// insrb(GroupRef,BufferHeader[]) -//inserting buffer in the group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSRB]); - fmask[INSRB] = 1; - - fe->addArg(*gref); - fe->addArg(*buf); - return(fe); -} - -SgStatement *CreateRemBuf(SgExpression *header,SgExpression *buffer,int st_sign,int iplp,int iaxis,int icoeff,int iconst) -{ -//generating Subroutine Call: -// crtrbl(ArrayHeader[],BufferHeader[], Base,StaticSign,LoopRef, AxisArray[],CoeffArray[],ConstArray[], ) -//creating buffer for remote data -// SgSymbol *sbase; - SgCallStmt *call = new SgCallStmt(*fdvm[CRTRB]); - fmask[CRTRB] = 2; - call->addArg(*header); - call->addArg(*buffer); - //sbase = (header->symbol()->type()->baseType()->variant() == T_STRING) ? Chmem : Imem; /* podd 14.01.12 */ - //fe->addArg(* new SgArrayRefExp(*sbase)); //Base - call->addArg(* new SgArrayRefExp(*Imem)); //Base - call->addArg(*ConstRef(st_sign)); - call->addArg(*DVM000(iplp)); - call->addArg(*DVM000(iaxis)); - call->addArg(*DVM000(icoeff)); - call->addArg(*DVM000(iconst)); - - return(call); -} -/* -SgExpression *CreateRemBuf(SgExpression *header,SgExpression *buffer,int st_sign,int icoeff,int iconst,int iinit,int ilast,int istep) -{ -//generating Function Call: -// crtrbl(ArrayHeader[],BufferHeader[], Base,StaticSign,CoeffArray[],ConstArray[], -// InitIndexArray[],LastIndexArray[],StepArray[]) -//creating buffer for remote data - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTRB]); - fmask[CRTRB] = 1; - fe->addArg(*header); - fe->addArg(*buffer); - fe->addArg(* new SgArrayRefExp(*Imem)); //Base - fe->addArg(*ConstRef(st_sign)); - fe->addArg(*DVM000(icoeff)); - fe->addArg(*DVM000(iconst)); - fe->addArg(*DVM000(iinit)); - fe->addArg(*DVM000(ilast)); - fe->addArg(*DVM000(istep)); - return(fe); -} -*/ - -SgStatement *CreateRemBufP(SgExpression *header,SgExpression *buffer,int st_sign,SgExpression *psref,int icoord) -{ -//generating Subroutine Call: -// crtrbp(ArrayHeader[],BufferHeader[], Base,StaticSign,LoopRef, AxisArray[],CoeffArray[], -// ConstArray[], ) -//creating buffer for remote data - SgCallStmt *call = new SgCallStmt(*fdvm[CRTRBP]); -// SgSymbol *sbase; - fmask[CRTRBP] = 2; - call->addArg(*header); - call->addArg(*buffer); - //sbase = (header->symbol()->type()->baseType()->variant() == T_STRING) ? Chmem : Imem; /* podd 14.01.12 */ - //fe->addArg(* new SgArrayRefExp(*sbase)); //Base - call->addArg(* new SgArrayRefExp(*Imem)); //Base - call->addArg(*ConstRef(st_sign)); - call->addArg(*psref); - call->addArg(*DVM000(icoord)); - return(call); -} - -SgStatement *LoadRemBuf(SgExpression *buf) -{ -//generating Subroutine Call: -// loadrb(BufferHeader,RenewSign) -//loading buffer - SgCallStmt *call = new SgCallStmt(*fdvm[LOADRB]); - fmask[LOADRB] = 2; - - call->addArg(*buf); - call->addArg(*ConstRef(0)); - return(call); -} - -SgStatement *WaitRemBuf(SgExpression *buf) -{ -//generating Subroutine Call: -// waitrb(BufferHeader) -//waiting completion of loading buffer - SgCallStmt *call = new SgCallStmt(*fdvm[WAITRB]); - fmask[WAITRB] = 2; - - call->addArg(*buf); - return(call); -} -/* -SgExpression *DelRemBuf(SgExpression *buf) -{ -//generating Function Call: -// delrb(BufferHeader) -//deleting buffer - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DELRB]); - fmask[DELRB] = 1; - - fe->addArg(*buf); - return(fe); -} -*/ - - -/**************************************************************\ -* Inquiry about the kind of distributed array element access * -* ( for HPF program) * -\**************************************************************/ -SgExpression *RemoteAccessKind(SgExpression *header,SgExpression *buffer,int st_sign,int iplp,int iaxis,int icoeff,int iconst,int ilsh,int ihsh) -{ -//generating Function Call: -// rmkind(ArrayHeader[],BufferHeader[], Base,StaticSign,LoopRef, AxisArray[],CoeffArray[], -// ConstArray[], LowShadowArray[],HiShadowArray[]) -//determinating data access kind: 1 - local, 2 - shadow, 3 - remote - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RMKIND]); - fmask[RMKIND] = 1; - fe->addArg(*header); - fe->addArg(*buffer); - fe->addArg(* new SgArrayRefExp(*Imem)); //Base - fe->addArg(*ConstRef(st_sign)); - fe->addArg(*DVM000(iplp)); - fe->addArg(*DVM000(iaxis)); - fe->addArg(*DVM000(icoeff)); - fe->addArg(*DVM000(iconst)); - fe->addArg(*DVM000(ilsh)); - fe->addArg(*DVM000(ihsh)); - - return(fe); -} -/**************************************************************\ -* Indirect access * -\**************************************************************/ -SgExpression *LoadIG(SgSymbol *group) -{ -//generating Function Call: -// loadig(GroupRef) -//loading buffers of group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADIG]); - fmask[LOADIG] = 1; - - fe->addArg(*GROUP_REF(group,1)); - return(fe); -} - -SgExpression *WaitIG(SgSymbol *group) -{ -//generating Function Call: -// waitig(GroupRef) -//waiting of completion of loading buffers of the group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITIG]); - fmask[WAITIG] = 1; - - fe->addArg(*GROUP_REF(group,1)); - return(fe); -} - -SgExpression *CreateIG(int st_sign,int del_sign) -{ -//generating Function Call: -// crtig(StaticSign,DelBufSign) -//creating group of buffers - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTIG]); - fmask[CRTIG] = 1; - - fe->addArg(*ConstRef(st_sign)); - fe->addArg(*ConstRef(del_sign)); - return(fe); -} - -SgExpression *InsertIndBuf(SgSymbol *group, SgExpression *buf) -{ -//generating Function Call: -// insib(GroupRef,BufferHeader[]) -//inserting buffer in the group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSIB]); - fmask[INSIB] = 1; - - fe->addArg(*GROUP_REF(group,1)); - fe->addArg(*buf); - return(fe); -} - -SgExpression *CreateIndBuf(SgExpression *header,SgExpression *buffer,int st_sign,SgExpression *mehead, int iconst) -{ -//generating Function Call: -// crtib(ArrayHeader[],BufferHeader[], Base,StaticSign,MEHeader[],ConstArray[]) - -//creating buffer for indirect access data - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTIB]); - fmask[CRTIB] = 1; - fe->addArg(*header); - fe->addArg(*buffer); - fe->addArg(* new SgArrayRefExp(*Imem)); //Base - fe->addArg(*ConstRef(st_sign)); - fe->addArg(*mehead); - fe->addArg(*DVM000(iconst)); - return(fe); -} - -SgExpression *LoadIndBuf(SgExpression *buf) -{ -//generating Function Call: -// loadib(BufferHeader) -//loading buffer - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADIB]); - fmask[LOADIB] = 1; - - fe->addArg(*buf); - return(fe); -} - -SgExpression *WaitIndBuf(SgExpression *buf) -{ -//generating Function Call: -// waitib(BufferHeader) -//waiting completion of loading buffer - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITIB]); - fmask[WAITIB] = 1; - - fe->addArg(*buf); - return(fe); -} -/* -SgExpression *DelIndBuf(SgExpression *buf) -{ -//generating Function Call: -// delib(BufferHeader) -//deleting buffer - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DELIB]); - fmask[DELIB] = 1; - - fe->addArg(*buf); - return(fe); -} -*/ - -/**************************************************************\ -* Getting array into consistent state * -\**************************************************************/ - -SgExpression *StartConsistent(SgExpression *header,int iplp,int iaxis,int icoeff,int iconst,int re_sign) -{ -//generating Function Call: -// strtac(ArrayHeader[],LoopRef, AxisArray[],CoeffArray[], ConstArray[], RenewSign ) -// -//start to get array into consistent state - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRTAC]); - fmask[STRTAC] = 1; - fe->addArg(*header); - fe->addArg(*DVM000(iplp)); - fe->addArg(*DVM000(iaxis)); - fe->addArg(*DVM000(icoeff)); - fe->addArg(*DVM000(iconst)); - fe->addArg(*ConstRef(re_sign)); - - return(fe); -} - -SgExpression *WaitConsistent(SgExpression *header) -{ -//generating Function Call: -// waitac(ArrayHeader) -// -//wait to get array into consistent state - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITAC]); - fmask[WAITAC] = 1; - fe->addArg(*header); - - return(fe); -} - -SgExpression *FreeConsistent(SgExpression *header) -{ -//generating Function Call: -// rstrda(ArrayHeader) -// -//free memory of consistent array - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RSTRDA]); - fmask[RSTRDA] = 1; - fe->addArg(*header); - - return(fe); -} - -SgExpression *CreateConsGroup(int st_sign,int del_sign) -{ -//generating Function Call: -// crtcg(StaticSign,DelArraySign) -//creating group of consistent arrays - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTCG]); - fmask[CRTCG] = 1; - - fe->addArg(*ConstRef(st_sign)); - fe->addArg(*ConstRef(del_sign)); - return(fe); -} - - -SgExpression *InsertConsGroup(SgExpression *gref,SgExpression *header,int iplp,int iaxis,int icoeff,int iconst,int re_sign) -{ -//generating Function Call: -// inscg(GroupRef,ArrayHeader[],LoopRef, AxisArray[],CoeffArray[], ConstArray[],RenewSign ) -// -//insert array into consistent group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSCG]); - fmask[INSCG] = 1; - fe->addArg(*gref); - fe->addArg(*header); - fe->addArg(*DVM000(iplp)); - fe->addArg(*DVM000(iaxis)); - fe->addArg(*DVM000(icoeff)); - fe->addArg(*DVM000(iconst)); - fe->addArg(*ConstRef(re_sign)); - return(fe); -} - -SgExpression *ExstractConsGroup(SgExpression *gref, int del_sign) -{ -//generating Function Call: -// rstcg(GroupRef,DelArraySign) -//extracting all consistent arrays from group - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RSTCG]); - fmask[RSTCG] = 1; - - fe->addArg(*gref); - fe->addArg(*ConstRef(del_sign)); - return(fe); -} - -SgExpression *StartConsGroup(SgExpression *gref) -{ -//generating Function Call: -// strtcg(GroupRef) -//starting of getting group of arrays into consistent state - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRTCG]); - fmask[STRTCG] = 1; - - fe->addArg(*gref); - return(fe); -} - -SgExpression *WaitConsGroup(SgExpression *gref) -{ -//generating Function Call: -// waitcg(GroupRef) -//waiting completion of getting group of arrays into consistent state - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITCG]); - fmask[WAITCG] = 1; - - fe->addArg(*gref); - return(fe); -} - -/**************************************************************\ -* Getting array into consistent state in Task_Region * -\**************************************************************/ -SgExpression *TaskConsistent(SgExpression *header,SgExpression *amvref, int iaxis, int re_sign) -{ -//generating Function Call: -// consda(ArrayHeader,AMViewRef,ArrayAxis,RenewSign) -// -//start to get array into consistent state in Task_Region - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CONSDA]); - fmask[CONSDA] = 1; - fe->addArg(*header); - fe->addArg(*amvref); //copy?? - fe->addArg(*DVM000(iaxis)); - fe->addArg(*ConstRef(re_sign)); - return(fe); -} - -SgExpression *IncludeConsistentTask(SgExpression *gref,SgExpression *header,SgExpression *amvref, int iaxis,int re_sign) -{ -//generating Function Call: -// inclcg(GroupRef,ArrayHeader,AMViewRef,ArrayAxis) -// -//include array into consistent group in Task_Region - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INCLCG]); - fmask[INCLCG] = 1; - fe->addArg(*gref); - fe->addArg(*header); - fe->addArg(*amvref); //copy?? - fe->addArg(*DVM000(iaxis)); - fe->addArg(*ConstRef(re_sign)); - return(fe); -} - -/**************************************************************\ -* Special ACROSS * -\**************************************************************/ - -SgExpression *DVM_Receive(int iplp,SgExpression *mem,int t,int is) -{ -//generating Function Call: -// dvm_rm(LoopRef,MemAddr,ElmType,ElmNumber) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMRM]); - fmask[DVMRM] = 1; - fe->addArg(*DVM000(iplp)); - fe->addArg(*mem); - fe->addArg(*ConstRef(t)); - fe->addArg(*DVM000(is)); - return(fe); -} - -SgExpression *DVM_Send(int iplp,SgExpression *mem,int t,int is) -{ -//generating Function Call: -// dvm_sm(LoopRef,MemAddr,ElmType,ElmNumber) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMSM]); - fmask[DVMSM] = 1; - fe->addArg(*DVM000(iplp)); - fe->addArg(*mem); - fe->addArg(*ConstRef(t)); - fe->addArg(*DVM000(is)); - return(fe); -} - - -/**************************************************************\ -* Miscellaneous functions * -\**************************************************************/ -SgExpression *GetRank(int iref) -{ -//generating Function Call: -// GetRnk(ObjectRef) -// requesting rank of object - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETRNK]); - fmask[GETRNK] = 1; - fe->addArg(*DVM000(iref)); - return(fe); -} - -SgExpression *GetSize(SgExpression *ref,int axis) -{ -//generating Function Call: -// GetSiz(ObjectRef, Axis) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETSIZ]); - fmask[GETSIZ] = 1; - fe->addArg(*ref); - fe->addArg(* ConstRef (axis)); - return(fe); -} - -SgExpression * TestIOProcessor () -{ -// creates function call: TstIOP() - fmask[TSTIOP] = 1; - return( new SgFunctionCallExp(*fdvm[TSTIOP])); -} - -SgExpression *DeleteObject(SgExpression *objref) -{ -//generating Function Call: -// delobj(ObjectRef) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DELOBJ]); - fmask[DELOBJ] = 1; - - fe->addArg(objref->copy()); - - return(fe); -} - -SgExpression *TestElement(SgExpression *head, int ind) -{ -//generating Function Call: -// tstelm(ArrayHeader, IndexArray); - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TSTELM]); - fmask[TSTELM] = 1; - - fe->addArg(head->copy()); - fe->addArg(*DVM000(ind)); - return(fe); -} - -SgStatement *SendMemory(int icount, int inda, int indl) -{ -//generating Subroutine Call: -// call srmem (MemoryCount, StartAddrArray, LengthArray); - send =1; - - SgCallStmt *call = new SgCallStmt(*fdvm[SRMEM]); - fmask[SRMEM] = 2; - - call->addArg(*ConstRef_F95(icount)); //addArg(*DVM000(icount)); - call->addArg(*DVM000(inda)); - call->addArg(*DVM000(indl)); - return(call); -} - -SgExpression *GetAddres(SgSymbol * var) -{ -//generating Function Call: -// GetAdr(Var) - - SgFunctionCallExp *fe; - int ind; - // ind = GETADR; - ind = NameIndex(Base_Type(var->type())); - fe = new SgFunctionCallExp(*fdvm[ind]); - fmask[ind] = 1; - fe->addArg(* new SgVarRefExp (* var)); - return(fe); -} - -SgExpression *GetAddresMem(SgExpression * em) -{ -//generating Function Call: -// GetAdr(Var) - - SgFunctionCallExp *fe; - int ind; - // ind = GETADR; - ind = NameIndex(Base_Type(em->type())); - fe = new SgFunctionCallExp(*fdvm[ind]); - fmask[ind] = 1; - fe->addArg(em->copy()); - return(fe); -} - -SgStatement *Addres(SgExpression * em) -{ -//generating assign statement: -// dvm000(ndvm)= GetAdr(Var) - - SgFunctionCallExp *fe; - int ind; - ind = NameIndex(Base_Type(em->type())); - fe = new SgFunctionCallExp(*fdvm[ind]); - fmask[ind] = 1; - fe->addArg(em->copy()); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -} - -SgExpression *GetAddresDVM(SgExpression * em) -{ -//generating Function Call: -// GetAdr(Var) - - SgFunctionCallExp *fe; - int ind; - // ind = GETADR; - ind = NameIndex(SgTypeInt()); //argument type of DVM-Lib functions (headers and others) - fe = new SgFunctionCallExp(*fdvm[ind]); - fmask[ind] = 1; - fe->addArg(em->copy()); - return(fe); -} - - -SgStatement *CloseFiles() -{ -//generating Subroutine Call: clfdvm() - - SgCallStmt *call = new SgCallStmt(*fdvm[CLFDVM]); - fmask[CLFDVM] = 2; - return(call); -} - -SgExpression *AddHeader(SgExpression *head_new,SgExpression *head ) -{ -//generating Function Call: addhdr(NewHeadRef, Headref) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ADDHDR]); - fmask[ADDHDR] =1; - fe->addArg(*head_new); - fe->addArg(*head); - return(fe); -} -/* -SgExpression *TypeControl(int n, int iadr) -{ -//generating Function Call: tpcntr(Numb,FirstAddr[],NextAddr[],Len[],Type[]) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TPCNTR]); - fmask[TPCNTR] =1; - fe->addArg(*ConstRef(n)); - fe->addArg(*DVM000(iadr)); - fe->addArg(*DVM000(iadr+n)); - fe->addArg(*DVM000(iadr+2*n)); - fe->addArg(*DVM000(iadr+3*n)); - return(fe); -} -*/ - -SgExpression *Barrier() -{ -//generating Function Call: -// bsynch() -//stoping task - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[BARRIER]); - fmask[BARRIER] = 1; - return(fe); -} -/**************************************************************\ -* Debugger functions * -\**************************************************************/ -SgStatement *D_RegistrateArray(int rank, int type, SgExpression *headref, SgExpression *size_array,SgExpression *arref) -{ -//generating Subroutine Call: drarr(Rank,Type,Addr,Size_array,Operand) - SgCallStmt *call = new SgCallStmt(*fdvm[DRARR]); - fmask[DRARR] = 2; - call->addArg(*ConstRef(rank)); - call->addArg(*ConstRef(type)); - call->addArg(*headref); - call->addArg(*size_array); - call->addArg(*new SgValueExp(UnparseExpr(arref))); - return(call); -} - -SgStatement *D_LoadVar(SgExpression *vref, int type, SgExpression *headref, SgExpression *opref) -{ -//generating Subroutine Call: dldv(TypePtr,Addr,Handle,Operand) - - SgCallStmt *call = new SgCallStmt(*fdvm[DLOADV]); - fmask[DLOADV] = 2; - call->addArg(*ConstRef(type)); - call->addArg(*GetAddresMem(vref)); - call->addArg(*headref); - call->addArg(*new SgValueExp(UnparseExpr(opref))); - return(call); -/* - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DLOADV]); - fmask[DLOADV] = 1; - fe->addArg(*ConstRef(type)); - fe->addArg(*GetAddresMem(vref)); - fe->addArg(*headref); - fe->addArg(*new SgValueExp(UnparseExpr(opref))); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -*/ -} - -SgStatement *D_LoadVar2(SgExpression *vref, int type, SgExpression *headref, SgExpression *opref) -{ -//generating Subroutine Call: dldv2(TypePtr,Addr,Handle,Operand) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DLOAD2]); - fmask[DLOAD2] = 1; - fe->addArg(*ConstRef(type)); - fe->addArg(*GetAddresMem(vref)); - fe->addArg(*headref); - fe->addArg(*new SgValueExp(UnparseExpr(opref))); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -} - -SgStatement *D_StorVar() -{ -//generating Subroutine Call: dstv() - - SgCallStmt *call = new SgCallStmt(*fdvm[DSTORV]); - fmask[DSTORV] = 2; - return(call); -/* - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DSTORV]); - fmask[DSTORV] = 1; - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -*/ -} - -SgStatement *D_PrStorVar(SgExpression *vref, int type, SgExpression *headref, SgExpression *opref) -{ -//generating Subroutine Call: dprstv(TypePtr,Addr,Handle,Operand) - SgCallStmt *call = new SgCallStmt(*fdvm[DPRSTV]); - fmask[DPRSTV] = 2; - call->addArg(*ConstRef(type)); - call->addArg(*GetAddresMem(vref)); - call->addArg(*headref); - call->addArg(*new SgValueExp(UnparseExpr(opref))); - return(call); - -/* - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DPRSTV]); - fmask[DPRSTV] = 1; - fe->addArg(*ConstRef(type)); - fe->addArg(*GetAddresMem(vref)); - fe->addArg(*headref); - fe->addArg(*new SgValueExp(UnparseExpr(opref))); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -*/ -} - -SgStatement *D_InOutVar(SgExpression *vref, int type, SgExpression *headref) -{ -//generating Subroutine Call: dinout(TypePtr,Addr,Handle) -/* - SgCallStmt *call = new SgCallStmt(*fdvm[DINOUT]); - //fmask[DINOUT] = 1; - call->addArg(*ConstRef(type)); - call->addArg(*GetAddresMem(vref)); - call->addArg(*headref); - return(call); -*/ - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DINOUT]); - fmask[DINOUT] = 1; - fe->addArg(*ConstRef(type)); - fe->addArg(*GetAddresMem(vref)); - fe->addArg(*headref); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -} - -SgStatement *D_Fname() -{ -//generating Subroutine Call: fname(FileName) -/* - SgCallStmt *call = new SgCallStmt(*fdvm[FNAME]); - call->addArg(*new SgValueExp(fin_name)); - return(call); -*/ - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[FNAME]); - fmask[FNAME] =1; - fe->addArg(*new SgValueExp(fin_name)); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -} - -SgStatement *D_Lnumb(int num_line) -{ -//generating Subroutine Call: lnumb(LineNumber) -/* - SgCallStmt *call = new SgCallStmt(*fdvm[LNUMB]); - call->addArg(*new SgValueExp(num_line)); - return(call); -*/ - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LNUMB]); - fmask[LNUMB] =1; - fe->addArg(*DVM000(num_line)); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -} - -SgStatement *D_FileLine(int num_line, SgStatement *stmt) -{ -//generating Subroutine Call: dvmlf(LineNumber,FileName) - - //char *fname; - filename_list *fn; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMLF]); - fmask[DVMLF] =1; - fe->addArg(*DVM000(num_line)); - fn = AddToFileNameList(stmt->fileName()); - //fname= new char[80]; - //sprintf(fname,"%s%s",stmt->fileName()," "); - //fe->addArg(* new SgValueExp(fname)); - fe->addArg(* new SgVarRefExp(fn->fns)); - ndvm++; - FREE_DVM(1); - return(new SgAssignStmt(*DVM000(ndvm),*fe)); -} - -SgStatement *D_DummyFileLine(int num_line, const char *fname) -{ -//generating Subroutine Call: dvmlf(LineNumber,FileName) - - filename_list *fn; - SgCallStmt *call = new SgCallStmt(*fdvm[DVMLF]); - fmask[DVMLF] =2; - call->addArg(*DVM000(num_line)); - fn = AddToFileNameList(fname); - call->addArg(* new SgVarRefExp(fn->fns)); - ndvm++; - FREE_DVM(1); - return(call); -} - -SgStatement *D_FileLineConst(int line, SgStatement *stmt) -{ -//generating Subroutine Call: call dvmlf(LineNumber,FileName) - - filename_list *fn; - SgCallStmt *call = new SgCallStmt(*fdvm[DVMLF]); - fmask[DVMLF] =2; - call->addArg(*ConstRef_F95(line)); - fn = AddToFileNameList(baseFileName(stmt->fileName())); - call->addArg(* new SgVarRefExp(fn->fns)); - return(call); -} - - -SgStatement *D_Begpl(int num_loop,int rank,int iinit) -{ -//generating Subroutine Call: dbegpl(Rank,No,InitArray,LastArray,StepArray) - SgCallStmt *call = new SgCallStmt(*fdvm[DBEGPL]); - fmask[DBEGPL] = 2; - call->addArg(*ConstRef(rank)); - call->addArg(*ConstRef_F95(num_loop));//addArg(*DVM000(num_loop)); - call->addArg(*DVM000(iinit)); - call->addArg(*DVM000(iinit+rank)); - call->addArg(*DVM000(iinit+2*rank)); - return(call); -} - -SgStatement *D_Begsl(int num_loop) -{ -//generating Subroutine Call: dbegsl(No) - SgCallStmt *call = new SgCallStmt(*fdvm[DBEGSL]); - fmask[DBEGSL] = 2; - call->addArg(*ConstRef_F95(num_loop)); //addArg(*DVM000(num_loop)); - return(call); -} - -SgStatement *D_Begtr(int num_treg) -{ -//generating Subroutine Call: dbegtr(No) - SgCallStmt *call = new SgCallStmt(*fdvm[DBEGTR]); - fmask[DBEGTR] = 2; - call->addArg(*DVM000(num_treg)); - return(call); -} - -SgExpression *doPLmb(int iloopref, int ino) -{ -//generating Function Call: -// doplmb(LoopRef,No) - - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DOPLMB]); - fmask[DOPLMB] = 1; - fe->addArg(*DVM000(iloopref)); - fe->addArg(*DVM000(ino)); - return(fe); -} - -SgExpression *doPLmbSEQ(int ino, int rank, int iout) -{ -//generating Function Call: -// doplmbseq(No, Rank, OutInit[], OutLast[], OutStep[]) - - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DOPLSEQ]); - fmask[DOPLSEQ] = 1; - fe->addArg(*DVM000(ino)); - fe->addArg(* ConstRef(rank)); - fe->addArg(*DVM000(iout)); - fe->addArg(*DVM000(iout+rank)); - fe->addArg(*DVM000(iout+2*rank)); - return(fe); -} - - -SgExpression *doSL(int num_loop,int iout) -{ -//generating Function Call: -// dosl(No, OutInit, OutLast, OutStep) - - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DOSL]); - fmask[DOSL] = 1; - fe->addArg(*ConstRef_F95(num_loop)); //addArg(*DVM000(num_loop)); - fe->addArg(*DVM000(iout)); - fe->addArg(*DVM000(iout+1)); - fe->addArg(*DVM000(iout+2)); - return(fe); -} - - -SgStatement *D_Skpbl() -{ -//generating Subroutine Call: dskpbl() - SgCallStmt *call = new SgCallStmt(*fdvm[DSKPBL]); - fmask[DSKPBL] = 2; - return(call); -} - -SgStatement *D_Endl(int num_loop, int begin_line ) -{ -//generating Subroutine Call: dendl(No,Line) - SgCallStmt *call = new SgCallStmt(*fdvm[DENDL]); - fmask[DENDL] = 2; - call->addArg(*ConstRef_F95(num_loop)); //addArg(*DVM000(num_loop)); - call->addArg(*ConstRef_F95(begin_line)); //addArg(*DVM000(begin_line)); - return(call); -} - -SgStatement *D_Iter(SgSymbol *do_var, int type) -{ -//generating Subroutine Call: diter(Index,TypeIndex) - SgCallStmt *call = new SgCallStmt(*fdvm[DITER]); - fmask[DITER] = 2; - call->addArg(*GetAddres(do_var)); - call->addArg(*ConstRef(type)); - return(call); -} - -SgStatement *D_Iter_I(int ind, int indtp) -{ -//generating Subroutine Call: diter(IndexArray,TypeIndexArray) - SgCallStmt *call = new SgCallStmt(*fdvm[DITER]); - fmask[DITER] = 2; - call->addArg(*DVM000(ind)); - call->addArg(*DVM000(indtp)); - return(call); -} - -SgStatement *D_Iter_ON(int ind, int type) -{ -//generating Subroutine Call: diter(Index,TypeIndex) - SgCallStmt *call = new SgCallStmt(*fdvm[DITER]); - fmask[DITER] = 2; - call->addArg(*GetAddresMem(DVM000(ind))); - call->addArg(*ConstRef(type)); - return(call); -} - -SgStatement *D_RmBuf(SgExpression *source_headref, SgExpression *buf_headref, int rank, int index) -{ -//generating Subroutine Call: drmbuf(Src,RmtBuff,Rank,Index) - - SgCallStmt *call = new SgCallStmt(*fdvm[DRMBUF]); - fmask[DRMBUF] = 2; - call->addArg(*source_headref ); - call->addArg(*buf_headref); - call->addArg(* ConstRef(rank)); - call->addArg(* DVM000(index)); - return(call); -} - -SgStatement *D_Read(SgExpression *adr) -{ -//generating Subroutine Call: -// dread(Addr); - - SgCallStmt *call = new SgCallStmt(*fdvm[DREAD]); - fmask[DREAD] = 2; - call->addArg(*adr); - return(call); -} - -SgStatement *D_ReadA(SgExpression *adr,int indel, int icount) -{ -//generating Subroutine Call: -// dreada(StartArrayAddr, ElemLength, ArrayLength); - SgCallStmt *call = new SgCallStmt(*fdvm[DREADA]); - fmask[DREADA] = 2; - call->addArg(*adr); - call->addArg(*DVM000(indel)); - call->addArg(*DVM000(icount)); - return(call); -} - -SgExpression * D_CreateDebRedGroup() -{ -//generating function call: -// dcrtrg() - - //int ig; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DCRRG]); - fmask[DCRRG] = 1; - return(fe); -} - -SgStatement *D_InsRedVar(SgExpression *dgref,int num_red, SgExpression *red_array, int ntype, int length, SgExpression *loc_array, int loc_length, int locindtype) -{ -//generating subroutine call: -// dinsrd(DebRedGroupref, RedFuncNumb, RedArray, RedArrayType, RedArrayLength, LocArray, LocElmLength, LocIndType) - SgCallStmt *call = new SgCallStmt(*fdvm[DINSRD]); - fmask[DINSRD] = 2; - - call->addArg(dgref->copy()); - call->addArg(*ConstRef(num_red)); - call->addArg(*GetAddresMem(red_array)); - call->addArg(*ConstRef(ntype)); - call->addArg(*DVM000(length)); - call->addArg(loc_array->copy()); - call->addArg(*DVM000(loc_length)); - call->addArg(*ConstRef(locindtype)); - return(call); -} - -SgExpression *D_SaveRG(SgExpression *dgref) -{ -//creating function call: -// dsavrg(DebRedGroupRef) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DSAVRG]); - fmask[DSAVRG] = 1; - fe->addArg(dgref->copy()); - return(fe); -} - -SgStatement *D_CalcRG(SgExpression *dgref) -{ -//creating subroutine call: -// dclcrg(DebRedGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[DCLCRG]); - fmask[DCLCRG] = 2; - call->addArg(dgref->copy()); - return(call); -} - -SgStatement *D_DelRG(SgExpression *dgref) -{ -//creating subroutine call: -// ddelrg(DebRedGroupRef) - SgCallStmt *call = new SgCallStmt(*fdvm[DDLRG]); - fmask[DDLRG] = 2; - call->addArg(dgref->copy()); - return(call); -} - -SgExpression *SummaOfDistrArray(SgExpression *headref, SgExpression *sumvarref) -{ -//creating function call: -// dacsum(HeaderArrayRef,CheckSum) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[DACSUM]); - fmask[DACSUM] = 1; - fe->addArg(*headref); - fe->addArg(*sumvarref); - return(fe); -} - -SgExpression *SummaOfArray(SgExpression *are, int rank, SgExpression *size, int ntype,SgExpression *sumvarref) -{ -//creating function call: -// arcsf(addrMem,Rank,SizeArray[],Type,CheckSum) - SgFunctionCallExp *fe; - fe = new SgFunctionCallExp(*fdvm[ARCSF]); - fmask[ARCSF] = 1; - fe->addArg(*GetAddresMem(are)); - fe->addArg(*ConstRef(rank)); - fe->addArg(*size); - fe->addArg(*ConstRef(ntype)); - fe->addArg(*sumvarref); - return(fe); -} - -SgStatement *D_PutDebugVarAdr(SgSymbol *dbg_var, int flag) -{ -//generating Subroutine Call: dvtr(dbgvar,flag) - SgCallStmt *call = new SgCallStmt(*fdvm[DVTR]); - fmask[DVTR] = 2; - call->addArg(*new SgVarRefExp(*dbg_var)); - call->addArg(*new SgValueExp(flag)); - return(call); -} -/**************************************************************\ -* Performance Analyzer functins * -\**************************************************************/ -SgStatement *St_Binter(int num_fragment, SgExpression *valvar) //(int num_fragment, int valvar) -{ -//generating Subroutine Call: binter(nfrag, valvar) - SgCallStmt *call = new SgCallStmt(*fdvm[BINTER]); - fmask[BINTER] = 2; - call->addArg(*ConstRef_F95(num_fragment)); //(*DVM000(num_fragment)); - call->addArg(*valvar); //(* DVM000(valvar)); - return(call); -} - -SgStatement *St_Einter(int num_fragment,int begin_line) -{ -//generating Subroutine Call: einter(nfrag,nline) - SgCallStmt *call = new SgCallStmt(*fdvm[EINTER]); - fmask[EINTER] = 2; - call->addArg(*ConstRef_F95(num_fragment)); //(*DVM000(num_fragment)); - call->addArg(*ConstRef_F95(begin_line)); // (*DVM000(begin_line)); - return(call); -} - -SgStatement *St_Bsloop(int num_fragment) -{ -//generating Subroutine Call: bsloop(nfrag) - SgCallStmt *call = new SgCallStmt(*fdvm[BSLOOP]); - fmask[BSLOOP] = 2; - call->addArg(*ConstRef_F95(num_fragment)); //addArg(*DVM000(num_fragment)); - return(call); -} - - -SgStatement *St_Bploop(int num_fragment) -{ -//generating Subroutine Call: bploop(nfrag) - SgCallStmt *call = new SgCallStmt(*fdvm[BPLOOP]); - fmask[BPLOOP] = 2; - call->addArg(*ConstRef_F95(num_fragment)); //addArg(*DVM000(num_fragment)); - return(call); -} - -SgStatement *St_Enloop(int num_fragment,int begin_line) -{ -//generating Subroutine Call: enloop(nfrag,nline) - SgCallStmt *call = new SgCallStmt(*fdvm[ENLOOP]); - fmask[ENLOOP] = 2; - call->addArg(*ConstRef_F95(num_fragment));//addArg(*DVM000(num_fragment)); - call->addArg(*ConstRef_F95(begin_line)); //addArg(*DVM000(begin_line)); - return(call); -} - -SgStatement *St_Biof() -{ -//generating Subroutine Call: biof() - SgCallStmt *call = new SgCallStmt(*fdvm[BIOF]); - fmask[BIOF] = 2; - return(call); -} - -SgStatement *St_Eiof() -{ -//generating Subroutine Call: eiof() - SgCallStmt *call = new SgCallStmt(*fdvm[EIOF]); - fmask[EIOF] = 2; - return(call); -} - - - -/**************************************************************\ -* FORTRAN 90 functins * -\**************************************************************/ - -SgExpression *SizeFunction(SgSymbol *ar, int i) -{//SgSymbol *symb_SIZE; - SgFunctionCallExp *fe; - if(!HEADER(ar)) { -// generating function call: SIZE(ARRAY, DIM) - if(!f90[SIZE]) //(!SIZE_function) - f90[SIZE] = new SgFunctionSymb(FUNCTION_NAME, "size", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[SIZE]); - fe -> addArg(*new SgArrayRefExp(*ar));//array - if(i != 0) - fe -> addArg(*new SgValueExp(i)); // dimension number - return(fe); - } else - return(GetSize(HeaderRefInd(ar,1),Rank(ar)-i+1)); -} - -SgExpression *SizeFunctionWithKind(SgSymbol *ar, int i, int kind) -{//SgSymbol *symb_SIZE; - SgFunctionCallExp *fe; - if(!HEADER(ar)) { -// generating function call: SIZE(ARRAY, DIM) - if(!f90[SIZE]) //(!SIZE_function) - f90[SIZE] = new SgFunctionSymb(FUNCTION_NAME, "size", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[SIZE]); - fe -> addArg(*new SgArrayRefExp(*ar));//array - if(i != 0) - fe -> addArg(*new SgValueExp(i)); // dimension number - if(kind != 0) - fe -> addArg(*new SgExpression(KIND_OP,new SgValueExp(kind),NULL,NULL)); // kind of type for result - - return(fe); - } else - return(GetSize(HeaderRefInd(ar,1),Rank(ar)-i+1)); -} - -SgExpression *LBOUNDFunction(SgSymbol *ar, int i) -{//SgSymbol *symb_SIZE; - SgFunctionCallExp *fe; -// generating function call: LBOUND(ARRAY, DIM) - if(!f90[LBOUND]) - f90[LBOUND] = new SgFunctionSymb(FUNCTION_NAME, "lbound", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[LBOUND]); - fe -> addArg(*new SgArrayRefExp(*ar));//array - if(i != 0) - fe -> addArg(*new SgValueExp(i)); // dimension number - - return(fe); -} - -SgExpression *UBOUNDFunction(SgSymbol *ar, int i) -{//SgSymbol *symb_SIZE; - SgFunctionCallExp *fe; -// generating function call: UBOUND(ARRAY, DIM) - if(!f90[UBOUND]) - f90[UBOUND] = new SgFunctionSymb(FUNCTION_NAME, "ubound", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[UBOUND]); - fe -> addArg(*new SgArrayRefExp(*ar));//array - if(i != 0) - fe -> addArg(*new SgValueExp(i)); // dimension number - - return(fe); -} - -SgExpression *LENFunction(SgSymbol *string) -{ - SgFunctionCallExp *fe; -// generating function call: LEN(STRING) - if(!f90[LEN]) - f90[LEN] = new SgFunctionSymb(FUNCTION_NAME, "len", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[LEN]); - fe -> addArg(*new SgVarRefExp(*string));//string - - return(fe); -} - -SgExpression *CHARFunction(int i) -{ - SgFunctionCallExp *fe; -// generating function call: CHAR(I) - if(!f90[CHAR]) - f90[CHAR] = new SgFunctionSymb(FUNCTION_NAME, "char", *SgTypeChar(), *cur_func); - fe = new SgFunctionCallExp(*f90[CHAR]); - fe -> addArg(*new SgValueExp(i)); - - return(fe); -} - -SgExpression *TypeFunction(SgType *t, SgExpression *e, SgExpression *ke) -{int i = -1; - SgFunctionCallExp *fe; - SgExpression *kke; - -// generating function call: INT(e,KIND(ke)), REAL(e,KIND(ke)),... - switch(t->variant()) { - case T_INT: if(!f90[F_INT]) - f90[F_INT] = new SgFunctionSymb(FUNCTION_NAME, "int", *SgTypeInt(), *cur_func); - i = F_INT; - break; - - case T_BOOL: if(!f90[F_LOGICAL]) - f90[F_LOGICAL] = new SgFunctionSymb(FUNCTION_NAME, "logical", *SgTypeBool(), *cur_func); - i = F_LOGICAL; - break; - case T_FLOAT: - case T_DOUBLE: if(!f90[F_REAL]) - f90[F_REAL] = new SgFunctionSymb(FUNCTION_NAME, "real", *SgTypeFloat(), *cur_func); - i = F_REAL; - break; - - case T_COMPLEX: - case T_DCOMPLEX: if(!f90[F_CMPLX]) - f90[F_CMPLX] = new SgFunctionSymb(FUNCTION_NAME, "cmplx", *SgTypeComplex(current_file), *cur_func); - i = F_CMPLX; - break; - - case T_STRING: - case T_CHAR: if(!f90[F_CHAR]) - f90[F_CHAR] = new SgFunctionSymb(FUNCTION_NAME, "char", *SgTypeChar(), *cur_func); - i = F_CHAR; - break; - - - default: break; - } - fe = new SgFunctionCallExp(*f90[i]); - fe -> addArg(e->copy()); - if(ke) - { kke = (i==F_CMPLX) ? new SgKeywordArgExp("kind",*ke) : ke; - fe -> addArg(*kke); - } - return(fe); -} - -SgExpression *KINDFunction(SgExpression *arg) -{ - SgFunctionCallExp *fe; -// generating function call: KIND(arg) - if(!f90[KIND]) - f90[KIND] = new SgFunctionSymb(FUNCTION_NAME, "kind", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[KIND]); - fe -> addArg(*arg); - - return(fe); -} - -SgExpression *MaxFunction(SgExpression *arg1,SgExpression *arg2) -{ - SgFunctionCallExp *fe; -// generating function call: MAX(arg1,arg2) - if(!f90[MAX_]) - //f90[MAX_] = new SgFunctionSymb(FUNCTION_NAME); - f90[MAX_] = new SgFunctionSymb(FUNCTION_NAME, "max", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[MAX_]); - fe -> addArg(*arg1); - fe -> addArg(*arg2); - - return(fe); -} - -SgExpression *MinFunction(SgExpression *arg1,SgExpression *arg2) -{ - SgFunctionCallExp *fe; -// generating function call: MIN(arg1,arg2) - if(!f90[MIN_]) - - f90[MIN_] = new SgFunctionSymb(FUNCTION_NAME, "min", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[MIN_]); - fe -> addArg(*arg1); - fe -> addArg(*arg2); - - return(fe); -} - -SgExpression *IandFunction(SgExpression *arg1,SgExpression *arg2) -{ - SgFunctionCallExp *fe; -// generating function call: IAND(arg1,arg2) - if(!f90[IAND_]) - - f90[IAND_] = new SgFunctionSymb(FUNCTION_NAME, "iand", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[IAND_]); - fe -> addArg(*arg1); - fe -> addArg(*arg2); - - return(fe); -} - -SgExpression *IorFunction(SgExpression *arg1,SgExpression *arg2) -{ - SgFunctionCallExp *fe; -// generating function call: IOR(arg1,arg2) - if(!f90[IOR_]) - - f90[IOR_] = new SgFunctionSymb(FUNCTION_NAME, "ior", *SgTypeInt(), *cur_func); - fe = new SgFunctionCallExp(*f90[IOR_]); - fe -> addArg(*arg1); - fe -> addArg(*arg2); - - return(fe); -} - -SgExpression *AllocatedFunction(SgExpression *arg) -{ - SgFunctionCallExp *fe; -// generating function call: ALLOCATED(arg) - if(!f90[ALLOCATED_]) - - f90[ALLOCATED_] = new SgFunctionSymb(FUNCTION_NAME, "allocated", *SgTypeBool(), *cur_func); - fe = new SgFunctionCallExp(*f90[ALLOCATED_]); - fe -> addArg(*arg); - - return(fe); -} - -SgExpression *AssociatedFunction(SgExpression *arg) -{ - SgFunctionCallExp *fe; -// generating function call: ASSOCIATED(arg) - if(!f90[ASSOCIATED_]) - - f90[ASSOCIATED_] = new SgFunctionSymb(FUNCTION_NAME, "associated", *SgTypeBool(), *cur_func); - fe = new SgFunctionCallExp(*f90[ASSOCIATED_]); - fe -> addArg(*arg); - - return(fe); -} - -/**************************************************************\ -* C functins * -\**************************************************************/ - -SgExpression *mallocFunction(SgExpression *arg, SgStatement *scope) -{ - SgFunctionCallExp *fe; -// generating function call: -// malloc(arg) - - SgSymbol *sf = new SgFunctionSymb(FUNCTION_NAME, "malloc", *C_PointerType(C_VoidType()), *scope); - fe = new SgFunctionCallExp(*sf); - fe -> addArg(*arg); - - return(fe); -} - -SgExpression *freeFunction(SgExpression *arg, SgStatement *scope) -{ - SgFunctionCallExp *fe; -// generating function call: -// free(arg) - - SgSymbol *sf = new SgFunctionSymb(FUNCTION_NAME, "free", *C_VoidType(), *scope); - fe = new SgFunctionCallExp(*sf); - fe -> addArg(*arg); - - return(fe); -} - - -/**************************************************************\ -* ACC * -* Generating RTS2 Function Calls * -\**************************************************************/ - -SgStatement *RTL_GPU_Init() -{// generating subroutine call: call dvmh_init(DvmType *flagsRef) -// flags: 1 - Fortran, 2 - without regions (-noH), -// 4 - sequential program (-s), 8 - OpenMP will be used. - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_INIT]); - fmask[DVMH_INIT] = 2; - call -> addArg(*DVM000(ndvm)); - if(!only_debug && (ACC_program || parloop_by_handler)) - call -> addComment(OpenMpComment_InitFlags(ndvm)); - - int flag = 1; - if(only_debug) - flag = flag + 4; - else if(!ACC_program) - flag = flag + 2; - doAssignStmtAfter(new SgValueExp(flag)); - FREE_DVM(1); - doCallAfter(call); - return(call); -} - -SgStatement *Exit_2(int code) -{// generating subroutine call: call dvmh_exit(const DvmType *pExitCode) - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_EXIT]); - fmask[DVMH_EXIT] = 2; - call -> addArg(*ConstRef(code)); - return(call); -} - -SgStatement *RTL_GPU_Finish() -{// generating subroutine call: call dvmh_finish() - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_FINISH]); - fmask[DVMH_FINISH] = 2; - return(call); -} - -SgStatement *Init_Cuda() -{// generating subroutine call: call init_cuda() - SgCallStmt *call = new SgCallStmt(*fdvm[INIT_CUDA]); - fmask[INIT_CUDA] = 2; - cur_st->insertStmtAfter(*call,*cur_st->controlParent()); - cur_st = call; - return(call); -} - -SgExpression *RegionCreate(int flag) -{ // generating function call: region_create(FlagsRef) or dvmh_region_create (when RTS2 is used) - int fNum = INTERFACE_RTS2 ? REG_CREATE_2 : REG_CREATE; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - fmask[fNum] = 1; - - if(flag==0) - fe->addArg(*ConstRef(flag)); - else - { SgSymbol *symb; - symb = region_const[flag]; - fe->addArg(*new SgVarRefExp(*symb)); - } - return(fe); -} - -SgStatement *StartRegion(int irgn) -{ // generating Subroutine call: region_inner_start(DvmhRegionRef) - SgCallStmt *call = new SgCallStmt(*fdvm[REG_START]); - fmask[REG_START] = 2; - call -> addArg(*DVM000(irgn)); - return(call); -} - -SgStatement *RegionForDevices(int irgn, SgExpression *devices) -{ // generating Subroutine call: region_execute_on_targets(DvmType *curRegion, DvmType *deviceTypes) - // or for RTS2 - // dvmh_region_execute_on_targets(DvmType *curRegion, DvmType *deviceTypes) - int fNum = INTERFACE_RTS2 ? REG_DEVICES_2 : REG_DEVICES; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*devices); - return(call); -} - -/* -SgExpression *RegistrateDataRegion() -{ // generating function call: crt_data_region_gpu() - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DATAREG_GPU]); - fmask[DATAREG_GPU] = 1; - return(fe); -} -*/ - -SgStatement *EndRegion(int irgn) -{ // generating Subroutine call: region_end(DvmhRegionRef) or dvmh_region_end (when RTS2 is used) - int fNum = INTERFACE_RTS2 ? REG_END_2 : REG_END; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - call -> addArg(*DVM000(irgn)); - return(call); -} - -/* -SgStatement *UnRegistrateDataRegion(int n) -{ // generating Subroutine call: end_data_region_gpu(InOutDataRegionGpu) - SgCallStmt *call = new SgCallStmt(*fdvm[ENDDATAREG_GPU]); - fmask[ENDDATAREG_GPU] = 2; - call -> addArg(*GPU000(n)); - return(call); -} -*/ -/* -SgStatement *RegistrateDVMArray(SgSymbol *ar,int ireg,int inflag,int outflag) -{ //generating Subroutine Call: - // crtda_gpu(InRegionGpu, InDvmArray[], OutDvmGpuArray[], InDeviceBaseAddr, InCopyinFlag, InCopyoutFlag) - SgExpression *gpubase; - SgCallStmt *call = new SgCallStmt(*fdvm[CRTDA_GPU]); - fmask[CRTDA_GPU] = 2; - - gpubase = new SgArrayRefExp(*baseGpuMemory(ar->type()->baseType())); - call -> addArg(*GPU000(ireg)); - call -> addArg(*HeaderRef(ar)); - call -> addArg(*GpuHeaderRef(ar)); - call -> addArg(*gpubase); - call -> addArg(*ConstRef(inflag)); - call -> addArg(*ConstRef(outflag)); - - return(call); -} -*/ - -SgStatement *RegisterScalar(int irgn,SgSymbol *c_intent,SgSymbol *s) -{ //generating Subroutine Call: - // region_register_scalar(DvmhRegionRef, intentRef, addr, sizeRef, varType) - int ntype; - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SCALAR]); - fmask[RGSTR_SCALAR] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - call -> addArg(*new SgVarRefExp(s)); - if(isSgArrayType(s->type())) - call -> addArg(*TypeFunction(SgTypeInt(),ArrayLength(s,cur_region->region_dir,0), new SgValueExp(DVMTypeLength()))); - else - call -> addArg(*ConstRef_F95(TypeSize(s->type()))); - ntype = VarType_RTS(s); // as for reduction variables - ntype = ntype ? ntype : -1; // unknown type - call -> addArg(*ConstRef_F95(ntype) ); - return(call); -} - -SgStatement *RegionRegisterScalar(int irgn,SgSymbol *c_intent,SgSymbol *s) -{ //generating Subroutine Call: - // dvmh_region_register_scalar(const DvmType *pCurRegion, const DvmType *pIntent, const void *addr, const DvmType *pTypeSize,const DvmType *pVarNameStr) - int ntype; - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SCALAR_2]); - fmask[RGSTR_SCALAR_2] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - call -> addArg(*new SgVarRefExp(s)); - call -> addArg(*TypeSize_RTS2(s->type())); - call -> addArg(*DvmhString(new SgValueExp(s->identifier()))); - return(call); -} - -SgStatement *RegisterSubArray(int irgn, SgSymbol *c_intent, SgSymbol *ar, int ilow, int ihigh) -{ //generating Subroutine Call: - // region_register_subarray(DvmhRegionRef, intentRef, dvmDesc[], lowIndex[], highIndex[], elemType) - - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SUBARRAY]); - fmask[RGSTR_SUBARRAY] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - if(HEADER(ar)) //DVM-array - call -> addArg(*HeaderRef(ar)); - else // replicated array - call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); - call -> addArg(*DVM000(ilow)); - call -> addArg(*DVM000(ihigh)); - call -> addArg(*ConstRef_F95( TestType_DVMH(ar->type()))); - return(call); -} - -SgStatement *RegionRegisterSubArray(int irgn, SgSymbol *c_intent, SgSymbol *ar, SgExpression *index_list) -{ //generating Subroutine Call: - // dvmh_region_register_subarray(const DvmType *pCurRegion, const DvmType *pIntent, const DvmType dvmDesc[], const DvmType *pVarNameStr, - // const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */... ) - - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SUBARRAY_2]); - fmask[RGSTR_SUBARRAY_2] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - if(HEADER(ar)) //DVM-array - call -> addArg(*HeaderRef(ar)); - else // replicated array - call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); - call->addArg(*DvmhString(new SgValueExp(ar->identifier()))); - call -> addArg(*ConstRef_F95(Rank(ar))); - call -> addArg(*index_list); - return(call); -} - -SgStatement *RegisterArray(int irgn, SgSymbol *c_intent, SgSymbol *ar) -{ //generating Subroutine Call: - // region_register_array(DvmhRegionRef, intentRef, dvmDesc[], elemType) - - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_ARRAY]); - fmask[RGSTR_ARRAY] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - if(HEADER(ar)) //DVM-array or TEMPLATE - call -> addArg(*HeaderRef(ar)); - else // replicated array - call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); - call -> addArg(*ConstRef_F95( TestType_DVMH(ar->type()))); - return(call); -} - -SgStatement *RegionRegisterArray(int irgn, SgSymbol *c_intent, SgSymbol *ar) -{ //generating Subroutine Call: - // dvmh_region_register_array(const DvmType *pCurRegion, const DvmType *pIntent, const DvmType dvmDesc[], const DvmType *pVarNameStr) - - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_ARRAY_2]); - fmask[RGSTR_ARRAY_2] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - if(HEADER(ar)) //DVM-array or TEMPLATE - call -> addArg(*HeaderRef(ar)); - else // replicated array - call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); - call -> addArg(*DvmhString(new SgValueExp(ar->identifier()))); - return(call); -} - -SgStatement *Dvmh_Line(int line, SgStatement *stmt) -{ // generating Subroutine call: - // dvmh_line(const DvmType *pLineNumber, const DvmType *pFileNameStr) - - filename_list *fn; - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_LINE]); - fmask[DVMH_LINE] =2; - call->addArg(*ConstRef_F95(line)); - fn = AddToFileNameList(baseFileName(stmt->fileName())); - call->addArg(*DvmhString(new SgVarRefExp(fn->fns))); - return(call); -} - - -SgExpression *DvmhString(SgExpression *s) -{ - // generating function call: dvmh_string(const char s[]) - - fmask[STRING] = 1; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRING]); - fe->addArg(*s); - return fe; -} - - -SgExpression *DvmhStringVariable(SgExpression *v) -{ - // generates function call: dvmh_string_variable (char s[]) - - fmask[STRING_VAR] = 1; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRING_VAR]); - fe->addArg(*v); - return fe; - -} - -SgExpression *DvmhVariable(SgExpression *v) -{ - // generates function call: dvmh_get_addr(void *pVariable) - - fmask[GET_ADDR] = 1; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_ADDR]); - fe->addArg(*v); - return fe; - -} - -SgExpression *HasElement(SgExpression *ar_header, int n, SgExpression *index_list) -{ - // generates function call: - // dvmh_has_element(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndex */...); - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_HAS_ELEMENT]); - fmask[DVMH_HAS_ELEMENT] = 1; - fe->addArg(*ar_header); - fe->addArg(*ConstRef_F95(n)); - AddListToList(fe->lhs(),index_list); - return fe; - -} - -SgExpression *CalculateLinear(SgExpression *ar_header, int n, SgExpression *index_list) -{ - // generates function call: - // dvmh_calc_linear(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pGlobalIndex */...); - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CALC_LINEAR]); - fmask[CALC_LINEAR] = 1; - fe->addArg(*ar_header); - fe->addArg(*ConstRef_F95(n)); - AddListToList(fe->lhs(),index_list); - return fe; - -} - -SgStatement *SaveCheckpointFilenames(SgExpression *cpName, std::vector filenames) { - fmask[CP_SAVE_FILENAMES] = 2; - SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_SAVE_FILENAMES]); - callStmt->addArg(*DvmhString(cpName)); - - SgExpression *filenamesLength = DvmType_Ref(new SgValueExp((int) filenames.size())); - callStmt->addArg(*filenamesLength); - - std::vector::iterator it = filenames.begin(); - for (; it != filenames.end(); it++) { - callStmt->addArg(*DvmhString(*it)); - } - return callStmt; -} - - -SgStatement *CheckFilename(SgExpression *cpName, SgExpression *filename) { - fmask[CP_CHECK_FILENAME] = 2; - SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_CHECK_FILENAME]); - callStmt->addArg(*DvmhString(cpName)); - callStmt->addArg(*DvmhString(filename)); - - return callStmt; - -} - -SgStatement *CpWait(SgExpression *cpName, SgExpression *statusVar) { - fmask[CP_WAIT] = 2; - SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_WAIT]); - callStmt->addArg(*DvmhString(cpName)); - callStmt->addArg(*DvmhVariable(statusVar)); - return callStmt; -} - -SgStatement *CpSaveAsyncUnit(SgExpression *cpName, SgExpression *file, SgExpression *unit) { - fmask[CP_SAVE_ASYNC_UNIT] = 2; - SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_SAVE_ASYNC_UNIT]); - callStmt->addArg(*DvmhString(cpName)); - callStmt->addArg(*DvmhString(file)); - callStmt->addArg(*DvmType_Ref(unit)); - return callStmt; -} - -SgStatement *GetNextFilename(SgExpression *cpName, SgExpression *lastFile, SgExpression *currentFile) { - fmask[CP_NEXT_FILENAME] = 2; - SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_NEXT_FILENAME]); - callStmt->addArg(*DvmhString(cpName)); - callStmt->addArg(*DvmhString(lastFile)); - callStmt->addArg(*DvmhStringVariable(currentFile)); - - return callStmt; -} - -/* -SgStatement *RegisterBufferArray(int irgn, SgSymbol *c_intent, SgExpression *bufref, int ilow, int ihigh) -{ //generating Subroutine Call: - // region_register_subarray(DvmhRegionRef, intentRef, dvmDesc[], lowIndex[], highIndex[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SUBARRAY]); - fmask[RGSTR_SUBARRAY] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*new SgVarRefExp(c_intent)); - call -> addArg(*bufref); - call -> addArg(*DVM000(ilow)); - call -> addArg(*DVM000(ihigh)); - return(call); -} -*/ - -SgStatement *SetArrayName(int irgn, SgSymbol *ar) -{ //generating Subroutine Call: - // region_set_name_array(DvmhRegionRef *regionRef, long dvmDesc[], const char *name) - - SgCallStmt *call = new SgCallStmt(*fdvm[SET_NAME_ARRAY]); - fmask[SET_NAME_ARRAY] = 2; - - call -> addArg(*DVM000(irgn)); - - if(HEADER(ar)) //DVM-array - call -> addArg(*HeaderRef(ar)); - else // replicated array - call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); - call -> addArg(*new SgValueExp(ar->identifier())); - return(call); -} - -SgStatement *SetVariableName(int irgn, SgSymbol *var) -{ //generating Subroutine Call: - // region_set_name_variable(DvmhRegionRef *regionRef, void *addr, const char *name) - - SgCallStmt *call = new SgCallStmt(*fdvm[SET_NAME_VAR]); - fmask[SET_NAME_VAR] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(* new SgVarRefExp(var)); - call -> addArg(*new SgValueExp(var->identifier())); - return(call); -} - -SgStatement *RegionBeforeLoadrb(SgExpression *bufref) -{ //generating Subroutine Call: - // dvmh_remote_access( dvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[BEFORE_LOADRB]); - fmask[BEFORE_LOADRB] = 2; - - call -> addArg(*bufref); - return(call); -} - -SgStatement *RegionAfterWaitrb(int irgn, SgExpression *bufref) -{ //generating Subroutine Call: - // region_after_waitrb(DvmhRegionRef, dvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[REG_WAITRB]); - fmask[REG_WAITRB] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*bufref); - return(call); -} - -SgStatement *RegionDestroyRb(int irgn, SgExpression *bufref) -{ //generating Subroutine Call: - // region_destroy_rb(DvmhRegionRef, dvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[REG_DESTROY_RB]); - fmask[REG_DESTROY_RB] = 2; - - call -> addArg(*DVM000(irgn)); - call -> addArg(*bufref); - return(call); -} - -SgStatement *ActualScalar(SgSymbol *s) -{ //generating Subroutine Call: - // dvmh_actual_variable(addr) - // or when RTS2 is used - // dvmh_actual_variable2(const void *addr) - int fNum = INTERFACE_RTS2 ? ACTUAL_SCALAR_2 : ACTUAL_SCALAR; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - call -> addArg(*new SgVarRefExp(s)); - - return(call); -} - -SgStatement *ActualSubVariable(SgSymbol *s, int ilow, int ihigh) -{ //generating Subroutine Call: - // dvmh_actual_subvariable(addr, lowIndex[], highIndex[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBVAR]); - fmask[ACTUAL_SUBVAR] = 2; - - call -> addArg(*new SgVarRefExp(s)); - call -> addArg(*DVM000(ilow)); - call -> addArg(*DVM000(ihigh)); - - return(call); -} - -SgStatement *ActualSubVariable_2(SgSymbol *s, int rank, SgExpression *index_list) -{ //generating Subroutine Call: - // dvmh_actual_subvariable2(const void *addr, const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...) - - SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBVAR_2]); - fmask[ACTUAL_SUBVAR_2] = 2; - - call -> addArg(*new SgVarRefExp(s)); - call -> addArg(*ConstRef(rank)); - AddListToList(call->expr(0),index_list); - return(call); -} - - -SgStatement *ActualSubArray(SgSymbol *ar, int ilow, int ihigh) -{ //generating Subroutine Call: - // dvmh_actual_subarray(dvmDesc[], lowIndex[], highIndex[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBARRAY]); - fmask[ACTUAL_SUBARRAY] = 2; - - call -> addArg(*HeaderRef(ar)); - call -> addArg(*DVM000(ilow)); - call -> addArg(*DVM000(ihigh)); - return(call); -} - -SgStatement *ActualSubArray_2(SgSymbol *ar, int rank, SgExpression *index_list) -{ //generating Subroutine Call: - // dvmh_actual_subarray2(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...) - - SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBARRAY_2]); - fmask[ACTUAL_SUBARRAY_2] = 2; - - call -> addArg(*HeaderRef(ar)); - call -> addArg(*ConstRef(rank)); - AddListToList(call->expr(0),index_list); - return(call); -} - -SgStatement *ActualArray(SgSymbol *ar) -{ //generating Subroutine Call: - // dvmh_actual_array(dvmDesc[]) - // or when RTS2 is used - // dvmh_actual_array2(const DvmType dvmDesc[]) - int fNum = INTERFACE_RTS2 ? ACTUAL_ARRAY_2 : ACTUAL_ARRAY; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - call -> addArg(*HeaderRef(ar)); - return(call); -} - -SgStatement *ActualAll() -{ //generating Subroutine Call: - // dvmh_actual_all() - // or when RTS2 is used - // dvmh_actual_all2() - int fNum = INTERFACE_RTS2 ? ACTUAL_ALL_2 : ACTUAL_ALL; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - return(call); -} - -SgStatement *GetActualScalar(SgSymbol *s) -{ //generating Subroutine Call: - // dvmh_get_actual_variable(addr) - // or when RTS2 is used - // dvmh_get_actual_variable2(void *addr) - int fNum = INTERFACE_RTS2 ? GET_ACTUAL_SCALAR_2 : GET_ACTUAL_SCALAR; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - call -> addArg(*new SgVarRefExp(s)); - - return(call); -} - -SgStatement *GetActualSubVariable(SgSymbol *s, int ilow, int ihigh) -{ //generating Subroutine Call: - // dvmh_get_actual_subvariable(addr, lowIndex[], highIndex[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBVAR]); - fmask[GET_ACTUAL_SUBVAR] = 2; - - call -> addArg(*new SgVarRefExp(s)); - call -> addArg(*DVM000(ilow)); - call -> addArg(*DVM000(ihigh)); - - return(call); -} - -SgStatement *GetActualSubVariable_2(SgSymbol *s, int rank, SgExpression *index_list) -{ //generating Subroutine Call: - // dvmh_get_actual_subvariable2(void *addr, const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...); - - SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBVAR_2]); - fmask[GET_ACTUAL_SUBVAR_2] = 2; - - call -> addArg(*new SgVarRefExp(s)); - call -> addArg(*ConstRef(rank)); - AddListToList(call->expr(0),index_list); - return(call); -} - -SgStatement *GetActualSubArray(SgSymbol *ar, int ilow, int ihigh) -{ //generating Subroutine Call: - // dvmh_get_actual_subarray(dvmDesc[], lowIndex[], highIndex[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBARRAY]); - fmask[GET_ACTUAL_SUBARRAY] = 2; - - call -> addArg(*HeaderRef(ar)); - call -> addArg(*DVM000(ilow)); - call -> addArg(*DVM000(ihigh)); - return(call); -} - -SgStatement *GetActualSubArray_2(SgSymbol *ar, int rank, SgExpression *index_list) -{ //generating Subroutine Call: - // dvmh_get_actual_subarray2_(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...) - SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBARR_2]); - fmask[GET_ACTUAL_SUBARR_2] = 2; - - call -> addArg(*HeaderRef(ar)); - call -> addArg(*ConstRef(rank)); - AddListToList(call->expr(0),index_list); - return(call); -} - -SgStatement *GetActualArray(SgExpression *objref) -{ //generating Subroutine Call: - // dvmh_get_actual_array(dvmDesc[]) - // or when RTS2 is used - // dvmh_get_actual_array2(const DvmType dvmDesc[]) - int fNum = INTERFACE_RTS2 ? GET_ACTUAL_ARR_2 : GET_ACTUAL_ARRAY; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - call -> addArg(*objref); //(*HeaderRef(ar)); - return(call); -} - -SgStatement *GetActualAll() -{ //generating Subroutine Call: - // dvmh_get_actual_all() - // or when RTS2 is used - // dvmh_get_actual_all2() - int fNum = INTERFACE_RTS2 ? GET_ACTUAL_ALL_2 : GET_ACTUAL_ALL; - SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); - fmask[fNum] = 2; - - return(call); -} - -SgStatement *DestroyArray(SgExpression *objref) -{ //generating Subroutine Call: - // dvmh_destroy_array(dvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[DESTROY_ARRAY]); - fmask[DESTROY_ARRAY] = 2; - - call -> addArg(*objref); //(*HeaderRef(ar)); - return(call); -} - -SgStatement *DestroyScalar(SgExpression *objref) -{ //generating Subroutine Call: - // dvmh_destroy_variable(addr) - - SgCallStmt *call = new SgCallStmt(*fdvm[DESTROY_SCALAR]); - fmask[DESTROY_SCALAR] = 2; - - call -> addArg(*objref); - return(call); -} - -SgStatement *DeleteObject_H(SgExpression *objref) -{ -//generating Subroutine Call: -// dvmh_delete_object(ObjectRef) - - SgCallStmt *call = new SgCallStmt(*fdvm[DELETE_OBJECT]); - fmask[DELETE_OBJECT] = 2; - - call->addArg(objref->copy()); - - return(call); -} - -SgStatement *ForgetHeader(SgExpression *objref) -{ -//generating Subroutine Call: -// dvmh_forget_header(DvmType dvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[FORGET_HEADER]); - fmask[FORGET_HEADER] = 2; - - call->addArg(*objref); - - return(call); -} - - -SgStatement *ScopeStart() -{ -//generating Subroutine Call: -// dvmh_scope_start() - - SgCallStmt *call = new SgCallStmt(*fdvm[SCOPE_START]); - fmask[SCOPE_START] = 2; - - return(call); -} - -SgStatement *ScopeEnd() -{ -//generating Subroutine Call: -// dvmh_scope_end() - - SgCallStmt *call = new SgCallStmt(*fdvm[SCOPE_END]); - fmask[SCOPE_END] = 2; - - return(call); -} - -SgStatement *ScopeInsert(SgExpression *objref) -{ -//generating Subroutine Call: -// dvmh_scope_insert(dvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[SCOPE_INSERT]); - fmask[SCOPE_INSERT] = 2; - call -> addArg(*objref); - return(call); -} - - -SgStatement *DataEnter(SgExpression *objref, SgExpression *esize) -{ //generating Subroutine Call: - // dvmh_data_enter(addr,size) - - SgCallStmt *call = new SgCallStmt(*fdvm[DATA_ENTER]); - fmask[DATA_ENTER] = 2; - - call -> addArg(*objref); - call -> addArg(*esize); - return(call); -} - -SgStatement *DataExit(SgExpression *objref, int saveFlag) -{ //generating Subroutine Call: - // dvmh_data_exit(addr,saveFlag) - - SgCallStmt *call = new SgCallStmt(*fdvm[DATA_EXIT]); - fmask[DATA_EXIT] = 2; - - call -> addArg(*objref); - call -> addArg(*ConstRef(saveFlag)); - return(call); -} - - -SgStatement *Redistribute_H(SgExpression *objref, int new_sign) -{ //generating Subroutine Call: - // dvmh_redistribute(dvmDesc[], newValueFlagRef) - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REDISTRIBUTE]); - fmask[DVMH_REDISTRIBUTE] = 2; - - call -> addArg(*objref); //(*HeaderRef(ar)); - call -> addArg(*ConstRef(new_sign)); - return(call); -} - -SgStatement *Realign_H(SgExpression *objref, int new_sign) -{ //generating Subroutine Call: - // dvmh_align(dvmDesc[], newValueFlagRef) - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REALIGN]); - fmask[DVMH_REALIGN] = 2; - - call -> addArg(*objref); //(*HeaderRef(ar)); - call -> addArg(*ConstRef(new_sign)); - return(call); -} - - -SgStatement *HandleConsistent(SgExpression *gref) -{ -//generating Subroutine Call: -// dvmh_handle_consistent(DvmhRegionRef,DvmhConsistGroupRef) - - SgCallStmt *call = new SgCallStmt(*fdvm[HANDLE_CONSIST]); - fmask[HANDLE_CONSIST] = 2; - call->addArg(cur_region ? *DVM000(cur_region->No) : *ConstRef_F95(0)); - call->addArg(*gref); - return(call); -} - -SgStatement *RemoteAccess_H2 (SgExpression *buf_hedr, SgSymbol *ar, SgExpression *ar_hedr, SgExpression *axis_list) -{// generating subroutine call: dvmh_remote_access2 (DvmType rmaDesc[], const void *baseAddr, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pAlignmentHelper */...) - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REMOTE2]); - fmask[DVMH_REMOTE2] = 2; - call->addArg(*buf_hedr); - SgType *t = (isSgArrayType(ar->type())) ? ar->type()->baseType() : ar->type(); - SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); - call->addArg(*base); - call->addArg(*ar_hedr); - AddListToList(call->expr(0), axis_list); - return(call); -} - -/* -SgExpression *RegistrateLoop_GPU(int irgn,int iplp,int flag_first,int flag_last) -{ // generating function call: crtpl_gpu(region_ref, dvm_parloop_ref, flag_first, flag_last) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTPL_GPU]); - fmask[CRTPL_GPU] = 1; - fe->addArg(*GPU000(irgn)); - fe->addArg(*DVM000(iplp)); - fe->addArg(*ConstRef(flag_first)); - fe->addArg(*ConstRef(flag_last )); - return(fe); -} -*/ -//------------------------- Parallel loop -------------------------------------------------- - -SgExpression *LoopCreate_H(int irgn,int iplp) -{ // generating function call: loop_create(DvmhRegionRef, dvm_loop_ref(InDvmLoop)) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_CREATE]); - fmask[LOOP_CREATE] = 1; - if(irgn) - fe->addArg(*DVM000(irgn)); - else - fe->addArg(*ConstRef(0)); - if(iplp) - fe->addArg(*DVM000(iplp)); - else - fe->addArg(*ConstRef(0)); - return(fe); -} - -SgExpression *LoopCreate_H2(int nloop, SgExpression *paramList) -{ // generating function call: dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_CREATE_2]); - fmask[LOOP_CREATE_2] = 1; - fe->addArg(cur_region ? *DVM000(cur_region->No) : *ConstRef_F95(0)); - fe->addArg(*ConstRef(nloop)); - AddListToList(fe->lhs(),paramList); - return(fe); -} - -SgExpression *LoopCreate_H2(SgExpression ¶mList) -{ // generating function call: dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_CREATE_2],paramList); - fmask[LOOP_CREATE_2] = 1; - - return(fe); -} - -SgStatement *LoopMap(int ilh, SgExpression *desc, int rank, SgExpression *paramList) -{ // generating subroutine call: dvmh_loop_map(const DvmType *pCurLoop, const DvmType templDesc[], const DvmType *pTemplRank, /* const DvmType *pAlignmentHelper */...); - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_MAP]); - fmask[LOOP_MAP] = 2; - call->addArg(*DVM000(ilh)); - call->addArg(*desc); - call->addArg(*ConstRef(rank)); - AddListToList(call->expr(0),paramList); - return(call); -} - -SgStatement *LoopMap(SgExpression ¶mList) -{ // generating subroutine call: dvmh_loop_map(const DvmType *pCurLoop, const DvmType templDesc[], const DvmType *pTemplRank, /* const DvmType *pAlignmentHelper */...); - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_MAP],paramList); - fmask[LOOP_MAP] = 2; - - return(call); -} - -SgExpression *AlignmentLinear(SgExpression *axis,SgExpression *multiplier,SgExpression *summand) -{ // generating function call: - // DvmType dvmh_alignment_linear(const DvmType *pAxis, const DvmType *pMultiplier, const DvmType *pSummand) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ALIGN_LINEAR]); - fmask[ALIGN_LINEAR] = 1; - - fe->addArg(*DvmType_Ref(axis)); - fe->addArg(*DvmType_Ref(multiplier)); - fe->addArg(*DvmType_Ref(summand)); - return(fe); -} - -SgExpression *Register_Array_H2(SgExpression *ehead) -{ // generating function call: : DvmType dvmh_register_array(DvmType dvmDesc[]) - // DvmDesc - dvm-array header - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[REGISTER_ARR]); - fmask[REGISTER_ARR] = 1; - fe->addArg(*ehead); - return(fe); -} - -SgStatement *LoopStart_H(int il) -{ // generating subroutine call: loop_start(DvmhLoopRef) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_START]); - fmask[LOOP_START] = 2; - call->addArg(*DVM000(il)); - return(call); -} - -SgStatement *LoopEnd_H(int il) -{ // generating subroutine call: loop_end(DvmhLoopRef) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_END]); - fmask[LOOP_END] = 2; - call->addArg(*DVM000(il)); - return(call); -} - -SgStatement *LoopPerform_H(int il) -{ // generating subroutine call: loop_perform(DvmhLoopRef) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_PERFORM]); - fmask[LOOP_PERFORM] = 2; - call->addArg(*DVM000(il)); - return(call); -} - -SgStatement *LoopPerform_H2(int il) -{ // generating subroutine call: dvmh_loop_perform(DvmhLoopRef) - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_PERFORM_2]); - fmask[LOOP_PERFORM_2] = 2; - call->addArg(*DVM000(il)); - return(call); -} - -SgStatement *RegisterHandler_H(int il,SgSymbol *dev_const, SgExpression *flag, SgSymbol *sfun,int bcount,int parcount) -{ // generating subroutine call: loop_register_handler(DvmhLoopRef,deviceTypeRef,flagsRef,FuncRef,basesCount,paramCount,Params...) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[REG_HANDLER]); - fmask[REG_HANDLER] = 2; - call->addArg(*DVM000(il)); - call->addArg(* new SgVarRefExp(dev_const)); - call->addArg(* flag); - call->addArg(* new SgVarRefExp(sfun)); - call->addArg(* ConstRef(bcount)); - call->addArg(* ConstRef(parcount)); - return(call); -} - -SgStatement *RegisterHandler_H2(int il,SgSymbol *dev_const, SgExpression *flag, SgExpression *efun) -{ // generating subroutine call: dvmh_loop_register_handler(const DvmType *pCurLoop, const DvmType *pDeviceType, const DvmType *pHandlerType, const DvmType *pHandlerHelper) - - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[REG_HANDLER_2]); - fmask[REG_HANDLER_2] = 2; - call->addArg(*DVM000(il)); - call->addArg(* new SgVarRefExp(dev_const)); - call->addArg(* flag); - call->addArg(* efun); - return(call); -} - -SgExpression *HandlerFunc(SgSymbol *sfun, int paramCount, SgExpression *arg_list) -{ // generating function call: - // DvmType dvmh_handler_func(DvmHandlerFunc handlerFunc, const DvmType *pCustomParamCount, /* void *param */...) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[HANDLER_FUNC]); - fmask[HANDLER_FUNC] = 1; - fe->addArg(* new SgVarRefExp(sfun)); - fe->addArg(* ConstRef(paramCount)); - AddListToList(fe->lhs(), arg_list); - return(fe); -} - -/* -SgExpression *Loop_GPU(int il) -{ // generating function call: startpl_gpu(gpu_parloop_ref) - // gpu_parloop_ref - result of crtpl_gpu() - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_GPU]); - fmask[LOOP_GPU] = 1; - fe->addArg(*GPU000(il)); - fe->addArg(*new SgVarRefExp(s_blocks)); - fe->addArg(*new SgVarRefExp(s_threads)); - fe->addArg(*new SgArrayRefExp(*baseGpuMemory(IndexType()))); - fe->addArg(*new SgVarRefExp(s_blocks_off)); - return(fe); -} -*/ -/* -SgExpression *StartShadow_GPU(int irgn,SgExpression *gref) -{ // generating function call: strtsh_gpu(ComputeRegionRef, BoundGroupRef) - SgFunctionCallExp *fe= new SgFunctionCallExp(*fdvm[STRTSH_GPU]); - fmask[STRTSH_GPU] = 1; - fe->addArg(*GPU000(irgn)); - fe->addArg(gref->copy()); - return(fe); -} -*/ - -SgExpression *GetActualEdges_H(SgExpression *gref) -{ // generating function call: dvmh_get_actual_edges(ShadowGroupRef) - SgFunctionCallExp *fe= new SgFunctionCallExp(*fdvm[GET_ACTUAL_EDGES]); - fmask[GET_ACTUAL_EDGES] = 1; - - fe->addArg(gref->copy()); - return(fe); -} - -/* -SgStatement *DoneShadow_GPU(int ish) -{// generating subroutine call: donesh_gpu(gpu_ShagowRef) - // gpu_ShagowRef - result of strtsh_gpu() - SgCallStmt *call = new SgCallStmt(*fdvm[DONESH_GPU]); - fmask[DONESH_GPU] = 2; - call->addArg(*GPU000(ish)); - return(call); -} -*/ - -SgStatement *SetCudaBlock_H(int il, int ib) -{// generating subroutine call: loop_set_cuda_block(DvmhLoopRef,XRef,YRef,ZRef) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[CUDA_BLOCK]); - fmask[CUDA_BLOCK] = 2; - call->addArg(*DVM000(il)); - call->addArg(*DVM000(ib)); - call->addArg(*DVM000(ib+1)); - call->addArg(*DVM000(ib+2)); - return(call); -} - -SgStatement *SetCudaBlock_H2(int il, SgExpression *X, SgExpression *Y, SgExpression *Z ) -{// generating subroutine call: dvmh_loop_set_cuda_block(DvmhLoopRef,XRef,YRef,ZRef) - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[CUDA_BLOCK_2]); - fmask[CUDA_BLOCK_2] = 2; - call->addArg(*DVM000(il)); - call->addArg(*DvmType_Ref(X)); - call->addArg(*DvmType_Ref(Y)); - call->addArg(*DvmType_Ref(Z)); - return(call); -} - -SgStatement *Correspondence_H (int il, SgExpression *hedr, SgExpression *axis_list) -{// generating subroutine call: dvmh_loop_array_correspondence(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pLoopAxis */...) - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[CORRESPONDENCE]); - fmask[CORRESPONDENCE] = 2; - call->addArg(*DVM000(il)); - call->addArg(*hedr); - AddListToList(call->expr(0), axis_list); - return(call); -} - -SgStatement *Consistent_H (int il, SgExpression *hedr, SgExpression *axis_list) -{// generating subroutine call: dvmh_loop_consistent_(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pAlignmentHelper */...) - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_CONSISTENT]); - fmask[LOOP_CONSISTENT] = 2; - call->addArg(*DVM000(il)); - call->addArg(*hedr); - AddListToList(call->expr(0), axis_list); - return(call); -} - -SgStatement *LoopRemoteAccess_H (int il, SgExpression *hedr, SgSymbol *ar, SgExpression *axis_list) -{// generating subroutine call: dvmh_loop_remote_access_(const DvmType *pCurLoop, const DvmType dvmDesc[], const void *baseAddr, const DvmType *pRank, /* const DvmType *pAlignmentHelper */...) - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_REMOTE]); - fmask[LOOP_REMOTE] = 2; - call->addArg(*DVM000(il)); - call->addArg(*hedr); - SgType *t = (isSgArrayType(ar->type())) ? ar->type()->baseType() : ar->type(); - SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); - call->addArg(*base); - AddListToList(call->expr(0), axis_list); - return(call); -} - -SgStatement *ShadowRenew_H(SgExpression *gref) -{// generating subroutine call: dvmh_shadow_renew(ShadowGroupRef) - - SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_RENEW]); - fmask[SHADOW_RENEW] = 2; - - call->addArg(gref->copy()); - return(call); -} - -SgStatement *ShadowRenew_H2(SgExpression *head,int corner,int rank,SgExpression *shlist) -{// generating subroutine call: - // dvmh_shadow_renew2(const DvmType dvmDesc[], const DvmType *pCornerFlag, const DvmType *pSpecifiedRank, - // /* const DvmType *pShadowLow, const DvmType *pShadowHigh */...); - - SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_RENEW_2]); - fmask[SHADOW_RENEW_2] = 2; - - call->addArg(*head); - call->addArg(*ConstRef(corner)); - call->addArg(*ConstRef(rank)); - AddListToList(call->expr(0),shlist); - return(call); -} - - -SgStatement *IndirectShadowRenew(SgExpression *head, int axis, SgExpression *shadow_name) -{// generating subroutine call: - // dvmh_indirect_shadow_renew_(const DvmType dvmDesc[], const DvmType *pAxis, const DvmType *pShadowNameStr); - - SgCallStmt *call = new SgCallStmt(*fdvm[INDIRECT_SH_RENEW]); - fmask[INDIRECT_SH_RENEW] = 2; - - call->addArg(*head); - call->addArg(*ConstRef(axis)); - call->addArg(*DvmhString(shadow_name)); //DvmhString(new SgValueExp(name)) - return(call); -} - -SgStatement *LoopShadowCompute_H(int il,SgExpression *headref) -{ //generating subroutine call: loop_shadow_compute(DvmhLoopRef,dvmDesc[]) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_COMPUTE]); - fmask[SHADOW_COMPUTE] = 2; - - call -> addArg(*DVM000(il)); - call -> addArg(*headref); //(*HeaderRef(ar)); - - return(call); -} - -SgStatement *LoopShadowCompute_Array(int il,SgExpression *headref) -{ //generating subroutine call: dvmh_loop_shadow_compute_array(const DvmType *pCurLoop, const DvmType dvmDesc[]) - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_COMPUTE_AR]); - fmask[SHADOW_COMPUTE_AR] = 2; - - call -> addArg(*DVM000(il)); - call -> addArg(*headref); - - return(call); -} - -SgStatement *ShadowCompute(int ilh,SgExpression *head,int rank,SgExpression *shlist) -{// generating subroutine call: - // dvmh_loop_shadow_compute(const DvmType *pCurLoop, const DvmType templDesc[], const DvmType *pSpecifiedRank, - // /* const DvmType *pShadowLow, const DvmType *pShadowHigh */...); - // DvmhLoopRef - result of dvmh_loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_COMPUTE_2]); - fmask[SHADOW_COMPUTE_2] = 2; - - call->addArg(*DVM000(ilh)); - call->addArg(*head); - call->addArg(*ConstRef(rank)); - AddListToList(call->expr(0),shlist); - return(call); -} - -SgStatement *LoopAcross_H(int il,SgExpression *oldGroup,SgExpression *newGroup) -{ //generating subroutine call: loop_across(DvmhLoopRef *InDvmhLoop, ShadowGroupRef *oldGroup, ShadowGroupRef *newGroup) - // DvmhLoopRef - result of loop_create() - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_ACROSS]); - fmask[LOOP_ACROSS] = 2; - - call -> addArg(*DVM000(il)); - call -> addArg(*oldGroup); - call -> addArg(*newGroup); - - return(call); -} - -SgStatement *LoopAcross_H2(int il, int isOut, SgExpression *headref, int rank, SgExpression *shlist) -{ //generating subroutine call: - // dvmh_loop_across(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pShadowLow, const DvmType *pShadowHigh */...) - - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_ACROSS_2]); - fmask[LOOP_ACROSS_2] = 2; - - call -> addArg(*DVM000(il)); - call -> addArg(*ConstRef(isOut)); - call -> addArg(*headref); - call -> addArg(*ConstRef(rank)); - AddListToList(call->expr(0),shlist); - return(call); -} - -SgExpression *GetStage(SgStatement *first_do,int iplp) -{// generating function call: dvmh_get_next_stage(LineNumber,FileName,LoopRef,DvmhRegionRef) - // Loopref - result of crtpl() - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_STAGE]); - fmask[GET_STAGE] = 1; - filename_list *fn = AddToFileNameList(baseFileName(first_do->fileName())); - fe->addArg(cur_region ? *DVM000(cur_region->No) : *ConstRef_F95(0)); - fe->addArg(*DVM000(iplp)); - fe->addArg(*ConstRef_F95(first_do->lineNumber())); - fe->addArg(* new SgVarRefExp(fn->fns)); - - return(fe); -} - -SgStatement *SetStage(int il, SgExpression *stage) -{// generating function call: dvmh_loop_set_stage(const DvmType *pCurLoop, const DvmType *pStage) - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_SET_STAGE]); - fmask[DVMH_SET_STAGE] = 2; - - call -> addArg(*DVM000(il)); - call -> addArg(*TypeFunction(SgTypeInt(), stage, new SgValueExp(DVMTypeLength()))); - - return(call); - -} - -/* -SgStatement *EndHostExec_GPU(int il) -{// generating subroutine call: end_host_exec_gpu(gpu_parloop_ref) - // gpu_parloop_ref - result of crtpl_gpu() - SgCallStmt *call = new SgCallStmt(*fdvm[ENDHOST_GPU]); - fmask[ENDHOST_GPU] = 2; - call->addArg(*GPU000(il)); - return(call); -} -*/ - -SgStatement *CallKernel_GPU(SgSymbol *skernel, SgExpression *blosks_threads) -{// generating Kernel Call: - // loop__(InDeviceBaseAddr1,...,InDeviceBaseAddrN,,, blocks_off) - - // SgExpression *gpubase; - - SgCallStmt *call = new SgCallStmt(*skernel); - - call->setExpression(1,*blosks_threads); - //gpubase = new SgArrayRefExp(*baseGpuMemory(ar->type()->baseType())); - //call -> addArg(*new SgVarRefExp(s_blocks_off)); - - call ->setVariant(ACC_CALL_STMT); - return(call); -} - -/* -SgStatement *InsertRed_GPU(int il,int irv,SgExpression *base,SgExpression *loc_base,SgExpression *offset,SgExpression *loc_offset) -{// generating subroutine call: insred_gpu_(gpu_parloop_ref, InRedRefPtr, InDeviceArrayBaseAddr, InDeviceLocBaseAddr, AddrType* ArrayOffsetPtr, AddrType *LocOffsetPtr) - // InRedRefPtr - result of crtrdf() - - SgCallStmt *call = new SgCallStmt(*fdvm[INSRED_GPU]); - fmask[INSRED_GPU] = 2; - call -> addArg(*GPU000(il)); - call -> addArg(*DVM000(irv)); - call -> addArg(*base); - if(loc_base) - call -> addArg(*loc_base); - else - call -> addArg(*ConstRef(0)); - call -> addArg(*GetAddresMem(offset)); - if(loc_offset) - call -> addArg(*GetAddresMem(loc_offset)); - else - call -> addArg(*ConstRef(0)); - return(call); -} -*/ - -SgStatement *LoopInsertReduction_H(int ilh, int irv) -{// generating subroutine call: loop_insred(DvmhLoopRef, InRedRefPtr) - // InRedRefPtr - result of crtrdf() - // DvmhLoopRef - result of loop_create() - - SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_INSRED]); - fmask[LOOP_INSRED] = 2; - call -> addArg(*DVM000(ilh)); - call -> addArg(*DVM000(irv)); - return(call); -} - -/* -SgStatement *UpdateDVMArrayOnHost(SgSymbol *s) -{ - // generating subroutine call: dvmh_get_actual_whole_(long InOutDvmArray[]) - //InOutDvmArray[] - DVM-array header of array 's' - SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_WHOLE]); - fmask[GET_ACTUAL_WHOLE] = 2; - call->addArg(*HeaderRef(s)); - return(call); -} -*/ - -//--------- Array Copy ---------------------------------------------------------------- - -SgExpression *DvmhArraySlice(int rank, SgExpression *slice_list) -{ - // generating function call: - // DvmType dvmh_array_slice_C(DvmType rank, /* DvmType start, DvmType end, DvmType step */...) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRAY_SLICE]); - fmask[ARRAY_SLICE] = 1; - fe->addArg(*ConstRef_F95(rank)); - AddListToList(fe->lhs(), slice_list); //fe->lhs()->setRhs(slice_list); - return(fe); -} - -SgStatement *DvmhArrayCopy( SgExpression *array_header_right, int rank_right, SgExpression *slice_list_right, SgExpression *array_header_left, int rank_left, SgExpression *slice_list_left ) -{ - // generating subroutine call: - // dvmh_array_copy (const DvmType srcDvmDesc[], DvmType *pSrcSliceHelper, DvmType dstDvmDesc[], DvmType *pDstSliceHelper) - - SgCallStmt *call = new SgCallStmt(*fdvm[COPY_ARRAY]); - fmask[COPY_ARRAY] = 2; - call->addArg(*array_header_right); - call->addArg(*DvmhArraySlice(rank_right, slice_list_right)); - call->addArg(*array_header_left); - call->addArg(*DvmhArraySlice(rank_left, slice_list_left)); - return(call); -} - - -SgStatement *DvmhArrayCopyWhole( SgExpression *array_header_right, SgExpression *array_header_left ) -{ - // generating subroutine call: - // dvmh_array_copy_whole(const DvmType srcDvmDesc[], DvmType dstDvmDesc[]) - - SgCallStmt *call = new SgCallStmt(*fdvm[COPY_WHOLE]); - fmask[COPY_WHOLE] = 2; - call->addArg(*array_header_right); - call->addArg(*array_header_left); - return(call); -} - -SgStatement *DvmhArraySetValue( SgExpression *array_header_left, SgExpression *e_right ) -{ - // generating subroutine call: - // dvmh_array_set_value_(DvmType dstDvmDesc[], const void *scalarAddr) - - SgCallStmt *call = new SgCallStmt(*fdvm[SET_VALUE]); - fmask[SET_VALUE] = 2; - call->addArg(*array_header_left); - call->addArg(*e_right); - - return(call); -} - -// -------- Distributed array creation ------------------------------------------------ - -SgStatement *DvmhArrayCreate(SgSymbol *das, SgExpression *array_header, int rank, SgExpression *arglist) -{ - // generating subroutine call: - // dvmh_array_create(DvmType dvmDesc[], const void *baseAddr, const DvmType *pRank, const DvmType *pTypeSize, - // \* const DvmType *pSpaceLow, const DvmType *pSpaceHigh, const DvmType *pShadowLow, const DvmType *pShadowHigh *\...) - - SgCallStmt *call = new SgCallStmt(*fdvm[CREATE_ARRAY]); - fmask[CREATE_ARRAY] = 2; - loc_distr =1; - - call->addArg(*array_header); //(*HeaderRef(das)); - SgType *t = IS_POINTER(das) ? PointerType(das) : (das->type())->baseType(); - SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); - call->addArg(*base); //Base - call->addArg(*ConstRef(rank)); //Rank - //int it = TestType_RTS2(t); - //SgExpression *ts = it >= 0 ? &SgUMinusOp(*ConstRef(it)) : ConstRef_F95(TypeSize(t)); - //call->addArg(*ts); //TypeSize - //(*ConstRef_F95(TypeSize(t))); - call->addArg(*TypeSize_RTS2(t)); - AddListToList(call->expr(0),arglist); - return(call); -} - -SgStatement *DvmhTemplateCreate(SgSymbol *das, SgExpression *array_header, int rank, SgExpression *arglist) -{ - // generating subroutine call: - // dvmh_template_create(DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pSpaceLow, const DvmType *pSpaceHigh */...); - SgCallStmt *call = new SgCallStmt(*fdvm[CREATE_TEMPLATE]); - fmask[CREATE_TEMPLATE] = 2; - loc_distr = 1; - - call->addArg(*array_header); //(*HeaderRef(das)); - call->addArg(*ConstRef(rank)); //Rank - AddListToList(call->expr(0),arglist); - return(call); -} - -SgExpression *VarGenHeader(SgExpression *item) -{ - // generates function call: - // dvmh_variable_gen_header(const void *addr, const DvmType *pRank, const DvmType *pTypeSize, - // \* const DvmType *pSpaceLow, const DvmType *pSpaceHigh \*...) - - // dvmh_variable_gen_header(C, 0_8, int(-rt_FLOAT, 8)) for scalar variables - // dvmh_variable_gen_header(B, 2_8, int(-rt_FLOAT, 8), 1_8, 30_8, 1_8, 40_8) for array of size 40*30 - - fmask[VAR_GEN_HDR] = 1; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[VAR_GEN_HDR]); - fe->addArg(*item); - - int nsubs; - if (item->symbol() && isSgArrayType(item->symbol()->type())) - nsubs = isSgArrayType(item->symbol()->type())->dimension(); - else nsubs = 0; - fe->addArg(*ConstRef_F95(nsubs)); - - // fe->addArg(*TypeSize_RTS2(item->symbol()->type())); - - if (item->symbol()) fe->addArg(*TypeSize_RTS2(item->symbol()->type())); - else fe->addArg(*TypeSize_RTS2(item->type())); // array expressions don't have symbol - - if (nsubs) { - for (int i = nsubs-1; i >= 0; --i) { - fe->addArg(*DvmType_Ref(LowerBound(item->symbol(), i))); - fe->addArg(*DvmType_Ref(UpperBound(item->symbol(), i))); - } - } - - return fe; - -} - -SgStatement *CreateDvmArrayHeader_2(SgSymbol *ar, SgExpression *array_header, int rank, SgExpression *shape_list) -{ -// creates subroutine call: -// dvmh_variable_fill_header(DvmType dvmDesc[], const void *baseAddr, const void *addr, const DvmType *pRank, const DvmType *pTypeSize,/* const DvmType *pSpaceLow, const DvmType *pSpaceHigh */...); - - SgCallStmt *call = new SgCallStmt(*fdvm[VAR_FILL_HDR]); - fmask[VAR_FILL_HDR] = 2; - - call->addArg(*array_header); - SgType *t = (isSgArrayType(ar->type())) ? ar->type()->baseType() : ar->type(); - SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); - call->addArg(*base); - call->addArg(*new SgArrayRefExp(*ar)); - call->addArg(*ConstRef(rank)); - call->addArg(*TypeSize_RTS2(t)); - AddListToList(call->expr(0),shape_list); - return(call); -} - -SgExpression *DvmhReplicated() -{ - // generates function call: DvmType dvmh_distribution_replicated() - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_REPLICATED]); - fmask[DVMH_REPLICATED] = 1; - return fe; - -} - -SgExpression *DvmhBlock(int axis) -{ - // generates function call: DvmType dvmh_distribution_block(DvmType pMpsAxis) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_BLOCK]); - fmask[DVMH_BLOCK] = 1; - fe->addArg(*ConstRef(axis)); - return fe; - -} - -SgExpression *DvmhWgtBlock(int axis, SgSymbol *sw, SgExpression *en) -{ - // generates function call: - // DvmType dvmh_distribution_wgtblock(DvmType pMpsAxis, const DvmType *pElemType, const void *arrayAddr, const DvmType *pElemCount) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_WGTBLOCK]); - fmask[DVMH_WGTBLOCK] = 1; - SgType *t = (isSgArrayType(sw->type())) ? sw->type()->baseType() : sw->type(); - fe->addArg(*ConstRef(axis)); - fe->addArg(*ConstRef( TestType_RTS2(t) )); - fe->addArg(*new SgArrayRefExp(*sw)); - fe->addArg(*en); //DvmType_Ref(en) - return fe; - -} - - -SgExpression *DvmhGenBlock(int axis, SgSymbol *sg) -{ - // generates function call: - // DvmType dvmh_distribution_genblock(DvmType pMpsAxis, const DvmType *pElemType, const void *arrayAddr) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_GENBLOCK]); - fmask[DVMH_GENBLOCK] = 1; - SgType *t = (isSgArrayType(sg->type())) ? sg->type()->baseType() : sg->type(); - fe->addArg(*ConstRef(axis)); - fe->addArg(*ConstRef( TestType_RTS2(t))); - fe->addArg(*new SgArrayRefExp(*sg)); - return fe; - -} - -SgExpression *DvmhMultBlock(int axis, SgExpression *em) -{ - // generates function call: DvmType dvmh_distribution_multblock(DvmType pMpsAxis, const DvmType *pMultBlock) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_MULTBLOCK]); - fmask[DVMH_MULTBLOCK] = 1; - fe->addArg(*ConstRef(axis)); - fe->addArg(*em); // *DvmType_Ref(em)); - - return fe; - -} - -#define rt_UNKNOWN (-1) /*RTS2*/ - -SgExpression *DvmhIndirect(int axis, SgSymbol *smap) -{ - // generates function call: - // DvmType dvmh_distribution_indirect(DvmType pMpsAxis, const DvmType *pElemType, const void *arrayAddr) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_INDIRECT]); - fmask[DVMH_INDIRECT] = 1; - SgType *t = (isSgArrayType(smap->type())) ? smap->type()->baseType() : smap->type(); - fe->addArg(*ConstRef(axis)); - fe->addArg(HEADER(smap) ? *SignConstRef(rt_UNKNOWN) : *ConstRef( TestType_RTS2(t))); - fe->addArg(*new SgArrayRefExp(*smap)); - - return fe; - -} - -SgExpression *DvmhDerived(int axis, SgExpression *derived_rhs, SgExpression *counter_func, SgExpression *filler_func) -{ //generating function call: - // DvmType dvmh_distribution_derived(DvmType pMpsAxis, const DvmType *pDerivedRhsHelper, const DvmType *pCountingHandlerHelper, const DvmType *pFillingHandlerHelper) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_DERIVED]); - fmask[DVMH_DERIVED] = 1; - fe->addArg(*ConstRef(axis)); - fe->addArg(*derived_rhs); - fe->addArg(*counter_func); - fe->addArg(*filler_func); - return fe; -} - -SgStatement *DvmhDistribute(SgSymbol *das, int rank, SgExpression *distr_list) -{ - // generating subroutine call: - // dvmh_distribute(DvmType dvmDesc[], const DvmType *pRank, - // \* const DvmType *pDistributionHelper *\...); - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_DISTRIBUTE]); - fmask[DVMH_DISTRIBUTE] = 2; - - call->addArg(*HeaderRef(das)); - call->addArg(*ConstRef_F95(rank)); - AddListToList(call->expr(0),distr_list); - return(call); -} - - -SgStatement *DvmhRedistribute(SgSymbol *das, int rank, SgExpression *distr_list) -{ - // generating subroutine call: - // dvmh_redistribute2(DvmType dvmDesc[], const DvmType *pRank, - // \* const DvmType *pDistributionHelper *\...); - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REDISTR_2]); - fmask[DVMH_REDISTR_2] = 2; - - call->addArg(*HeaderRef(das)); - call->addArg(*ConstRef_F95(rank)); - AddListToList(call->expr(0),distr_list); - return(call); -} - - -SgStatement *DvmhAlign(SgSymbol *als, SgSymbol *align_base, int nr, SgExpression *alignment_list) -{ - // generating subroutine call: - // dvmh_align(DvmType dvmDesc[], const DvmType templDesc[], const DvmType *pTemplRank, - // \* const DvmType *pAlignmentHelper *\...) - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_ALIGN]); - fmask[DVMH_ALIGN] = 2; - - call->addArg(*HeaderRef(als)); - call->addArg(*HeaderRef(align_base)); - call->addArg(*ConstRef(nr)); //addArg(*ConstRef_F95(Rank(align_base))); - AddListToList(call->expr(0),alignment_list); - return(call); -} - -SgStatement *DvmhRealign(SgExpression *objref, int new_sign, SgExpression *pattern_ref, int nr, SgExpression *align_list) -{ //generating Subroutine Call: - // dvmh_realign2(dvmDesc[], newValueFlagRef) - - SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REALIGN_2]); - fmask[DVMH_REALIGN_2] = 2; - - call->addArg(*objref); - call->addArg(*ConstRef(new_sign)); - call->addArg(*pattern_ref); - call->addArg(*ConstRef(nr)); - AddListToList(call->expr(0),align_list); - return(call); -} - -SgStatement *IndirectLocalize(SgExpression *ref_array, SgExpression *target_array, int iaxis) -{ //generating Subroutine Call: - // dvmh_indirect_localize (const DvmType refDvmDesc[], const DvmType targetDvmDesc[], const DvmType *pTargetAxis) - - SgCallStmt *call = new SgCallStmt(*fdvm[LOCALIZE]); - fmask[LOCALIZE] = 2; - - call->addArg(*ref_array); - call->addArg(*target_array); - call->addArg(*ConstRef_F95(iaxis)); - return(call); -} - -SgStatement *ShadowAdd(SgExpression *templ, int iaxis, SgExpression *derived_rhs, SgExpression *counter_func, SgExpression *filler_func, SgExpression *shadow_name, int nl, SgExpression *array_list) -{ //generating Subroutine Call: - // dvmh_indirect_shadow_add (DvmType dvmDesc[], const DvmType *pAxis, const DvmType *pDerivedRhsHelper, const DvmType *pCountingHandlerHelper, - // const DvmType *pFillingHandlerHelper, const DvmType *pShadowNameStr, const DvmType *pIncludeCount, /* DvmType dvmDesc[] */...); - - SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_ADD]); - fmask[SHADOW_ADD] = 2; - - call->addArg(*templ); - call->addArg(*ConstRef_F95(iaxis)); - call->addArg(*derived_rhs); - call->addArg(*counter_func); - call->addArg(*filler_func); - call->addArg(*DvmhString(shadow_name)); - call->addArg(*ConstRef_F95(nl)); - AddListToList(call->expr(0),array_list); - return(call); -} - -SgExpression *DvmhExprIgnore() -{ - // generates function call: dvmh_derived_rhs_expr_ignore() - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[EXPR_IGNORE]); - fmask[EXPR_IGNORE] = 1; - return fe; -} - -SgExpression *DvmhExprConstant(SgExpression *e) -{ - // generates function call: dvmh_derived_rhs_expr_constant() - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[EXPR_CONSTANT]); - fmask[EXPR_CONSTANT] = 1; - fe->addArg(*DvmType_Ref(e)); - return fe; -} - -SgExpression *DvmhExprScan(SgExpression *edummy) -{ - // generates function call: dvmh_derived_rhs_expr_scan(const DvmType *pShadowCount, /* const DvmType *pShadowNameStr */...) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[EXPR_SCAN]); - fmask[EXPR_SCAN] = 1; - SgExpression *el = edummy->lhs(); - SgExpression *eln= NULL; - int nsh=0; - for(;el;el=el->rhs(),nsh++) - eln = AddElementToList(eln,DvmhString(el->lhs())); - fe->addArg(*ConstRef_F95(nsh)); - fe->lhs()->setRhs(eln); - return fe; -} - -SgExpression *DvmhDerivedRhs(SgExpression *erhs) -{ - // generates function call: - // dvmh_derived_rhs(const DvmType templDesc[], const DvmType *pTemplRank, /* const DvmType *pDerivedRhsExprHelper */...); - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DERIVED_RHS]); - fmask[DERIVED_RHS] = 1; - fe->addArg(*HeaderRef(erhs->symbol())); - SgExpression *el,*e,*eln=NULL; - int nr=0; - for(el=erhs->lhs();el;el=el->rhs(),nr++) - { - if(isSgKeywordValExp(el->lhs())) // "*" - e = DvmhExprIgnore(); - else if(el->lhs()->variant() == DUMMY_REF) // @align-dummy[ + shadow-name ]... - e = DvmhExprScan(el->lhs()); - else // int_expr - e = DvmhExprConstant(el->lhs()); - eln = AddElementToList(eln,e); - } - fe->addArg(*ConstRef_F95(nr)); - AddListToList(fe->lhs(),eln); - return fe; -} - -// ------- Input/Output -------------------------------------------------------------- - -SgExpression *DvmhConnected(SgExpression *unit, SgExpression *failIfYes) -{ - // generates function call: - // dvmh_ftn_connected(const DvmType *pUnit, const DvmType *pFailIfYes) - - fmask[FTN_CONNECTED] = 1; - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[FTN_CONNECTED]); - fe->addArg(*unit); - fe->addArg(*failIfYes); - - return fe; -} - -//------ Calls from HOST-procedure(host-handler) for parallel loop -------------------- - -SgStatement *LoopFillBounds_HH(SgSymbol *loop_s, SgSymbol *sBlow,SgSymbol *sBhigh,SgSymbol *sBstep) -{// generating subroutine call: loop_fill_bounds(DvmhLoopRef, lowIndex[],highIndex[],stepIndex[]) - // DvmhLoopRef - result of loop_create() - - SgCallStmt *call = new SgCallStmt(*fdvm[FILL_BOUNDS]); - //fmask[FILL_BOUNDS] = 2; - call -> addArg(*new SgVarRefExp(loop_s)); - call -> addArg(* new SgArrayRefExp(*sBlow, *new SgValueExp(1))); - call -> addArg(* new SgArrayRefExp(*sBhigh,*new SgValueExp(1))); - call -> addArg(* new SgArrayRefExp(*sBstep,*new SgValueExp(1))); - return(call); -} - -SgStatement *LoopRedInit_HH(SgSymbol *loop_s, int nred, SgSymbol *sRed,SgSymbol *sLoc) -{// generating subroutine call: loop_red_init(DvmhLoopRef *InDvmhLoop, DvmType *InRedNum, void *arrayPtr, void *locPtr) - // DvmhLoopRef - result of loop_create() - - SgCallStmt *call = new SgCallStmt(*fdvm[RED_INIT]); - //fmask[RED_INIT] = 2; - call -> addArg(*new SgVarRefExp(loop_s)); - call -> addArg(*ConstRef_F95(nred)); - call -> addArg(* new SgVarRefExp(*sRed)); - if(sLoc) - { if(isSgArrayType(sLoc->type())) - call -> addArg(*FirstArrayElement(sLoc)); //(* new SgArrayRefExp(*sLoc)); - else - call -> addArg(*new SgVarRefExp(sLoc)); - } - else - call -> addArg(*ConstRef_F95(0)); - return(call); -} - -SgStatement *LoopRedPost_HH(SgSymbol *loop_s, int nred, SgSymbol *sRed,SgSymbol *sLoc) -{// generating subroutine call: loop_red_post(DvmhLoopRef *InDvmhLoop, DvmType *InRedNum, void *arrayPtr, void *locPtr) - // DvmhLoopRef - result of loop_create() - - SgCallStmt *call = new SgCallStmt(*fdvm[RED_POST]); - //fmask[RED_POST] = 2; - call -> addArg(*new SgVarRefExp(loop_s)); - call -> addArg(*ConstRef_F95(nred)); - call -> addArg(* new SgVarRefExp(*sRed)); - if(sLoc) - { if(isSgArrayType(sLoc->type())) - call -> addArg(*FirstArrayElement(sLoc)); //(* new SgArrayRefExp(*sLoc)); - else - call -> addArg(*new SgVarRefExp(sLoc)); - } - else - call -> addArg(*ConstRef_F95(0)); - return(call); -} - -SgExpression *LoopGetSlotCount_HH(SgSymbol *loop_s) -{// generating function call: loop_get_slot_count(DvmhLoopRef *InDvmhLoop) - // DvmhLoopRef - result of loop_create() - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[SLOT_COUNT]); - //fmask[SLOT_COUNT] = 1; - fe -> addArg(*new SgVarRefExp(loop_s)); - return(fe); -} - -SgStatement *FillLocalPart_HH(SgSymbol *loop_s, SgSymbol *shead, SgSymbol *spart) -{// generating subroutine call: loop_fill_local_part(DvmhLoopRef *InDvmhLoop, long dvmDesc[], IndexType part[]) - - // DvmhLoopRef - result of loop_create() - - SgCallStmt *call = new SgCallStmt(*fdvm[FILL_LOCAL_PART]); - - call -> addArg(*new SgVarRefExp(loop_s)); - call -> addArg(* new SgArrayRefExp(*shead, *new SgValueExp(1))); - call -> addArg(* new SgArrayRefExp(*spart, *new SgValueExp(1))); - return(call); -} - -SgStatement *GetRemoteBuf (SgSymbol *loop_s, int n, SgSymbol *s_buf_head) -{// generating subroutine call: dvmh_loop_get_remote_buf_(const DvmType *pCurLoop, const DvmType *pRmaIndex, DvmType rmaDesc[]); - - SgCallStmt *call = new SgCallStmt(*fdvm[GET_REMOTE_BUF]); - fmask[GET_REMOTE_BUF] = 2; - call->addArg(*new SgVarRefExp(loop_s)); - call->addArg(*ConstRef_F95(n)); - call->addArg(*new SgArrayRefExp(*s_buf_head)); - return(call); -} - -//------ Calls from handlers for sequence of statements -------------------- - -SgExpression *HasLocalElement(SgSymbol *s_loop_ref,SgSymbol *ar, SgSymbol *IndAr) -{ // generating function call: - // loop_has_element(DvmhLoopRef *InDvmhLoop, long dvmDesc[], long indexArray[]); - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[HAS_ELEMENT]); - fmask[HAS_ELEMENT] = 1; - if(!s_loop_ref) - s_loop_ref = loop_ref_symb; - fe->addArg(* new SgVarRefExp(s_loop_ref)); - //if(HEADER(ar)) //DVM-array - fe-> addArg(*HeaderRef(ar)); - - //else // replicated array - // call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); - - fe->addArg(* new SgArrayRefExp(*IndAr)); - return(fe); - -} - -SgExpression *HasLocalElement_H2(SgSymbol *s_loop_ref, SgSymbol*ar, int n, SgExpression *index_list) -{ // generating function call: - // dvmh_loop_has_element_(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndex */...); - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[HAS_ELEMENT_2]); - fmask[HAS_ELEMENT_2] = 1; - if(!s_loop_ref) - s_loop_ref = loop_ref_symb; - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe-> addArg(*HeaderRef(ar)); - fe->addArg(*ConstRef_F95(n)); - AddListToList(fe->lhs(),index_list); - - return(fe); - -} - -// ------ Calls from Adapter/Cuda-Handler (C Language) -------------------------------------------------------------- - -SgExpression *GetNaturalBase(SgSymbol *s_cur_dev,SgSymbol *shead) -{ // generating function call: dvmh_get_natural_base (DvmType *deviceRef, DvmType dvmDesc[]) - // or - // dvmh_get_natural_base_C(DvmType deviceNum, const DvmType dvmDesc[]) - - int fNum = INTERFACE_RTS2 ? GET_BASE_C : GET_BASE; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(* new SgVarRefExp(s_cur_dev)); - else - fe->addArg(SgAddrOp(* new SgVarRefExp(s_cur_dev))); - fe->addArg(* new SgArrayRefExp(*shead)); - return(fe); -} - -SgExpression *GetDeviceAddr(SgSymbol *s_cur_dev,SgSymbol *s_var) -{ // generating function call: dvmh_get_device_addr (DvmType *deviceRef, void *variable) - // or when RTS2 is used - // dvmh_get_device_addr_C(DvmType deviceNum, const void *addr); - - int fNum = INTERFACE_RTS2 ? GET_DEVICE_ADDR_C : GET_DEVICE_ADDR ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(*new SgVarRefExp(s_cur_dev)); - else - fe->addArg(SgAddrOp(*new SgVarRefExp(s_cur_dev))); - fe->addArg(*new SgVarRefExp(*s_var)); - return(fe); -} - -SgExpression *FillHeader(SgSymbol *s_cur_dev,SgSymbol *sbase,SgSymbol *shead,SgSymbol *sgpuhead) -{ // generating function call: dvmh_fill_header_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[]) - // or when RTS2 is used - // DvmType dvmh_fill_header2_(const DvmType *pDeviceNum, const void *baseAddr, const DvmType dvmDesc[], DvmType devHeader[]); - - int fNum = INTERFACE_RTS2 ? FILL_HEADER_2 : FILL_HEADER ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - fe->addArg(SgAddrOp(*new SgVarRefExp(s_cur_dev))); - fe->addArg(* new SgVarRefExp(*sbase)); - fe->addArg(* new SgArrayRefExp(*shead)); - fe->addArg(* new SgArrayRefExp(*sgpuhead)); - return(fe); -} - -SgExpression *FillHeader_Ex(SgSymbol *s_cur_dev,SgSymbol *sbase,SgSymbol *shead,SgSymbol *sgpuhead,SgSymbol *soutType,SgSymbol *sParams) -{ // generating function call: dvmh_fill_header_ex_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[],DvmType *outTypeOfTransformation, DvmType extendedParams[]) - // or when RTS2 is used - // DvmType dvmh_fill_header_ex2_(const DvmType *pDeviceNum, const void *baseAddr, const DvmType dvmDesc[], DvmType devHeader[], DvmType extendedParams[]) - - int fNum = INTERFACE_RTS2 ? FILL_HEADER_EX_2 : FILL_HEADER_EX ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - SgExpression *e; - fe->addArg(SgAddrOp(*new SgVarRefExp(s_cur_dev))); - fe->addArg(* new SgVarRefExp(*sbase)); - fe->addArg(* new SgArrayRefExp(*shead)); - fe->addArg(* new SgArrayRefExp(*sgpuhead)); - if(!INTERFACE_RTS2) - fe->addArg(SgAddrOp(*new SgVarRefExp(soutType))); - fe->addArg(* new SgArrayRefExp(*sParams)); - if(INTERFACE_RTS2) - e = &SgAssignOp(*new SgVarRefExp(soutType), *fe); - - return(INTERFACE_RTS2 ? e : fe); -} - -SgExpression *LoopDoCuda(SgSymbol *s_loop_ref,SgSymbol *s_blocks,SgSymbol *s_threads,SgSymbol *s_stream, SgSymbol *s_blocks_info,SgSymbol *s_const) -{ // generating function call: loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, void **InOutBlocks, SgExpression *etype) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DO_CUDA]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - - fe->addArg(SgAddrOp(*new SgVarRefExp(*s_blocks)));//(* new SgExpression(ADDRESS_OP,new SgVarRefExp(*s_blocks),NULL); - //fe->addArg(* new SgValueExp(0)); //fe->addArg(SgAddrOp(* new SgVarRefExp(*s_threads))); - //fe->addArg(* new SgValueExp(0)); //fe->addArg(SgAddrOp(* new SgVarRefExp(*s_stream))); - if(s_blocks_info) - //fe->addArg(*new SgCastExp(*C_PointerType(C_PointerType(C_VoidType() )), SgAddrOp(* new SgVarRefExp(*s_blocks_info)))); - fe->addArg(SgAddrOp(* new SgVarRefExp(*s_blocks_info))); - else - fe->addArg(* new SgValueExp(0)); // for sequence of statements in region - fe->addArg(* new SgVarRefExp(s_const)); - return(fe); -} - -SgFunctionCallExp *CallKernel(SgSymbol *skernel, SgExpression *blosks_threads) -{// generating Kernel Call: - // loop__(InDeviceBaseAddr1,dvmhDesc1[]...,InDeviceBaseAddrN,dvmhDescN[],, ,blocks_info,red_count) - - SgExpression *fe = new SgExpression(ACC_CALL_OP); - fe->setSymbol(*skernel); - fe->setRhs(*blosks_threads); - return((SgFunctionCallExp *)fe); -} - -SgExpression *RegisterReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red, SgSymbol *s_loc) -{ // generating function call: loop_cuda_register_red(DvmhLoopRef *InDvmhLoop, DvmType InRedNum, void **ArrayPtr, void **LocPtr) - // or when RTS2 is used - // dvmh_loop_cuda_register_red_C(DvmType curLoop, DvmType redIndex, void **arrayAddrPtr, void **locAddrPtr) - - SgExpression *eloc; - int fNum = INTERFACE_RTS2 ? RED_CUDA_C : RED_CUDA ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgVarRefExp(s_var_num)); - fe->addArg(SgAddrOp(*new SgVarRefExp(*s_red))); - if (s_loc) - eloc = &(SgAddrOp(*new SgVarRefExp(*s_loc))); - else - eloc = new SgValueExp(0); - fe->addArg(*eloc); - return( fe); -} - - -SgExpression *Register_Red(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red_array, SgSymbol *s_loc_array,SgSymbol *s_offset,SgSymbol *s_loc_offset) -{ // generating function call: loop_cuda_register_red_(DvmhLoopRef *InDvmhLoop, DvmType InRedNumRef,void *InDeviceArrayBaseAddr, void *InDeviceLocBaseAddr,CudaOffsetTypeRef *ArrayOffsetPtr, CudaOffsetTypeRef *LocOffsetPtr) - - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[REGISTER_RED]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - - fe->addArg(SgAddrOp(* new SgVarRefExp(s_var_num))); - fe->addArg(*new SgVarRefExp(*s_red_array)); - if(s_loc_array) - fe->addArg(*new SgVarRefExp(*s_loc_array)); - else - fe->addArg(*new SgValueExp(0)); - fe->addArg(* new SgVarRefExp(s_offset)); - fe->addArg(* new SgVarRefExp(s_loc_offset)); - return( fe); -} - -SgExpression *InitReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red,SgSymbol *s_loc) -{ // generating function call: loop_red_init_(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNum, void *arrayPtr, void *locPtr) - // or when RTS2 is used - // dvmh_loop_red_init_(const DvmType *pCurLoop, const DvmType *pRedIndex, void *arrayAddr, void *locAddr) - - SgExpression *eloc; - int fNum = INTERFACE_RTS2 ? RED_INIT_2 : RED_INIT_C ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(SgAddrOp(* new SgVarRefExp(s_var_num))); - fe->addArg(SgAddrOp(* new SgVarRefExp(*s_red))); - if (s_loc) - eloc = new SgArrayRefExp(*s_loc); //&(SgAddrOp(*new SgVarRefExp(*s_loc))); - else - eloc = new SgValueExp(0); - fe->addArg(*eloc); - return(fe); -} - -SgExpression *CudaInitReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_dev_red,SgSymbol *s_dev_loc) //SgSymbol *s_red,SgSymbol *s_loc, -{ // generating function call: loop_cuda_red_init_ (DvmhLoopRef *InDvmhLoop, Dvmtype InRedNum, void *arrayPtr, void *locPtr, void **devArrayPtr, void **devLocPtr) - // or when RTS2 is used - // dvmh_loop_cuda_red_init_C(DvmType curLoop, DvmType redIndex, void **devArrayAddrPtr, void **devLocAddrPtr) - - SgExpression *eloc; - int fNum = INTERFACE_RTS2 ? CUDA_RED_INIT_2 : CUDA_RED_INIT ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgVarRefExp(s_var_num)); - //fe->addArg(* new SgVarRefExp(*s_red)); - //if (s_loc) - // eloc = new SgArrayRefExp(*s_loc); //&(SgAddrOp(*new SgVarRefExp(*s_loc))); - //else - // eloc = new SgValueExp(0); - //fe->addArg(*eloc); - fe->addArg(SgAddrOp(*new SgVarRefExp(s_dev_red))); - if (s_dev_loc) - eloc = new SgArrayRefExp(*s_dev_loc); //&(SgAddrOp(*new SgVarRefExp(*s_dev_loc))); - else - eloc = new SgValueExp(0); - fe->addArg(*eloc); - return(fe); -} - -SgExpression *PrepareReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_count, SgSymbol *s_fill_flag, int fixedCount, int fillFlag) -{ // generating function call: loop_cuda_red_prepare_(DvmhLoopRef *InDvmhLoop, Dvmtype InRedNumRef, DvmType InCountRef, DvmType InFillFlagRef) - // or when RTS2 is used - // dvmh_loop_cuda_red_prepare_C(DvmType curLoop, DvmType redIndex, DvmType count, DvmType fillFlag) - - int fNum = INTERFACE_RTS2 ? RED_PREPARE_C : RED_PREPARE ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgVarRefExp(s_var_num)); - if (fixedCount == 0) - fe->addArg(* new SgVarRefExp(s_count)); - else - fe->addArg(*new SgValueExp(fixedCount)); - if (fillFlag == -1) - fe->addArg(* new SgVarRefExp(s_fill_flag)); - else - fe->addArg(* new SgValueExp(fillFlag)); - return(fe); -} - -SgExpression *FinishReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num) -{ // generating function call: loop_red_finish_(DvmhLoopRef *InDvmhLoop, DvmType InRedNumRef) - // or when RTS2 is used - // dvmh_loop_cuda_red_finish_C(DvmType curLoop, DvmType redIndex) - - int fNum = INTERFACE_RTS2 ? RED_FINISH_C : RED_FINISH ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgVarRefExp(s_var_num)); - return(fe); -} - - -SgExpression *LoopSharedNeeded(SgSymbol *s_loop_ref, SgExpression *ecount) -{ // generating function call: loop_cuda_shared_needed_(DvmhLoopRef *InDvmhLoop, DvmType *count) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[SHARED_NEEDED]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(*ecount); - return(fe); -} - -SgExpression *GetLocalPart(SgSymbol *s_loop_ref, SgSymbol *shead, SgSymbol *s_const) -{ // generating function call: - // void * loop_cuda_get_local_part (DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[], DvmType indexType); - // or when RTS2 is used - // void *dvmh_loop_cuda_get_local_part_C(DvmType curLoop, const DvmType dvmDesc[], DvmType indexType) - - int fNum = INTERFACE_RTS2 ? GET_LOCAL_PART_C : GET_LOCAL_PART ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgArrayRefExp(*shead)); - fe->addArg(* new SgVarRefExp(s_const)); - return(fe); - -} - -SgExpression *GetDeviceNum(SgSymbol *s_loop_ref) -{ // generating function call: - // DvmType loop_get_device_num_ (DvmhLoopRef *InDvmhLoop) - // or when RTS2 is used - // DvmType dvmh_loop_get_device_num_C ( DvmType curLoop) - - int fNum = INTERFACE_RTS2 ? GET_DEVICE_NUM_2 : GET_DEVICE_NUM ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - return(fe); - -} - -SgExpression *GetOverallStep(SgSymbol *s_loop_ref) -{ // generating function call: - // loop_cuda_get_red_step (DvmhLoopRef *InDvmhLoop) - //DvmType loop_get_overall_blocks_(DvmhLoopRef *InDvmhLoop) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_OVERALL_STEP]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - - return(fe); - -} - -SgExpression *FillBounds(SgSymbol *loop_s, SgSymbol *sBlow,SgSymbol *sBhigh,SgSymbol *sBstep) -{// generating function call: - // loop_fill_bounds_(DvmType *InDvmhLoop, DvmType lowIndex[], DvmType highIndex[], DvmType stepIndex[]) - // DvmhLoopRef - result of loop_create() - // or when RTS2 is used - // dvmh_loop_fill_bounds_(const DvmType *pCurLoop, DvmType boundsLow[], DvmType boundsHigh[], DvmType loopSteps[]); - - int fNum = INTERFACE_RTS2 ? FILL_BOUNDS_2 : FILL_BOUNDS_C ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - fe -> addArg(* new SgVarRefExp(loop_s)); - fe -> addArg(* new SgVarRefExp(sBlow)); - fe -> addArg(* new SgVarRefExp(sBhigh)); - if(sBstep) - fe -> addArg(* new SgVarRefExp(sBstep)); - else - fe -> addArg(* new SgValueExp(0)); - return(fe); -} - -SgExpression *LoopGetRemoteBuf(SgSymbol *loop_s, int n, SgSymbol *s_buf_head) -{// generating function call: dvmh_loop_get_remote_buf_(const DvmType *pCurLoop, const DvmType *pRmaIndex, DvmType rmaDesc[]); - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_REMOTE_BUF_C]); - fe->addArg(SgDerefOp(*new SgVarRefExp(loop_s))); - fe->addArg(*new SgValueExp(n)); - fe->addArg(*new SgArrayRefExp(*s_buf_head)); - return(fe); -} - -SgExpression *RedPost(SgSymbol *loop_s, SgSymbol *s_var_num, SgSymbol *sRed,SgSymbol *sLoc) -{// generating function call: - // void loop_red_post_(DvmhLoopRef *InDvmhLoop, DvmType *InRedNum, void *arrayPtr, void *locPtr) - // DvmhLoopRef - result of loop_create() - // or when RTS2 is used - // void dvmh_loop_red_post_(const DvmType *pCurLoop, const DvmType *pRedIndex, const void *arrayAddr, const void *locAddr) - - int fNum = INTERFACE_RTS2 ? RED_POST_2 : RED_POST_C ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - fe->addArg(* new SgVarRefExp(loop_s)); - fe->addArg(SgAddrOp(* new SgVarRefExp(s_var_num))); - fe->addArg(SgAddrOp(* new SgVarRefExp(sRed))); - if(sLoc) - fe -> addArg(*new SgArrayRefExp(*sLoc)); - else - fe -> addArg(*new SgValueExp(0)); - - return(fe); -} - -SgExpression *CudaReplicate(SgSymbol *Addr, SgSymbol *recordSize, SgSymbol *quantity, SgSymbol *devPtr) -{// generating function call: - // void dvmh_cuda_replicate_(void *addr, DvmType recordSize, DvmType quantity, void *devPtr) - // - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CUDA_REPLICATE]); - - fe->addArg(SgAddrOp(* new SgVarRefExp(Addr))); - fe->addArg(* new SgVarRefExp(recordSize)); - fe->addArg(* new SgVarRefExp(quantity)); - fe->addArg(* new SgVarRefExp(devPtr)); - - return(fe); -} - -SgExpression *GetDependencyMask(SgSymbol *s_loop_ref) -{ // generating function call: - // DvmType loop_get_dependency_mask_(DvmhLoopRef *InDvmhLoop) - // or when RTS2 is used - // DvmType dvmh_loop_get_dependency_mask_(const DvmType *pCurLoop) - - int fNum = INTERFACE_RTS2 ? GET_DEP_MASK_2 : GET_DEP_MASK ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - - return(fe); - -} - -SgExpression *CudaTransform(SgSymbol *s_loop_ref, SgSymbol *s_head, SgSymbol *s_BackFlag, SgSymbol *s_headH, SgSymbol *s_addrParam) -{ // generating function call: - // DvmType loop_cuda_transform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[], DvmhLoopRef *backFlagRef, DvmType dvmhDesc[], DvmType addressingParams[]) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CUDA_TRANSFORM]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgArrayRefExp(*s_head)); - fe->addArg(SgAddrOp(*new SgVarRefExp(s_BackFlag))); - fe->addArg(* new SgArrayRefExp(*s_headH)); - fe->addArg(* new SgArrayRefExp(*s_addrParam)); - return(fe); -} - -SgExpression *CudaAutoTransform(SgSymbol *s_loop_ref, SgSymbol *s_head) -{ // generating function call: - // DvmType loop_cuda_autotransform(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]) - // or when RTS2 is used - // DvmType dvmh_loop_autotransform_(const DvmType *pCurLoop, DvmType dvmDesc[]) - - int fNum = INTERFACE_RTS2 ? LOOP_AUTOTRANSFORM : CUDA_AUTOTRANSFORM ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - fe->addArg(* new SgVarRefExp(s_loop_ref)); - fe->addArg(* new SgArrayRefExp(*s_head)); - return(fe); -} - -SgExpression *ApplyOffset(SgSymbol *s_head, SgSymbol *s_base, SgSymbol *s_headH) -{ // generating function call: - // dvmh_apply_offset(DvmType dvmDesc[], void *base, DvmType dvmhDesc[]) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[APPLY_OFFSET]); - - fe->addArg(* new SgArrayRefExp(*s_head)); - fe->addArg(* new SgVarRefExp(s_base)); - fe->addArg(* new SgArrayRefExp(*s_headH)); - return(fe); - -} - -SgExpression *GetConfig(SgSymbol *s_loop_ref,SgSymbol *s_shared_perThread,SgSymbol *s_regs_perThread,SgSymbol *s_threads,SgSymbol *s_stream, SgSymbol *s_shared_perBlock) -{ // generating function call: void loop_cuda_get_config_ (DvmhLoopRef *InDvmhLoop, DvmType InSharedPerThread, DvmType InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream, DvmType *OutSharedPerBlock) - // or when RTS2 is used - // dvmh_loop_cuda_get_config_C(DvmType curLoop, DvmType sharedPerThread, DvmType regsPerThread, void *inOutThreads, void *outStream,DvmType *outSharedPerBlock) - - int fNum = INTERFACE_RTS2 ? GET_CONFIG_C : GET_CONFIG ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(* new SgVarRefExp(s_loop_ref)); - if(s_shared_perThread) - fe->addArg(*new SgVarRefExp(*s_shared_perThread)); - else - fe->addArg(*new SgValueExp(0)); - if(s_regs_perThread) - fe->addArg(*new SgVarRefExp(*s_regs_perThread)); - else - fe->addArg(*new SgValueExp(0)); - - fe->addArg(SgAddrOp(* new SgVarRefExp(*s_threads))); - fe->addArg(SgAddrOp(* new SgVarRefExp(*s_stream))); - if(s_shared_perBlock) - fe->addArg(SgAddrOp(* new SgVarRefExp(*s_shared_perBlock))); - else - fe->addArg(* new SgValueExp(0)); - return(fe); -} - -SgExpression *ChangeFilledBounds(SgSymbol *s_low,SgSymbol *s_high,SgSymbol *s_idx, SgSymbol *s_n,SgSymbol *s_dep,SgSymbol *s_type,SgSymbol *s_idxs) -{// generating function call: - // void dvmh_change_filled_bounds(DvmType *low, DvmType *high, DvmType *idx, DvmType n, DvmType dep, DvmType type_of_run, DvmType *idxs); - // dvmh_change_filled_bounds_C(DvmType boundsLow[], DvmType boundsHigh[], DvmType loopSteps[], DvmType rank, DvmType depMask, DvmType idxPerm[]) - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CHANGE_BOUNDS]); - - fe -> addArg(* new SgVarRefExp(s_low)); - fe -> addArg(* new SgVarRefExp(s_high)); - fe -> addArg(* new SgVarRefExp(s_idx)); - fe -> addArg(* new SgVarRefExp(s_n)); - fe -> addArg(* new SgVarRefExp(s_dep)); - fe -> addArg(* new SgVarRefExp(s_type)); - fe -> addArg(* new SgVarRefExp(s_idxs)); - return(fe); -} - -SgExpression *GuessIndexType(SgSymbol *s_loop_ref) -{// generating function call: - // loop_guess_index_type_(DvmhLoopRef *InDvmhLoop) - // or when RTS2 is used - // dvmh_loop_guess_index_type_C(DvmType *curLoop) - - int fNum = INTERFACE_RTS2 ? GUESS_INDEX_TYPE_2 : GUESS_INDEX_TYPE ; - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); - if(INTERFACE_RTS2) - fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); - else - fe->addArg(*new SgVarRefExp(s_loop_ref)); - return(fe); -} - -SgExpression *RtcSetLang(SgSymbol *s_loop_ref, const int lang) -{// generating function call: - // loop_cuda_rtc_set_lang(DvmType *InDvmhLoop, DvmType lang) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RTC_SET_LANG]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - if (lang == 0) - fe->addArg(*new SgKeywordValExp("FORTRAN_CUDA")); - else if (lang == 1) - fe->addArg(*new SgKeywordValExp("C_CUDA")); - else - fe->addArg(*new SgKeywordValExp("UNKNOWN_CUDA")); - return(fe); -} - -SgExpression *GetDeviceProp(SgSymbol *s_loop_ref, SgExpression *ep) -{// generating function call: - // DvmType loop_cuda_get_device_prop(DvmType *InDvmhLoop, DvmType prop); - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_DEVICE_PROP]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - fe->addArg(*ep); - return(fe); -} - -SgExpression *GetMaxBlocks(SgSymbol *s_loop_ref, SgSymbol *s_max_blocks, SgSymbol *s_needed_bytes) -{// generating function call: - // DvmType loop_cuda_get_max_blocks(DvmType *InDvmhLoop, DvmType maxBlocks, DvmType neededBytesForBlock) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_MAX_BLOCKS]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - fe->addArg(*new SgVarRefExp(s_max_blocks)); - fe->addArg(*new SgVarRefExp(s_needed_bytes)); - return(fe); -} - -SgExpression *GetPrivateArray(SgSymbol *s_loop_ref, SgExpression *e_bytes) -{// generating function call: - // DvmType *loop_cuda_get_private_array(DvmType *InDvmhLoop, UDvmType neededBytes) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_PRIVATE_ARR]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - fe->addArg(*e_bytes); - return(fe); -} - -SgExpression *DisposePrivateArray(SgSymbol *s_loop_ref, SgSymbol *s_array) -{// generating function call: - // void loop_cuda_dispose_private_array(DvmType *InDvmhLoop, void *array) - - SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DISPOSE_PRIVATE_AR]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - fe->addArg(*new SgVarRefExp(s_array)); - return(fe); -} - -SgExpression* GetWarpSize(SgSymbol* s_loop_ref) -{// generating function call: - // int dvmh_get_warp_size(DvmType *InDvmhLoop) - - SgFunctionCallExp* fe = new SgFunctionCallExp(*fdvm[GET_WARP_SIZE]); - - fe->addArg(*new SgVarRefExp(s_loop_ref)); - return(fe); -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/help.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/help.cpp deleted file mode 100644 index e415a46..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/help.cpp +++ /dev/null @@ -1,1070 +0,0 @@ -/**************************************************************\ -* Fortran DVM * -* * -* Miscellaneous help routines * -\**************************************************************/ - -#include "dvm.h" -#include -#include -extern "C" PTR_SYMB last_file_symbol; -//************************************************************* -/* -* Error - formats the error message then call "err" to print it -* -* input: -* s - string that specifies the conversion format -* t - string that to be formated according to s -* num - error message number -* stmt - pointer to the statement -*/ -//************************************************************* -void Error(const char *s, const char *t, int num, SgStatement *stmt) - -{ - char *buff = new char[strlen(t) + strlen(s) + 8]; - sprintf(buff, s, t); - err(buff, num, stmt); - - delete []buff; -} - -/* -* Err_g - formats and prints the special kind error message (without statement reference) -* -* input: -* s - string that specifies the conversion format -* t - string that to be formated according to s -* num - error message number -*/ - -void Err_g(const char *s, const char *t, int num) - -{ - char *buff = new char[strlen(t) + strlen(s) + 8]; - char num3s[4]; - sprintf(buff, s, t); - format_num(num, num3s); - err_cnt++; - (void)fprintf(stderr, "Error %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); - delete []buff; -} - -/* -* err_p -- prints the special kind error message (with procedure reference) -* -* input: -* s - string to be printed out -* num - error message number -* name - procedure identifier -*/ -void err_p(const char *s, const char *name, int num) - -{ - char num3s[4]; - format_num(num, num3s); - err_cnt++; - - (void)fprintf(stderr, "Error %s in procedure %s: %s \n", num3s, name, s); -} - -/* -* err -- prints the error message -* -* input: -* s - string to be printed out -* num - error message number -* stmt - pointer to the statement -*/ -void err(const char *s, int num, SgStatement *stmt) - -{ - char num3s[4]; - format_num(num, num3s); - err_cnt++; - // printf( "Error on line %d : %s\n", stmt->lineNumber(), s); - (void)fprintf(stderr, "Error %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); -} - -/* -* Warning -- formats a warning message then call "warn" to print it out -* -* input: -* s - string that specifies the conversion format -* t - string that to be converted according to s -* num - warning message number -* stmt - pointer to the statement -*/ -void Warning(const char *s, const char *t, int num, SgStatement *stmt) -{ - char *buff = new char[strlen(t) + strlen(s) + 8]; - sprintf(buff, s, t); - warn(buff, num, stmt); - - delete []buff; -} - -/* -* warn -- print the warning message if specified -* -* input: -* s - string to be printed -* num - warning message number -* stmt - pointer to the statement -*/ -void warn(const char *s, int num, SgStatement *stmt) -{ - char num3s[4]; - format_num(num, num3s); - // printf( "Warning on line %d: %s\n", stmt->lineNumber(), s); - (void)fprintf(stderr, "Warning %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); - -} - -void Warn_g(const char *s, const char *t, int num) -{ - char *buff = new char[strlen(t) + strlen(s) + 8]; - char num3s[4]; - format_num(num, num3s); - sprintf(buff, s, t); - (void)fprintf(stderr, "Warning %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); - delete []buff; -} - -//********************************************************************* -void printVariantName(int i) -{ - if ((i >= 0 && i < MAXTAGS) && tag[i]) - printf("%s", tag[i]); - else - printf("not a known node variant"); -} -//*********************************** - -//TODO: allocate buffer dynamically! -#define BUFLEN 500000 -static char buffer[BUFLEN], *bp; -#define binop(n) (n >= EQ_OP && n <= NEQV_OP) - -static const char *fop_name[] = { - " .eq. ", - " .lt. ", - " .gt. ", - " .ne. ", - " .le. ", - " .ge. ", - " + ", - " - ", - " .or. ", - " * ", - " / ", - "", - " .and. ", - "**", - "", - " // ", - " .xor. ", - " .eqv. ", - " .neqv. " -}; - - -/* -* Precedence table of operators for Fortran -*/ -static char precedence[] = { /* precedence table of the operators */ - 5, /* .eq. */ - 5, /* .lt. */ - 5, /* .gt. */ - 5, /* .ne. */ - 5, /* .le. */ - 5, /* .ge. */ - 3, /* + */ - 3, /* - */ - 8, /* .or. */ - 2, /* * */ - 2, /* / */ - 0, /* none */ - 7, /* .and. */ - 1, /* ** */ - 0, /* none */ - 4, /* // */ - 8, /* .xor. */ - 9, /* .eqv. */ - 9 /* .neqv. */ -}; - - -/* -* Type names in ascii form -*/ -/*static const char *ftype_name[] = { - "integer", - "real", - "double precision", - "character", - "logical", - "character", - "gate", - "event", - "sequence", - "", - "", - "", - "", - "complex", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "", - "double complex" -};*/ - -/**************************************************************** -* * -* addstr -- add the string "s" to output buffer * -* * -* Input: * -* s - the string to be appended to the buffer * -* * -* Side effect: * -* bp - points to where next character will go * -* * -****************************************************************/ -void addstr(const char *s) -{ - while ((*bp = *s++) != 0) - bp++; -} - -/**************************************************************** -* * -* unp_llnd -- unparse the given low level node to source * -* string * -* * -* Input: * -* pllnd - low level node to be unparsed * -* bp (implicitely) - where the output string to be * -* placed * -* * -* Output: * -* the unparse string where "bp" was pointed to * -* * -* Side Effect: * -* "bp" will be updated to the next character behind * -* the end of the unparsed string (by "addstr") * -* * -****************************************************************/ -void unp_llnd(PTR_LLND pllnd) -{ - if (pllnd == NULL) - return; - - switch (pllnd->variant) - { - case INT_VAL: - { char sb[64]; - - sprintf(sb, "%d", pllnd->entry.ival); - addstr(sb); - break; - } - case LABEL_REF: - { char sb[64]; - - sprintf(sb, "%d", (int)pllnd->entry.label_list.lab_ptr->stateno); - addstr(sb); - break; - } - case FLOAT_VAL: - case DOUBLE_VAL: - case STMT_STR: - addstr(pllnd->entry.string_val); - break; - case STRING_VAL: - *bp++ = '\''; - addstr(pllnd->entry.string_val); - *bp++ = '\''; - break; - case COMPLEX_VAL: - *bp++ = '('; - unp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ','; - unp_llnd(pllnd->entry.Template.ll_ptr2); - *bp++ = ')'; - break; - case KEYWORD_VAL: - addstr(pllnd->entry.string_val); - break; - case KEYWORD_ARG: - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("="); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case BOOL_VAL: - if (pllnd->entry.bval) - addstr(".TRUE."); - else - addstr(".FALSE."); - break; - case CHAR_VAL: - /* if (! in_impli) */ - *bp++ = '\''; - *bp++ = pllnd->entry.cval; - /* if (! in_impli) */ - *bp++ = '\''; - break; - case CONST_REF: - case VAR_REF: - case ENUM_REF: - case TYPE_REF: - case INTERFACE_REF: - addstr(pllnd->entry.Template.symbol->ident); - /* Look out !!!! */ - /* Purpose unknown. Commented out. */ - /* - if (pllnd->entry.Template.symbol->type->entry.Template.ranges != LLNULL) - unp_llnd(pllnd->entry.Template.symbol->type->entry.Template.ranges); - */ - break; - case ARRAY_REF: - addstr(pllnd->entry.array_ref.symbol->ident); - if (pllnd->entry.array_ref.index) { - *bp++ = '('; - unp_llnd(pllnd->entry.array_ref.index); - *bp++ = ')'; - } - break; - case ARRAY_OP: - unp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = '('; - unp_llnd(pllnd->entry.Template.ll_ptr2); - *bp++ = ')'; - break; - case RECORD_REF: - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("%"); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case STRUCTURE_CONSTRUCTOR: - addstr(pllnd->entry.Template.symbol->ident); - *bp++ = '('; - unp_llnd(pllnd->entry.Template.ll_ptr1); - *bp++ = ')'; - break; - case CONSTRUCTOR_REF: - addstr("(/"); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("/)"); - break; - case ACCESS_REF: - unp_llnd(pllnd->entry.access_ref.access); - if (pllnd->entry.access_ref.index != NULL) { - *bp++ = '('; - unp_llnd(pllnd->entry.access_ref.index); - *bp++ = ')'; - } - break; - case OVERLOADED_CALL: - break; - case CONS: - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(","); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case ACCESS: - unp_llnd(pllnd->entry.access.array); - addstr(", FORALL=("); - addstr(pllnd->entry.access.control_var->ident); - *bp++ = '='; - unp_llnd(pllnd->entry.access.range); - *bp++ = ')'; - break; - case IOACCESS: - *bp++ = '('; - unp_llnd(pllnd->entry.ioaccess.array); - addstr(", "); - addstr(pllnd->entry.ioaccess.control_var->ident); - *bp++ = '='; - unp_llnd(pllnd->entry.ioaccess.range); - *bp++ = ')'; - break; - case PROC_CALL: - case FUNC_CALL: - addstr(pllnd->entry.proc.symbol->ident); - *bp++ = '('; - unp_llnd(pllnd->entry.proc.param_list); - *bp++ = ')'; - break; - case EXPR_LIST: - unp_llnd(pllnd->entry.list.item); - /* if (in_param) { - addstr("="); - unp_llnd(pllnd->entry.list.item->entry.const_ref.symbol->entry.const_value); - } - */ - if (pllnd->entry.list.next) { - addstr(","); - unp_llnd(pllnd->entry.list.next); - } - break; - case EQUI_LIST: - *bp++ = '('; - unp_llnd(pllnd->entry.list.item); - *bp++ = ')'; - if (pllnd->entry.list.next) { - addstr(", "); - unp_llnd(pllnd->entry.list.next); - } - break; - case COMM_LIST: - case NAMELIST_LIST: - if (pllnd->entry.Template.symbol) { - *bp++ = '/'; - addstr(pllnd->entry.Template.symbol->ident); - *bp++ = '/'; - } - unp_llnd(pllnd->entry.list.item); - if (pllnd->entry.list.next) { - addstr(", "); - unp_llnd(pllnd->entry.list.next); - } - break; - case VAR_LIST: - case RANGE_LIST: - case CONTROL_LIST: - unp_llnd(pllnd->entry.list.item); - if (pllnd->entry.list.next) { - addstr(","); - unp_llnd(pllnd->entry.list.next); - } - break; - case DDOT: - if (pllnd->entry.binary_op.l_operand) - unp_llnd(pllnd->entry.binary_op.l_operand); - *bp++ = ':'; - if (pllnd->entry.binary_op.r_operand) - unp_llnd(pllnd->entry.binary_op.r_operand); - break; - case DEFAULT: - addstr("default"); - break; - case DEF_CHOICE: - case SEQ: - unp_llnd(pllnd->entry.seq.ddot); - if (pllnd->entry.seq.stride) { - *bp++ = ':'; - unp_llnd(pllnd->entry.seq.stride); - } - break; - case SPEC_PAIR: - unp_llnd(pllnd->entry.spec_pair.sp_label); - *bp++ = '='; - unp_llnd(pllnd->entry.spec_pair.sp_value); - break; - case EQ_OP: - case LT_OP: - case GT_OP: - case NOTEQL_OP: - case LTEQL_OP: - case GTEQL_OP: - case ADD_OP: - case SUBT_OP: - case OR_OP: - case MULT_OP: - case DIV_OP: - case MOD_OP: - case AND_OP: - case EXP_OP: - case CONCAT_OP: - { - int i = pllnd->variant - EQ_OP, j; - PTR_LLND p; - int num_paren = 0; - - p = pllnd->entry.binary_op.l_operand; - j = p->variant; - if (binop(j) && precedence[i] < precedence[j - EQ_OP]) { - num_paren++; - *bp++ = '('; - } - unp_llnd(p); - if (num_paren) { - *bp++ = ')'; - num_paren--; - } - addstr(fop_name[i]); /* print the op name */ - p = pllnd->entry.binary_op.r_operand; - j = p->variant; - if (binop(j) && precedence[i] <= precedence[j - EQ_OP]) { - num_paren++; - *bp++ = '('; - } - unp_llnd(p); - if (num_paren) { - *bp++ = ')'; - num_paren--; - } - break; - } - case MINUS_OP: - addstr(" -("); - unp_llnd(pllnd->entry.unary_op.operand); - *bp++ = ')'; - break; - case UNARY_ADD_OP: - addstr(" +("); - unp_llnd(pllnd->entry.unary_op.operand); - *bp++ = ')'; - break; - case NOT_OP: - addstr(" .not. ("); - unp_llnd(pllnd->entry.unary_op.operand); - *bp++ = ')'; - break; - case PAREN_OP: - addstr("("); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(")"); - case ASSGN_OP: - addstr("="); - unp_llnd(pllnd->entry.Template.ll_ptr1); - case STAR_RANGE: - addstr(" : "); - break; - case OMP_THREADPRIVATE: /*OMP*/ - addstr(" / "); /*OMP*/ - unp_llnd(pllnd->entry.Template.ll_ptr1); /*OMP*/ - addstr(" / "); /*OMP*/ - break; /*OMP*/ - /* case IMPL_TYPE: - pr_ftype_name(pllnd->type, 1); - if (pllnd->entry.Template.ll_ptr1 != LLNULL) - { - addstr("("); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(")"); - } - break; - */ - /* - case ORDERED_OP : - addstr("ordered "); - break; - case EXTEND_OP : - addstr("extended "); - break; - case MAXPARALLEL_OP: - addstr("max parallel = "); - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case PARAMETER_OP : - addstr("parameter "); - break; - case PUBLIC_OP : - addstr("public "); - break; - case PRIVATE_OP : - addstr("private "); - break; - case ALLOCATABLE_OP : - addstr("allocatable "); - break; - case DIMENSION_OP : - addstr("dimension ("); - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr(")"); - break; - case EXTERNAL_OP : - addstr("external "); - break; - case OPTIONAL_OP : - addstr("optional "); - break; - case IN_OP : - addstr("intent (in) "); - break; - case OUT_OP : - addstr("intent (out) "); - break; - case INOUT_OP : - addstr("intent (inout) "); - break; - case INTRINSIC_OP : - addstr("intrinsic "); - break; - case POINTER_OP : - addstr("pointer "); - break; - case SAVE_OP : - addstr("save "); - break; - case TARGET_OP : - addstr("target "); - break; - */ - case LEN_OP: - addstr("*"); - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - /* case TYPE_OP : - pr_ftype_name(pllnd->type, 1); - unp_llnd(pllnd->type->entry.Template.ranges); - break; - */ - /* - case ONLY_NODE : - addstr("only: "); - if (pllnd->entry.Template.ll_ptr1) - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case DEREF_OP : - unp_llnd(pllnd->entry.Template.ll_ptr1); - break; - case RENAME_NODE : - unp_llnd(pllnd->entry.Template.ll_ptr1); - addstr("=>"); - unp_llnd(pllnd->entry.Template.ll_ptr2); - break; - case VARIABLE_NAME : - addstr(pllnd->entry.Template.symbol->ident); - break; - */ - default: - fprintf(stderr, "Error: unp_llnd -- bad llnd_ptr %d!\n", pllnd->variant); - break; - } -} - -/**************************************************************** -* * -* funparse_llnd -- unparse the low level node for Fortran * -* * -* input: * -* llnd -- the node to be unparsed * -* * -* output: * -* the unparsed string * -* * -****************************************************************/ -char* funparse_llnd(PTR_LLND llnd) -{ - int len; - char *p; - - bp = buffer; /* reset the buffer pointer */ - unp_llnd(llnd); - /* *bp++ = '\n'; */ - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = (char *)malloc(len); /* allocate space for returned value */ - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - return p; -} - -char *UnparseExpr(SgExpression *e) -{ - char *buf; - - if (isSgVarRefExp(e) || (isSgArrayRefExp(e) && (!(e->lhs()) || d_no_index))) - return (e->symbol()->identifier()); - - buf = funparse_llnd(e->thellnd); - return buf; -} -/* -char *UnparseExpr(SgExpression *e) -{char *buf; - -int l; -if(isSgVarRefExp(e) || (isSgArrayRefExp(e) && !(e->lhs()))) -return (e->symbol()->identifier()); -Init_Unparser(); -buf = Tool_Unparse2_LLnode(e->thellnd); -l = strlen(buf); -char *ustr = new char[l+1]; -strcpy(ustr,buf); -//ustr[l] = ' '; -//ustr[l+1] = '\0'; -return(ustr); -} -*/ -//************************************ - -const char* header(int i) -{ - switch (i) - { - case(PROG_HEDR) : - return("program"); - case(PROC_HEDR) : - return("subroutine"); - case(FUNC_HEDR) : - return("function"); - default: - return("error"); - } -} - -SgLabel* firstLabel(SgFile *f) -{ - SetCurrentFileTo(f->filept); - SwitchToFile(GetFileNumWithPt(f->filept)); - return LabelMapping(PROJ_FIRST_LABEL()); -} - -int isLabel(int num) -{ - PTR_LABEL lab; - for (lab = PROJ_FIRST_LABEL(); lab; lab = LABEL_NEXT(lab)) - if (num == LABEL_STMTNO(lab)) - return 1; - return 0; -} - -SgLabel* GetLabel() -{ - static int lnum = 90000; - if (lnum>max_lab) - return (new SgLabel(lnum--)); - while (isLabel(lnum)) - lnum--; - return (new SgLabel(lnum--)); -} -/* -int FragmentList(char *l, int level) -{char ch[10],*str,*p; -int num; -D_fragment *fr; -str = l; -p = ch; -cur_num: -for(; (*str != '\0' && *str != ','); str++) -if(isdigit(*str)) -*p++ = *str; -else -return(0); -*p = '\0'; -num = atoi(p); -fr = new D_fragment; -fr->next = NULL; -fr->No = num; -if(num == 0) { -fr->next = deb[level]; -deb[level] = fr; -} else -if(!deb[level]){ -fr->next = NULL; -deb[level] = fr; -} else { -fr->next = deb[level]->next; -deb[level] ->next = fr; -} - -if(*str == '\0') -return(1); - -str = str+1; -goto cur_num; - -return(1); -} - - -int FragmentList(char *l, int dlevel, int elevel) -{char ch[10],*str,*p; -int num,num1; -str = l; -num1 =0; -cur_num: -p = ch; -if(!isdigit(*str)) return(0); -for(; (*str != '\0' && *str != ',' && *str != '-'); str++) -if(isdigit(*str)) -*p++ = *str; -else -//return(0); -break; -*p = '\0'; -num = atoi(ch); -if(*str == '-') -num1 = num; -else -if(num1){ -AddToFragmentList(num1,num,dlevel,elevel); -num1 =0; -} -else -AddToFragmentList(num,num,dlevel,elevel); - -if(*str == '\0') -return(1); -if(*str != ',' && *str != '-') -return(0); -str = str+1; -goto cur_num; - -} -*/ - -int FragmentList(char *l, int dlevel, int elevel) -{ - char ch[10], *str, *p; - int num, num1; - str = l; - num1 = 0; -cur_num: - p = ch; - if (!isdigit(*str)) return(0); - for (; (*str != '\0' && *str != ',' && *str != '-'); str++) - if (isdigit(*str)) - *p++ = *str; - else - //return(0); - break; - *p = '\0'; - num = atoi(ch); - if (*str == '-') - num1 = num; - else - if (num1){ - AddToFragmentList(num1, num, dlevel, elevel); - num1 = 0; - } - else - AddToFragmentList(num, num, dlevel, elevel); - - if (*str == '\0') - return(1); - if (*str != ',' && *str != '-') - return(0); - str = str + 1; - goto cur_num; - -} -/* -void AddToFragmentList(int num,int dlevel,int elevel) -{ fragment_list *fr; -if(dlevel == 0 && elevel == 0) -return; -if(!debug_fragment) { -debug_fragment = new fragment_list; -debug_fragment->No = num; -debug_fragment->next = NULL; -debug_fragment->dlevel = dlevel; -debug_fragment->elevel = elevel; -} else { -for(fr= debug_fragment; fr; fr=fr->next) -if(fr->No == num) { -if(dlevel != 0) -fr->dlevel = dlevel; -if(elevel != 0) -fr->elevel = elevel; -return; -} -fr = new fragment_list; -fr->No = num; -fr->dlevel = dlevel; -fr->elevel = elevel; -fr->next = debug_fragment; -debug_fragment = fr; -} -return; -} - -void AddToFragmentList(int num1, int num2, int dlevel, int elevel) -{ fragment_list_in *fr; -if(dlevel == 0 && elevel == 0) -return; -fr = new fragment_list_in; -fr->N1 = num1; -fr->N2 = num2; -fr->dlevel = dlevel; -fr->elevel = elevel; -fr->next = debug_fragment; -debug_fragment = fr; -return; -} -*/ - -void AddToFragmentList(int num1, int num2, int dlevel, int elevel) -{ - fragment_list_in *fr; - if (dlevel == -1 && elevel == -1) - return; - fr = new fragment_list_in; - fr->N1 = num1; - fr->N2 = num2; - if (elevel == -1) { - fr->level = dlevel; - fr->next = debug_fragment; - debug_fragment = fr; - } - else { - fr->level = elevel; - fr->next = perf_fragment; - perf_fragment = fr; - } - return; -} - -/* -fragment_list_in *AddToFragmentList(int num1, int num2, int level, fragment_list_in *frlist) -{ fragment_list_in *fr; -if(level == 0) -return; -fr = new fragment_list_in; -fr->N1 = num1; -fr->N2 = num2; -fr->level = level; -fr->next = frlist; -return(fr); -} -*/ - - -void format_num(int num, char num3s[]) -{ - if (num>99) - sprintf(num3s, "%3d", num); - else if (num>9) - sprintf(num3s, "0%2d", num); - else - sprintf(num3s, "00%1d", num); -} - -SgExpression* ConnectList(SgExpression *el1, SgExpression *el2) -{ - SgExpression *el; - if (!el1) - return(el2); - if (!el2) - return(el1); - for (el = el1; el->rhs(); el = el->rhs()) - ; - el->setRhs(el2); - return(el1); -} - -int is_integer_value(char *str) -{ - char *p; - p = str; - for (; *str != '\0'; str++) - if (!isdigit(*str)) - return 0; - return (atoi(p)); -} - -char* SymbListString(symb_list *symbl) -{ - symb_list *sl; - int len; - char *p; - - bp = buffer; /* reset the buffer pointer */ - for (sl = symbl; sl; sl = sl->next) - { - if (sl != symbl) - addstr(", "); - addstr(sl->symb->identifier()); - } - *bp++ = '\0'; - len = (bp - buffer) + 1; /* calculate the string length */ - p = (char *)malloc(len); /* allocate space for returned value */ - strcpy(p, buffer); /* copy the buffer for output */ - *buffer = '\0'; - - return p; -} - -char * baseFileName(char *name) -{//removal the path from the filename 'name' - char *p=strrchr(name,'/'); - if(p) - return (p+1); - else if(p=strrchr(name,'\\')) - return (p+1); - else - return(name); -} - -char *to_C_ident(char *name, bool allowFirstDigit) -{ - int l = strlen(name); - for (int i = 0; i < l; i++) - { - char c = name[i]; - if (!((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_' || ((i > 0 || allowFirstDigit) && c >= '0' && c <= '9'))) - name[i] = '_'; - } - return name; -} - -SgSymbol *isNameConcurrence(const char *name, SgStatement *func) -{ - SgSymbol *s, *until, *first; - until = SymbMapping(last_file_symbol)->next(); - first = func->symbol(); - for (s= first; s==first || s && DECL(s) != 1 && s != until; s = s->next()) - { - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -/* -SgSymbol *isNameConcurrence(const char *name, SgStatement *func) -{ - return (isSameNameInProgramUnit(name,func)); -} -*/ - -SgSymbol *isSameNameInProgramUnit(const char *name,SgStatement *func) -{ - SgSymbol *s, *until; - SgStatement *last = func->lastNodeOfStmt(); - while(last && last->variant()==CONTROL_END) - last = last->lexNext(); - if(last && last->symbol()) - until = last->symbol(); - else - until = SymbMapping(last_file_symbol)->next(); - - for (s= func->symbol(); s && s!=until; s = s->next()) - { - if (s && !strcmp(s->identifier(), name)) - return(s); - } - return(NULL); -} - -char *Check_Correct_Name(const char *name) -{ - SgSymbol *s = NULL; - char *ret = new char[strlen(name) + 1]; - strcpy(ret,name); - while ((s = isSameNameInProgramUnit(ret,cur_func))) - { - ret = new char[strlen(name) + 2]; - sprintf(ret, "%s_", s->identifier()); - } - return ret; -} - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/hpf.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/hpf.cpp deleted file mode 100644 index d469000..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/hpf.cpp +++ /dev/null @@ -1,1698 +0,0 @@ -/**************************************************************\ -* Fortran DVM * -* * -* Translating HPF-program * -\**************************************************************/ - -#include "dvm.h" -int hpf_new_var; -/**************************************************************\ -* Processing distributed array refference * -\**************************************************************/ -/*----------- outside the range of parallel loop -------------*/ -int SearchDistArrayRef(SgExpression *e, SgStatement *stmt) -{ int res = 0; - SgExpression *el,*eleft; - if(only_local) // option -Honlyl is specified: - return (res); // all the operands are local in sequential threads - //looks the expression 'e' for distributed array references, - // adds the attribute REMOTE_VARIABLE to the reference - //generates statements for loading the values of distributed array elements into buffers - if(!e) - return (res); - - if(isSgArrayRefExp(e)) { - for(el=e->lhs(); el; el=el->rhs()) - res = (SearchDistArrayRef(el->lhs(),stmt)) ? 1 : res; - - if(HEADER( e->symbol()) && e->lhs()) {//is distributed array reference with subscripts - if(stmt->variant() == ASSIGN_STAT) { - eleft = isSgArrayRefExp(stmt->expr(0));//left part of assignment statement - if(eleft && eleft->lhs() && RemAccessRefCompare(eleft, e)) - //array reference in right part of assignment statement is - //the same as one in left part - return(1); - } - BufferDistArrayRef(e,stmt); - //add attribute(REMOTE_VARIABLE) to distributed array reference - res = 1; - } - return(res); - } - - res = SearchDistArrayRef(e->lhs(),stmt); - res = (SearchDistArrayRef(e->rhs(),stmt)) ? 1 : res; - return(res); -} - -void BufferDistArrayRef(SgExpression *e, SgStatement *stmt) -{//generating statements for loading the value of distributed array element - // to buffer scalar variable and inserting ones before statement 'stmt' - //adding attribute REMOTE_VARIABLE to distributed array reference 'e' - int r,n,ibuf; - SgExpression *el; - rem_var *remv = new rem_var; - remv->ncolon = 0; - remv->index = ibuf = ++rmbuf_size[TypeIndex(e->symbol()->type()->baseType())]; - remv->amv = -1; - e->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); - r = Rank(e->symbol()); - for(el=e->lhs(),n=0; el; el = el->rhs(),n++) - ; - if(r && n && r != n) { - Error("Wrong number of subscripts specified for '%s'",e->symbol()->identifier(),175,stmt); - return; - } - if(first_time) { - SgStatement *st,*stw; - ReplaceContext(stmt); - stw = (stmt->variant() == ELSEIF_NODE) ? stmt->controlParent() : stmt; - //loading buffers for statement ELSEIF is performed before statement IF_THEN - LINE_NUMBER_STL_BEFORE(st,stmt,stw); - cur_st = st; - first_time = 0; - } - CopyToBuffer(0, ibuf, e); //loading buffer for distributed array's element - return; -} - -/*----------- inside the range of parallel loop --------------*/ - -SgExpression *IND_ModifiedDistArrayRef(SgExpression *e, SgStatement *st) -// analyzing distributed array reference: -// may this reference be used as IND_target? -{int i, num, ni, use[MAX_LOOP_NEST], IN_use; - SgExpression *ei,*el,*es,*ee; - ni = nIND+nIEX; - for(i= 0; ilhs())) return(NULL); //no subscripts - ee = &(e->copy()); - for(el=ee->lhs(); el; el=el->rhs()) { - es = el->lhs(); //subscript expression - IN_use = 0; - num = AxisNumOfDoVarInExpr(es, DoVar, ni, &ei, use, &IN_use, st); - if(num<0) return(NULL); - if(num>nIEX) {// IND-index is used - if(use[num-1] > 1) { - Error("More one occurance of do-variable '%s' in subscript list", DoVar[num-1]->identifier(),251, st); - return(NULL); - } - if(IN_use) //IND-index and IN-index are used - err("More one occurance of a do-variable in subscript expression", 252,st); - //err("Illegal subscript expression",253,cur_st); - } else - if(IN_use) //IN-index is used - el->setLhs(new SgExpression(DDOT)); //(new SgKeywordValExp("*")); - } - for(i= nIEX; icopy())); -} - -void IND_UsedDistArrayRef(SgExpression *e, SgStatement *st) -// analyzing the distributed array reference in right part of assignment statement and so on -// including it in the list IND_refs -{int i, num, ni, use[MAX_LOOP_NEST], IN_use, nt; - SgExpression *ei,*el,*es,*ee, *elbb; - SgValueExp c0(0),cM1(-1); - IND_ref_list *ref; - hpf_new_var=0; - ni = nIND+nIEX; - for(i= 0; ilhs())) return; //no subscripts - if(isINDtarget(e)){ // is the same reference as IND_target - // ( reference in left part of assignment statement) - IND_DistArrayRef(e, st, NULL); - return; - } - if((ref=isInINDrefList(e)) != NULL) {// the same reference is in list IND_refs - IND_DistArrayRef(e, st, ref); - return; - } - // creating new element of list of distributed array references used in parallel loop - ref = new IND_ref_list; - ref->next = IND_refs; - IND_refs = ref; - ee = &(e->copy()); - ref->rmref = ee; - ref->nc = 0; - ref->ind = 0; - nt = 0; - //looking through the subscript list - for(el=ee->lhs(); el; el=el->rhs(), nt++) { - es = el->lhs(); //subscript expression - IN_use = 0; - hpf_new_var=0; - //determinating kind of subscript expression - num = AxisNumOfDoVarInExpr(es, DoVar, ni, &ei, use, &IN_use, st); - if(num>nIEX) {// IND-index is used - ref->nc++; - if(IN_use) {//IND-index and IN-index are used : f(IN) - //err("More one occurance of a do-variable in subscript expression", 252,st); - el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':' - ref->axis[nt] = & cM1.copy(); - ref->coef[nt] = & c0.copy(); - ref->cons[nt] = & c0.copy(); - } else { - ref->axis[nt] = new SgValueExp(num-nIEX); - CoeffConst(es, ei, &(ref->coef[nt]), &(ref->cons[nt])); //testing form: a*IND+b - if(!ref->coef[nt]){ //f(IND) - //err("Illegal subscript expression", 253, stat); - el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':' - ref->axis[nt] = & cM1.copy(); - ref->coef[nt] = & c0.copy(); - ref->cons[nt] = & c0.copy(); - } - else //a*IND+b - // correcting const with lower bound of array - if((elbb = LowerBound(ref->rmref->symbol(),nt)) != NULL) - ref->cons[nt] = &(*(ref->cons[nt]) - (elbb->copy())); - } - } else // IND-index is not used - if(IN_use || hpf_new_var) {//IN-index is used: f(IN) or new variable is used - el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':' - ref->axis[nt] = & cM1.copy(); - ref->coef[nt] = & c0.copy(); - ref->cons[nt] = & c0.copy(); - ref->nc++; - } - else { // invariant: const,f(IEX) - ref->axis[nt] = & c0.copy(); - ref->coef[nt] = & c0.copy(); - if((elbb = LowerBound(ref->rmref->symbol(),nt)) != NULL) - ref->cons[nt] = & (es->copy() - (elbb->copy())); - // correcting const with lower bound of array - else //error situation - ref->cons[nt] = & (es->copy()); - } - } - if(nt < 7) - ref->axis[nt] = NULL; - - IND_DistArrayRef(e, st, ref); - return; -} - -int AxisNumOfDoVarInExpr (SgExpression *e, SgSymbol *dovar_ident[], int ni, SgExpression **eref, int use[], int *pINuse, SgStatement *st) -{ - SgSymbol *symb; - SgExpression * e1; - int i,i1,i2; - *eref = NULL; - if (!e) - return(0); - if(isSgVarRefExp(e)) { - symb = e->symbol(); - for(i=0; i= nIEX) - Error("More one occurance of do-variable '%s' in subscript list", symb->identifier(),251, st); - */ - use[i]++; - return(i+1); - } - } - if(isDoVar(symb)) // is IN-index - // (symb is not IEX- nor IND-index, but symb is do-variable => symb is IN-index) - (*pINuse)++; - if(isNewVar(symb)) - hpf_new_var=1; - return (0); - } - i1 = AxisNumOfDoVarInExpr(e->lhs(), dovar_ident, ni, eref, use, pINuse, st); - e1 = *eref; - i2 = AxisNumOfDoVarInExpr(e->rhs(), dovar_ident, ni, eref, use, pINuse, st); - if((i1==-1)||(i2==-1)) return(-1); - if(i1 && i1>=nIEX && i2 && i2>=nIEX) { - err("More one occurance of a do-variable in subscript expression", 252,st); - return(-1); - } - if(i1) *eref = e1; - return(i1 ? i1 : i2); -} - -int isINDtarget(SgExpression *re) -{if(RemAccessRefCompare(IND_target, re)) - return(1); - else - return (0); -} - -IND_ref_list *isInINDrefList(SgExpression *re) -{IND_ref_list *el; - //for(el=IND_refs; el; el=el->next) - //el->rmref->unparsestdout(); //?!!! - for(el=IND_refs; el; el=el->next) - if(RemAccessRefCompare(el->rmref, re)) - return(el); - return (NULL); -} -/* -void IND_DistArrayRef(SgExpression *e, SgStatement *st) -{SgSymbol *ar; - //replace distributed array reference A(I1,I2,...,In) by - // n - // ( HeaderCopy(n+1) + I1 + SUMMA(HeaderCopy(n-k+1) * Ik)) - // k=2 - // is I0000M if A is of type integer - // R0000M if A is of type real - // D0000M if A is of type double precision - // C0000M if A is of type complex - // L0000M if A is of type logical - ar = e->symbol(); - e->setSymbol(baseMemory(ar->type()->baseType())); - if(!e->lhs()) - Error("No subscripts: %s", ar->identifier(),171,st); - else { - (e->lhs())->setLhs(*LinearForm(ar,e->lhs())); - (e->lhs())->setRhs(NULL); - } -} -*/ - -void IND_DistArrayRef(SgExpression *e, SgStatement *st, IND_ref_list *el) -{SgSymbol *ar; - //replace distributed array reference A(I1,I2,...,In) by - // n - // ( HeaderCopy(n+1) + I1 + SUMMA(HeaderCopy(n-k+1) * Ik)) - // k=2 - // is I0000M if A is of type integer - // R0000M if A is of type real - // D0000M if A is of type double precision - // C0000M if A is of type complex - // L0000M if A is of type logical - ar = e->symbol(); - if(!el) { // local access reference - e->setSymbol(baseMemory(ar->type()->baseType())); - if(!e->lhs()) - Error("No subscripts: %s", ar->identifier(),171,st); - else { - (e->lhs())->setLhs(*LinearForm(ar,e->lhs(),NULL)); - (e->lhs())->setRhs(NULL); - } - } else { - int n, num, k; - SgExpression *esl; - SgExpression *p = NULL; - if(el->ind == 0) {//new reference: allocating header copy - el->ind = nhpf; - nhpf+=(el->nc)+2; - } - hpf_ind = el->ind; - if(el->nc) { //there are ':' or a*IND+b elements in index list of remote variable - for(n = 0; n<7 && el->axis[n]; n++) - ; - if(n && n != Rank(ar)) { - Error("Wrong number of subscripts specified for '%s'", ar->identifier(),175,st); - return; - } - //looking through the subscript and index lists - for(esl=e->lhs(),k=0; esl && krhs(),k++){ - num = el->axis[k]->valueInteger(); - if(num == -1) // ':' - p=esl; - else if(num > 0){ //do-variable-use: a*IND+b - esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND - /* - if(p) - esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND - else //first non-invariant index - if(INTEGER_VALUE(el->coef[k],1) && k == 0) // a == 1 - esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND - else - esl->setLhs(&(*HPF000((el->ind)+(el->nc)-1)*(*new SgVarRefExp(IND_var[num-1])))); - // replace by HeaderCopy(nc)*IND - */ - p=esl; - } - else - //delete corresponding subscript in reference - if(!p) - e->setLhs(esl->rhs()); - else - p->setRhs(esl->rhs()); - } - } - - e->setSymbol(baseMemory(ar->type()->baseType())); - num = el->axis[0]->valueInteger(); - if ((num == 0) || ((num > 0) && !INTEGER_VALUE(el->coef[0], 1)) )//first dimension is b or a*IND+b - // where a != 1 - e->lhs()->setLhs(*HPF000((el->ind)+(el->nc)) * (*e->lhs()->lhs())); - // first non-invariant index I is replaced by HeaderCopy(nc)*I - e->setLhs(*LinearFormB(hpfbuf, (el->ind), el->nc, e->lhs())); - } -} -/**************************************************************\ -* Processing independent loop nest * -\**************************************************************/ -void SkipIndepLoopNest(SgStatement *stmt) -{ - SgStatement *st,*stl; - stl = stmt; - // looking through the loop nest - for(st=par_do; isSgForStmt(st); st=st->lexNext()){ - stl = st; - if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) - Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive - else - break; - } - cur_st = stl; -} - -void LookIndepLoopNest(SgStatement *stmt) -{ int i; - SgStatement *st,*stl; - stl = stmt; - // looking through the loop nest - for(st=stmt->lexNext(),i = 0; isSgForStmt(st); st=st->lexNext(),i++){ - stl = st; - IND_var[i] = st->symbol(); - if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) - Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive - else - break; - } - cur_st = stl; -} - -int IndependentLoop(SgStatement *stmt) -{ - SgStatement *st, *if_stmt, *stl = NULL; - SgStatement *first_do; - SgValueExp c0(0); - int i, ndo, iout, iinp, ind; - SgForStmt *stdo; - SgValueExp c1(1); - SgExpression *step[MAX_LOOP_LEVEL], - *init[MAX_LOOP_LEVEL], - *last[MAX_LOOP_LEVEL], - *vpart[MAX_LOOP_LEVEL]; - - first_do = stmt -> lexNext();// first DO statement of the loop nest - IND_var = DoVar+nIEX; - IND_target = NULL; - IND_target_R = NULL; - IND_refs = NULL; - redl = NULL; - irg = 0; idebrg = 0; - red_list = NULL; - redgref = NULL; - //new_red_var_list = NULL; - -//initialization vpart[] - for(i=0; ilexNext()) { - ndo++; - if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) { - if(st->lexNext()->expr(0)) - stmt->setExpression(0,*ConnectNewList(stmt->expr(0),st->lexNext()->expr(0))); - //stmt->expr(0)->lhs()->unparsestdout(); - Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive - } - else - break; - } - /* if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) - st=st->lexNext(); - else - break; - */ - - nIND = ndo; -// generating assign statement: -// dvm000(i) = lnumb(num); // line number of stmt - LINE_NUMBER_AFTER(stmt,stmt); -//generating call to 'bploop' function of performance analizer (begin of parallel interval) - if(perf_analysis && perf_analysis != 2) - { - InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' - } - ins_st1 = cur_st; - -// generating assign statement: -// dvm000(iplp) = crtpl(Rank); - iplp = ndvm++; - doAssignTo_After(DVM000(iplp), CreateParLoop( ndo)); - -//allocating DebRedGroupRef - ndvm++; -//allocating RedGroupRef - ndvm++; -//allocating OutInitIndexArray,OutLastIndexArray,OutStepArray - iout = iarg = ndvm; - ndvm += 3*ndo; - -// looking through the loop nest - for(st=first_do,i=0; ilexNext(),i++) { - stdo = isSgForStmt(st); - if(!stdo) - break; - stl = st; - IND_var[i] = stdo->symbol(); - step[i] = stdo->step(); - if(!step[i]) - step[i] = & c1.copy(); // by default: step = 1 - init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,IND_var); - if( init[i] ) - step[i] = & c1.copy(); - else - init[i] = stdo->start(); - last[i] = stdo->end(); - - // setting new loop parameters - if(vpart[i]) - stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form - //step is not replaced - else { - stdo->setStart(*DVM000(iout+i)); - //stdo->setStep(*DVM000(iout+i+2*ndo)); - } - stdo->setEnd(*DVM000(iout+i+ndo)); - SetDoVar(stdo->symbol()); - } - - iinp = ndvm; - if(dvm_debug) - OpenParLoop_Inter(stl,iinp,iinp+ndo,IND_var,ndo); - - // creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray - // and InpStepArray - for(i=0; ilineNumber(); - DebugParLoop(cur_st,ndo,iinp+2*ndo); - /*SET_DVM(iinp+2*ndo); */ - } - /* else - { SET_DVM(iinp); } - */ - - // generating Logical IF statement: - // begin_lab IF (DoPL(LoopRef) .EQ. 0) GO TO end_lab - // and inserting it before loop nest - begin_lab = GetLabel(); - end_lab = GetLabel(); - if_stmt = new SgLogIfStmt(SgEqOp(*doLoop(iplp) , c0), *new SgGotoStmt(*end_lab)); - if_stmt -> setLabel(*begin_lab); - cur_st->insertStmtAfter(*if_stmt); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF - // (error Sage) - cur_st = stl; // set cur_st on last DO satement of loop nest - //cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest - // cur_st = stl->lexNext(); - return(1); //!!! -} - -int IndependentLoop_Debug(SgStatement *stmt) -{ SgStatement *st, *stl = NULL; - SgStatement *first_do; - SgValueExp c0(0); - int i, ndo, iout, iinp, ind; - SgForStmt *stdo; - SgValueExp c1(1); - SgExpression *step[MAX_LOOP_LEVEL], - *init[MAX_LOOP_LEVEL], - *last[MAX_LOOP_LEVEL], - *vpart[MAX_LOOP_LEVEL]; - - first_do = stmt -> lexNext();// first DO statement of the loop nest - IND_var = DoVar+nIEX; - IND_target = NULL; - IND_target_R = NULL; - IND_refs = NULL; - redl = NULL; - irg = 0; idebrg = 0; - red_list = NULL; - redgref = NULL; - //new_red_var_list = NULL; - -//determinating rank of independent loop - for(st=first_do,ndo=0; isSgForStmt(st); st=st->lexNext()) { - ndo++; - if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) { - if(st->lexNext()->expr(0)) - stmt->setExpression(0,*ConnectNewList(stmt->expr(0),st->lexNext()->expr(0))); - //stmt->expr(0)->lhs()->unparsestdout(); - Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive - } - else - break; - } - nIND = ndo; -// generating assign statement: -// dvm000(i) = lnumb(num); // line number of stmt - LINE_NUMBER_AFTER(stmt,stmt); -//generating call to 'bploop' function of performance analizer (begin of parallel interval) - if(perf_analysis && perf_analysis != 2) - { - InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' - } - ins_st1 = cur_st; - - iplp = 0; - -//allocating DebRedGroupRef - ndvm++; -//allocating RedGroupRef - ndvm++; - - iout = iarg = ndvm; - //ndvm += 3*ndo; - -//initialization vpart[] - for(i=0; ilexNext(),i++) { - stdo = isSgForStmt(st); - if(!stdo) - break; - stl = st; - IND_var[i] = stdo->symbol(); - step[i] = stdo->step(); - if(!step[i]) - step[i] = & c1.copy(); // by default: step = 1 - init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,IND_var); - if( init[i] ) - step[i] = & c1.copy(); - else - init[i] = stdo->start(); - last[i] = stdo->end(); - - SetDoVar(stdo->symbol()); - } - - iplp=iinp = ndvm; - OpenParLoop_Inter(stl,iinp,iinp+ndo,IND_var,ndo); - - // creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray - // and InpStepArray - /* for(i=0; ilineNumber(); - DebugParLoop(cur_st,ndo,iinp+2*ndo); - //SET_DVM(iinp+2*nloop); - cur_st = stl; // set cur_st on last DO satement of loop nest - return(1); -} - -SgExpression *ConnectNewList(SgExpression *el1, SgExpression *el2) -{// el1 , el2 - NEW specifications of INDEPENDENT directives - SgExpression *el; - if(!el1) - return(el2); - if(!el2) - return(el1); - for(el = el1->lhs(); el->rhs(); el = el->rhs()) - ; - el->setRhs(el2->lhs()); - //el1->lhs()->unparsestdout(); - return(el1); -} - -void IEXLoopAnalyse(SgStatement *func) -{ SgStatement *st; - int i; - nIEX = 0; - IEX_var = DoVar; - for(i=0; icontrolParent(); st!=func; st=st->controlParent()) { - if(st->variant() == FOR_NODE) - IEXLoopBegin(st); - else - continue; - } -} - -void IEXLoopBegin(SgStatement *st) -{ - DoVar[nIEX] = st->symbol(); - nIEX++; -} - -void INDLoopBegin() -{//generating Lib-DVM calls for beginning independent loop - SgSymbol *spat; - SgStatement *st; - int iaxis; - int nr;//number of aligning rules i.e. length of align-loop-index-list - - st = cur_st; //store cur_st(pointer to current statement) - if(!IND_target) - IND_target = IND_target_R; - if(! IND_target) { - err("No target for independent loop", 254, indep_st); - return; - } - spat = IND_target->symbol(); // target array symbol - //printf("INN_target"); - //IND_target->unparsestdout(); - /* for HPF error if IND_target is NULL - if(!HEADER(spat)) { - Error("'%s' isn't distributed array", spat->identifier(), 72,stmt); - return(0); - } - */ -//creating reduction group - if(redl) { - irg = iarg-1; - redgref = DVM000(irg); - cur_st = ins_st1; - doAssignTo_After(redgref, CreateReductionGroup()); - if(debug_regim){ - idebrg = iarg-2; - doAssignTo_After(DVM000(idebrg), D_CreateDebRedGroup()); - } - ReductionListIND1(); - //ReductionListIND_Err(); - } - - cur_st = ins_st2; -// creating AxisArray, CoeffArray and ConstArray - iaxis = ndvm; - nr = doAlignIterationIND(); - -// generating assign statement: -// dvm000(i) = -// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[], -// LoopVarAdrArray[], InpInitIndexArray[], InpLastIndexArray[], -// InpStepArray[], -// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[]) - - doCallAfter( BeginParLoop (iplp, HeaderRef(spat), nIND, iaxis, nr, iarg+3*nIND, iarg)); - - if(redgref) - ReductionListIND2(redgref); - - if(IND_refs) - RemoteVariableListIND(); - - cur_st = st; //restore cur_st -} - -void INDReductionDebug() -{//generating Lib-DVM calls for debugging independent loop (creating reduction group) - SgStatement *st; - - st = cur_st; //store cur_st(pointer to current statement) - -//creating reduction group - if(redl) { - irg = iarg-1; - redgref = DVM000(irg); - cur_st = ins_st1; - doAssignTo_After(redgref, CreateReductionGroup()); - if(debug_regim){ - idebrg = iarg-2; - doAssignTo_After( DVM000(idebrg), D_CreateDebRedGroup()); - } - ReductionListIND1(); - ReductionListIND2(redgref); - //ReductionListIND_Err(); - } - cur_st = st; //restore cur_st -} - -int doAlignIterationIND() -// creating axis_array, coeff_array and const_array -// returns counter of elements in align_iteration_list - -{ int i,nt,num, use[MAX_LOOP_LEVEL]; - SgExpression * el,*e,*ei,*elbb; - SgSymbol *ar; - SgExpression *axis[MAX_LOOP_LEVEL], - *coef[MAX_LOOP_LEVEL], - *cons[MAX_LOOP_LEVEL]; - SgValueExp c1(1),c0(0),cM1(-1); - - for (i=0; isymbol(); // array - - //looking through the align_iteration_list - nt = 0; //counter of elements in align_iteration_list - for(el=IND_target->lhs(); el; el=el->rhs()) { - e = el->lhs(); //subscript expression - if(e->variant()==DDOT) { // ":" - /*if(e->variant()==KEYWORD_VAL) { */ // "*" - axis[nt] = & cM1.copy(); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else { // expression - num = AxisNumOfDummyInExpr(e, IND_var, nIND, &ei, use, indep_st); - if (num<=0) { - axis[nt] = & c0.copy(); - coef[nt] = & c0.copy(); - if((elbb = LowerBound(ar,nt)) != NULL) - cons[nt] = & (e->copy() - (elbb->copy())); - // correcting const with lower bound of array - else //error situation - cons[nt] = & (e->copy()); - } - else { - axis[nt] = new SgValueExp(num); - CoeffConst(e, ei,&coef[nt], &cons[nt]); - TestReverse(coef[nt],indep_st); - if(!coef[nt]){ - err("Wrong iteration-align-subscript in PARALLEL", 160,indep_st); - coef[nt] = & c0.copy(); - cons[nt] = & c0.copy(); - } - else - // correcting const with lower bound of array - if((elbb = LowerBound(ar,nt)) != NULL) - cons[nt] = &(*cons[nt] - (elbb->copy())); - } - } - - nt++; - } - - // setting on arrays - for(i=nt-1; i>=0; i--) - doAssignStmtAfter(axis[i]); - for(i=nt-1; i>=0; i--) - doAssignStmtAfter(ReplaceFuncCall(coef[i])); - for(i=nt-1; i>=0; i--) - doAssignStmtAfter(Calculate(cons[i])); - return(nt); -} - -void ReductionListIND1() -{ - SgExpression *ev, *evc, *loc_var,*len, *loclen; - int irv, num_red, ntype,sign, ilen,locindtype; - SgSymbol *var; - SgValueExp c0(0),c1(1); - reduction_list *er; - - //looking through the reduction list - for(er = redl; er; er=er->next) { - loc_var = ConstRef(0); - loclen = &c0; - locindtype = 0; - len =&c1; - ev = er->red_var; - evc=&(ev->copy()); - num_red = er->red_op; - if( !num_red) - err("Wrong reduction operation name", 70, indep_st); - var = ev->symbol(); - if(isSgVarRefExp(ev)) - ; - else if( isSgArrayRefExp(ev)) { - if(!ev->lhs()){ //whole array - if(Rank(var)>1) - Error("Wrong reduction variable '%s'", var->identifier(), 151, indep_st); - len = ArrayDimSize(var,1); // size of vector - if(!len || len->variant()==STAR_RANGE){ - Error("Wrong reduction variable '%s'", var->identifier(), 151, indep_st); - len = &c1; - } - evc->setLhs(new SgExprListExp(*Exprn(LowerBound(var,0)))); - } - } - else - err("Wrong reduction variable",151,indep_st); - ntype = VarType(var); //RedVarType(var) - if(!ntype) - Error("Wrong type of reduction variable '%s'", var->identifier(), 152,indep_st); - sign = 1; - ilen = ndvm; // index for RedArrayLength - doAssignStmtAfter(len); - doAssignStmtAfter(loclen); - irv = ndvm; // index for RedVarRef - if(! only_debug) - doAssignStmtAfter(ReductionVar(num_red,evc,ntype,ilen, loc_var, ilen+1,sign)); - er->ind = irv; - if(debug_regim) { - doCallAfter(D_InsRedVar(DVM000(idebrg),num_red,evc,ntype,ilen, loc_var, ilen+1,locindtype)); - } - } - return; - } - -void ReductionListIND2(SgExpression *gref) -{ reduction_list *er; -//looking through the reduction list - if(only_debug) return; - for(er = redl; er; er=er->next) - doCallAfter(InsertRedVar(gref,er->ind,(only_debug ? 0 : iplp))); -} - -void ReductionListIND_Err() -{ reduction_list *er; -//looking through the reduction list - for(er = redl; er; er=er->next) - Error("Reduction statement inside the range of INDEPENDENT loop, '%s' is reduction variable", er->red_var->symbol()->identifier(), 255, indep_st); -} - -void OffDoVarsOfNest(SgStatement *end_stmt) -{ - SgStatement *parent; - SgForStmt *do_st; - parent = end_stmt->controlParent(); - OffDoVar(parent->symbol()); - if(!end_stmt->label()) // ENDDO is end of DO constuct - return; - parent = parent->controlParent(); - while((do_st=isSgForStmt(parent)) && do_st->endOfLoop() - && ( LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(end_stmt->label()->thelabel))) { - OffDoVar(parent->symbol()); - parent = parent->controlParent(); - } - return; -} -/* -void RemoteVariableListIND() -{ IND_ref_list *el; - int ibg,ishg,ikind,ibuf,ishw,iaxis,ideb,iq; - SgSymbol *ar, *b; - SgExpression *ind_deb[7],*head, *shgref, *bgref; - int j, n, buf_size, shw_size, rank, static_sign; - SgValueExp c0(0),cm1(-1); - SgStatement *if_st,*end_st,*cp, *cp1,*endif_st,*else_st; - - if(!IND_refs) return; - - cp = cp1 = cur_st->controlParent(); - if( !one_inquiry){ - ishg = ndvm; shgref = DVM000(ishg); - ibg = ndvm+1; bgref = DVM000(ibg); - doAssignStmtAfter(ConstRef(0)); // dvm000(ishg) = 0 - doAssignStmtAfter(ConstRef(0)); // dvm000(ibg) = 0 - static_sign = 0; - } - else { - iq = nhpf++; - InitInquiryVar(iq); - if_st = doIfThenConstrForIND(HPF000(iq), 0, 1, 0, cur_st, cp); - cur_st = if_st; - doAssignTo_After(HPF000(iq), ConstRef(1)); // hpf000(iq) = 1 :inquiry has done - ishg = nhpf++; shgref = HPF000(ishg); - ibg = nhpf++; bgref = HPF000(ibg); - doAssignTo_After(shgref, ConstRef(0)); // hpf000(ishg) = 0 - doAssignTo_After( bgref, ConstRef(0)); // hpf000(ibg) = 0 - static_sign = 1; - cp = if_st; - } - ikind = ndvm++; - //looking through the IND_reference list - for(el=IND_refs; el; el=el->next){ - ar = el->rmref->symbol(); - rank = Rank(ar); - // looking through the index list of remote variable - //for(es= el->rmref->lhs(),n=0; es; es= es->rhs(),n++) - // - for(n = 0; n<7 && el->axis[n]; n++) - if( el->axis[n]->valueInteger() == 0) - ind_deb[n] = &(el->cons[n]->copy()); - else - ind_deb[n] = &cm1.copy(); - //allocating buffer header (for remote data) and arrays of shadow widths - buf_size = (el->nc) ? 2*(el->nc)+2 : 4; //memory size for buffer - if( !one_inquiry){ - ibuf = ndvm; - ndvm+= buf_size; - b = dvmbuf; //or NULL - } else { - ibuf = nhpf; - nhpf+= buf_size; - b = hpfbuf; - } - ishw = ndvm; - shw_size = 2*rank; - //size = (buf_size > shw_size) ? buf_size : shw_size; - ndvm+= shw_size; - //generating inquiry for kind of data access - iaxis = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmtAfter(el->axis[j]); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(el->coef[j])); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(Calculate(el->cons[j])); - - head = HeaderRef(el->rmref->symbol()); - doAssignTo_After(DVM000(ikind), RemoteAccessKind(head, header_rf(b,ibuf,1),static_sign,iplp,iaxis,iaxis+n,iaxis+2*n,ishw,ishw+rank)); - //SET_DVM(ishw); - SET_DVM(iaxis); - //generating IF(dvm000(ikind).EQ.3) THEN ...ELSE...ENDIF - if_st = doIfThenConstrForIND(DVM000(ikind), 3, 1, 1, cur_st, cp); - end_st = endif_st = if_st->lexNext()->lexNext(); //END IF statement - else_st = if_st->lexNext(); // ELSE statement - - //IF(dvm000(ibg).EQ.0) THEN ...ENDIF - // hpf000(ibg) - if_st = doIfThenConstrForIND(bgref, 0, 1, 0, if_st, if_st); - cur_st = if_st; - doAssignTo_After(bgref,CreateBG(static_sign,1));//creating group of remote data buffer - where = else_st; - doAssignStmt(InsertRemBuf(bgref, header_rf(b,ibuf,1)));//inserting buffer in group - if(dvm_debug) { - ideb = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmt(ReplaceFuncCall(ind_deb[j])); - InsertNewStatementBefore(D_RmBuf(head, GetAddresDVM( header_rf(b,ibuf,1)),n,ideb),else_st); - } - BufferHeaderCopy(b,ibuf, n, el); - - cur_st = else_st; // generating ELSE body - //generating IF(dvm000(ikind).EQ.2) THEN ...ELSE...ENDIF - if_st = doIfThenConstrForIND(DVM000(ikind), 2, 1, 0, else_st, else_st); - end_st = if_st->lexNext(); //END IF statement - //IF(dvm000(ishg).EQ.0) THEN ...ENDIF - // hpf000(ishg) - if_st = doIfThenConstrForIND(shgref, 0, 1, 0, if_st, if_st); - cur_st = if_st; - CreateBoundGroup(shgref); //creating group of shadow edges - where = end_st; - doAssignStmt(InsertArrayBound(shgref, head, ishw, ishw+rank, 1)); //corner = 1 !!! - //inserting shadow in group - //ishsign = ndvm; - //maxsh = doShadowSignArray(el); see DepList(),doDepLengthArrays() - //doAssignStmt(InsertArrayBoundDep(shgref, head, ishw, ishw+rank, maxsh, ishsign)); - cur_st = end_st; - ArrayHeaderCopy(n,el); - - SET_DVM(ishw); - cur_st = endif_st; - } - if(one_inquiry) - cur_st = cur_st->lexNext(); - //IF(dvm000(ishg).NE.0) THEN {executing SHADOW group} ENDIF - // hpf000(ishg) - if_st = doIfThenConstrForIND(shgref, 0, 0, 0, cur_st, cp1); - end_st = if_st->lexNext(); //END IF statement - cur_st = if_st; - doAssignStmtAfter(StartBound(shgref)); // starting exchange of shadow edges - FREE_DVM(1); - doAssignStmtAfter(WaitBound (shgref));// waiting completion of shadow edges exchange - FREE_DVM(1); - //IF(dvm000(ibg).NE.0) THEN {executing REMOTE group} ENDIF - // hpf000(ibg) - if_st = doIfThenConstrForIND(bgref, 0, 0, 0, end_st, cp1); - cur_st = if_st; - doAssignStmtAfter(LoadBG(bgref)); // starting load of buffer group - FREE_DVM(1); - doAssignStmtAfter(WaitBG(bgref));// waiting completion of buffer group load - FREE_DVM(1); - - if( one_inquiry) - {SET_HPF(nhpf);} - else - {SET_HPF(1);} - return; -} -*/ - -void RemoteVariableListIND() -{ IND_ref_list *el; - int ibg,ishg,ikind,ibuf,ishw,iaxis,ideb,iq; - SgSymbol *ar, *b; - SgExpression *ind_deb[7],*head, *shgref, *bgref; - int j, n, buf_size, shw_size, rank, static_sign; - SgValueExp c0(0),cm1(-1); - SgStatement *if_st,*end_st,*cp, *cp1,*endif_st,*else_st; - - if(!IND_refs) return; - - cp = cp1 = cur_st->controlParent(); - if( !one_inquiry){ - ishg = ndvm; shgref = DVM000(ishg); - ibg = ndvm+1; bgref = DVM000(ibg); - doAssignStmtAfter(ConstRef(0)); // dvm000(ishg) = 0 - doAssignStmtAfter(ConstRef(0)); // dvm000(ibg) = 0 - static_sign = 0; - } - else { - iq = nhpf++; - InitInquiryVar(iq); - if_st = doIfThenConstrForIND(HPF000(iq), 0, 1, 0, cur_st, cp); - cur_st = if_st; - doAssignTo_After(HPF000(iq), ConstRef(1)); // hpf000(iq) = 1 :inquiry has done - ishg = nhpf++; shgref = HPF000(ishg); - ibg = nhpf++; bgref = HPF000(ibg); - doAssignTo_After(shgref, ConstRef(0)); // hpf000(ishg) = 0 - doAssignTo_After( bgref, ConstRef(0)); // hpf000(ibg) = 0 - static_sign = 1; - cp = if_st; - } - ikind = ndvm++; - //looking through the IND_reference list - for(el=IND_refs; el; el=el->next){ - ar = el->rmref->symbol(); - rank = Rank(ar); - // looking through the index list of remote variable - //for(es= el->rmref->lhs(),n=0; es; es= es->rhs(),n++) - - for(n = 0; n<7 && el->axis[n]; n++) - if( el->axis[n]->valueInteger() == 0) - ind_deb[n] = &(el->cons[n]->copy()); - else - ind_deb[n] = &cm1.copy(); - //allocating buffer header (for remote data) and arrays of shadow widths - buf_size = (el->nc) ? 2*(el->nc)+2 : 4; //memory size for buffer - if( !one_inquiry){ - ibuf = ndvm; - ndvm+= buf_size; - b = dvmbuf; //or NULL - } else { - ibuf = nhpf; - nhpf+= buf_size; - b = hpfbuf; - } - ishw = ndvm; - shw_size = 2*rank; - //size = (buf_size > shw_size) ? buf_size : shw_size; - ndvm+= shw_size; - //generating inquiry for kind of data access - iaxis = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmtAfter(el->axis[j]); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(ReplaceFuncCall(el->coef[j])); - for(j=n-1; j>=0; j--) - doAssignStmtAfter(Calculate(el->cons[j])); - - head = HeaderRef(el->rmref->symbol()); - doAssignTo_After(DVM000(ikind), RemoteAccessKind(head, header_rf(b,ibuf,1),static_sign,iplp,iaxis,iaxis+n,iaxis+2*n,ishw,ishw+rank)); - //SET_DVM(ishw); - SET_DVM(iaxis); - //generating IF(dvm000(ikind).EQ.4) THEN ...ELSE...ENDIF - if_st = doIfThenConstrForIND(DVM000(ikind), 4, 1, 1, cur_st, cp); - end_st = endif_st = if_st->lexNext()->lexNext(); //END IF statement - else_st = if_st->lexNext(); // ELSE statement - - //IF(dvm000(ibg).EQ.0) THEN ...ENDIF - // hpf000(ibg) - if_st = doIfThenConstrForIND(bgref, 0, 1, 0, if_st, if_st); - cur_st = if_st; - doAssignTo_After(bgref,CreateBG(static_sign,1));//creating group of remote data buffer - where = else_st; - doAssignStmt(InsertRemBuf(bgref, header_rf(b,ibuf,1)));//inserting buffer in group - if(dvm_debug) { - ideb = ndvm; - for(j=n-1; j>=0; j--) - doAssignStmt(ReplaceFuncCall(ind_deb[j])); - InsertNewStatementBefore(D_RmBuf(head, GetAddresDVM( header_rf(b,ibuf,1)),n,ideb),else_st); - } - BufferHeaderCopy(b,ibuf, n, el); - - cur_st = else_st; // generating ELSE body - ArrayHeaderCopy(n,el); - //generating IF(dvm000(ikind).NE.1) THEN ...ELSE...ENDIF - if_st = doIfThenConstrForIND(DVM000(ikind), 1, 0, 0, else_st, else_st); - end_st = if_st->lexNext(); //END IF statement - //generating IF(dvm000(ikind).EQ.2) THEN {corner = 0} ELSE {corner = 1} ENDIF - cur_st = doIfThenConstrForIND(DVM000(ikind), 2, 1, 1, if_st, if_st); - doCallAfter(InsertArrayBound(shgref, head, ishw, ishw+rank, 0)); - //inserting shadow in group with FullShadowSign=0 - //icorn = ndvm++; - //doAssignTo_After(DVM000(icorn),new SgValueExp(0)); //corner = 0 - cur_st = cur_st->lexNext(); // ELSE - doCallAfter(InsertArrayBound(shgref, head, ishw, ishw+rank, 1)); - //inserting shadow in groupwith FullShadowSign=1 - //doAssignTo_After(DVM000(icorn),new SgValueExp(1)); //corner = 1 - //IF(dvm000(ishg).EQ.0) THEN ...ENDIF - // hpf000(ishg) - if_st = doIfThenConstrForIND(shgref, 0, 1, 0, if_st, if_st); - cur_st = if_st; - CreateBoundGroup(shgref); //creating group of shadow edges - where = end_st; - //doAssignStmt(InsertArrayBound(shgref, head, ishw, ishw+rank, icorn)); - //inserting shadow in group - //ishsign = ndvm; - //maxsh = doShadowSignArray(el); see DepList(),doDepLengthArrays() - //doAssignStmt(InsertArrayBoundDep(shgref, head, ishw, ishw+rank, maxsh, ishsign)); - //cur_st = end_st; - // ArrayHeaderCopy(n,el); - - SET_DVM(ishw); - cur_st = endif_st; - } - if(one_inquiry) - cur_st = cur_st->lexNext(); - //IF(dvm000(ishg).NE.0) THEN {executing SHADOW group} ENDIF - // hpf000(ishg) - if_st = doIfThenConstrForIND(shgref, 0, 0, 0, cur_st, cp1); - end_st = if_st->lexNext(); //END IF statement - cur_st = if_st; - doCallAfter(StartBound(shgref)); // starting exchange of shadow edges - doCallAfter(WaitBound (shgref));// waiting completion of shadow edges exchange - //IF(dvm000(ibg).NE.0) THEN {executing REMOTE group} ENDIF - // hpf000(ibg) - if_st = doIfThenConstrForIND(bgref, 0, 0, 0, end_st, cp1); - cur_st = if_st; - doAssignStmtAfter(LoadBG(bgref)); // starting load of buffer group - FREE_DVM(1); - doAssignStmtAfter(WaitBG(bgref));// waiting completion of buffer group load - FREE_DVM(1); - - if( one_inquiry) - {SET_HPF(nhpf);} - else - {SET_HPF(1);} - return; -} - - -void InitInquiryVar(int iq) -{SgStatement *st; - st = cur_st;//save cur_st - cur_st = first_hpf_exec; - doAssignTo_After(HPF000(iq),ConstRef(0)); - cur_st = st; //resave cur_st -} - -/**************************************************************\ -* Creating header copy * -* (calculating coefficients of address expression) * -\**************************************************************/ -void BufferHeaderCopy(SgSymbol *b, int ibuf, int n, IND_ref_list *el) -// n - number of subscripts in array reference -// hpf000(ihpf) = getai(dvm000(ibuf))- header address -// hpf000(ihpf+i) = dvm000(ibuf+i) i=1,...,rank-1 -// hpf000(ihpf+rank) = 1 -// hpf000(ihpf+rank+1) = f(dvm000(ibuf+1 : ibuf+2*rank+2)) - calculated - -// -// Copy BufferHeader(rank=3) -// _________ _________ -// | adress | | | 1 -// |_________| |_________| -// | * | <--- | * | 2 -// |_________| |_________| -// | * | <--- | * | 3 -// |_________| |_________| -// | 1 | | | 4 -// |_________| |_________| -// |calculate| | | 5 -// |_________| |_________| -// | . . . | -// |_________| -// -{int k,ind,rank; - rank = el->nc; // rank of BufferArray - ind = el->ind; - doAssignTo(header_rf(hpfbuf,ind,1),GetAddresDVM(header_rf(b,ibuf,1))); - for(k=2; krmref->symbol(); - n = rme->nc; - //ar = NULL; - if(!(array->attributes() & DIMENSION_BIT)){// for continuing translation - return (new SgValueExp(0)); - } - artype = isSgArrayType(array->type()); - if(!artype) // error - return(new SgValueExp(0)); // for continuing translation of procedure - - ind = n+1; - ehead = header_rf(ar,ihead,ind); - - i=0; j=0; - for(k = 0; kaxis[k]->valueInteger() != 0) - {j = 1; break;} - else - i++; - if(j == 0) //buffer is of one element - return(ehead); - if(rme->axis[k]->valueInteger() == -1) // : - if(!(e=LowerBound(array,i))) - return(new SgValueExp(0)); // for continuing translation of procedure - else - ehead = &(*ehead - e->copy()); - else //a*i+b - ehead = &(*ehead - (*header_rf(ar,ihead,ind+n+1))); - for(k = k+1, i++; kaxis[k]->valueInteger() == -1){ - ind--; - e = artype->sizeInDim(i); - if(e && e->variant() == DDOT && e->lhs()) - ehead = & (*ehead - (*header_rf(ar,ihead,ind) * - (LowerBound(array,i)->copy()))); - else - ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1 - } - else if(rme->axis[k]->valueInteger() > 0){ - ind--; - ehead = & (*ehead - (*header_rf(ar,ihead,ind) * (*header_rf(ar,ihead,ind+n+1)))); - } - return(ehead); -} - -void ArrayHeaderCopy(int n, IND_ref_list *el) -{ int k, i, ind, rank, num; - SgSymbol *ar; - SgExpression *e; - ind = el->ind; - rank = el->nc; - ar = el->rmref->symbol(); //array symbol - doAssignTo_After(HPF000(ind+rank+1),HeaderRefInd(ar,n+2));//HeaderCopy(rank+1)=Header(n+2) - num = el->axis[0]->valueInteger(); - i = rank; - if(num == - 1) { // 1-st index is ':' - doAssignTo_After(HPF000(ind+rank), new SgValueExp(1));//HeaderCopy(rank) = 1 - i--; - } else { - if(num > 0) { // 1-st index is a*IND+b - doAssignTo_After(HPF000(ind+rank), el->coef[0]); //HeaderCopy(rank) = a - i--; - } - if(el->cons[0]->lhs() && !INTEGER_VALUE(el->cons[0]->lhs(),0)) // b != 0 - doAssignTo_After(HPF000(ind+rank+1), &(*HPF000(ind+rank+1)+(*el->cons[0]->lhs()))); - //HeaderCopy(rank+1) = HeaderCopy(rank+1) + b - } - for(k=1; kaxis[k]->valueInteger(); - if(num == - 1) { // k-th index is ':' - doAssignTo_After(HPF000(ind+i),HeaderRefInd(ar,n-k+1));//HeaderCopy(i) = Header(k) - i--; - } else { - if(num > 0) { // k-th index is a*IND+b - e = INTEGER_VALUE(el->coef[k],1) ? HeaderRefInd(ar,n-k+1) : &(*HeaderRefInd(ar,n-k+1)*(*el->coef[k])); - doAssignTo_After(HPF000(ind+i), e); //HeaderCopy(i) = a * Header(k) - i--; - } - if(el->cons[k]->lhs() && !INTEGER_VALUE(el->cons[k]->lhs(),0)) // b!= 0 - doAssignTo_After(HPF000(ind+rank+1), &(*HPF000(ind+rank+1)+(*HeaderRefInd(ar,n-k+1)*(*el->cons[k]->lhs())))); // HeaderCopy(rank+1) = HeaderCopy(rank+1) + b * Header(k) - } - } - doAssignTo_After(HPF000(ind), GetAddresDVM(HeaderRefInd(ar,1))); - return; -} -/**************************************************************\ -* Looking for reduction operation * -\**************************************************************/ - -int NodeBefore=ASSIGN_STAT; -int CompareIfReduction(SgExpression *e1, SgExpression *e2) -{ - if(!e1||!e2) return(0); - if(e1->variant() != e2->variant()) - return(0); - if(e1->variant() != VAR_REF && e1->variant() != ARRAY_REF) - return(0); - if(e1->symbol() != e2->symbol()) - return(0); - if(e1->variant() == ARRAY_REF && !ExpCompare(e1->lhs(),e2->lhs())) - return(0); - return (1); -} - -/* Function returns number of reduction operation */ -/* expr_ind is used in order to correspond position of reduction variable*/ -/* if SgExpression e - if-condition 'rv ol er' expr_ind=0 */ -/* if SgExpression e - if-condition 'er ol rv' expr_ind=1 */ -/* else expr_ind=0 */ -int ReductionFuncNumber(SgExpression *e,int expr_ind) -{ - switch(e->variant()) - { - case ADD_OP: return (1); - case MULT_OP: return (2); - case AND_OP: return (5); - case OR_OP: return (6); - case NEQV_OP: return (7); - case EQV_OP: return (8); - case XOR_OP: return (0); - case FUNC_CALL: { - char *red_name; - red_name = ((e->symbol())->identifier()); - if(!strcmp(red_name, "max")) - return(3); - if(!strcmp(red_name, "min")) - return(4); - };break; - case LT_OP: - case LTEQL_OP: if (expr_ind==0) return (3); /*max*/ - else return (4);/*min*/ - case GT_OP: - case GTEQL_OP: if (expr_ind==0) return (4); - else return (3); - default: return (0); - } -return 0; -} - -/* Function checks if pos_red is in newl-list */ -int IsInNewList(SgExpression *pos_red, SgExpression *newl) -{ -SgExpression *ExprList; -if (!newl) return 0; -if (!pos_red) return 0; -if (pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) return 0; -for (ExprList=newl;ExprList&&(ExprList->variant()==EXPR_LIST);ExprList=ExprList->rhs()) - { - if ((ExprList->lhs())->variant()==VAR_REF || (ExprList->lhs())->variant()==ARRAY_REF ) - if (ExprList->lhs()->symbol()==pos_red->symbol()) - return 1; - } -return 0; -} -/* Function checks if pos_red is already in reduction-list */ -int IsInReductionList(SgExpression *pos_red) -{ -reduction_list *rlist=redl; -if (!pos_red) return 0; -if(pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) return 0; -for (;rlist;rlist=rlist->next) - { - if (rlist->red_var) - if (rlist->red_var->symbol()==pos_red->symbol()) - return 1; - } -return 0; -} - -/* Function checks if pos_red is reduction-variable * - * pos_red should be variable, shouldn`t be in newl-list, * - * pos_red shouldn`t be loop-variable and distribute-array*/ -int IsReductionVariable(SgExpression *pos_red, SgExpression *newl) -{ -if (!pos_red) return 0; - -if (pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) - { - return 0; - } -if (IsInNewList(pos_red,newl)) - { - return 0; - } -if (IS_DISTR_ARRAY(pos_red->symbol())) - { - return 0; - } -if (isDoVar(pos_red->symbol())) - { - return 0; - } -return 1; -} - -int IsError(SgExpression *pos_red, SgExpression *newl, int variant) -{ -if (!pos_red) return 0; -if (IsInNewList(pos_red,newl)) return 0; -if (variant&&IsReductionVariable(pos_red,newl)) return 0; -if (IS_DISTR_ARRAY(pos_red->symbol())) return 0; -return 1; -} - -int FindInExpr(SgExpression *red, SgExpression *expr) -{ -if(!expr) return 0; -if (!red) return 0; -if (red->variant()!=VAR_REF && red->variant()!=ARRAY_REF) return 0; - -if(red->variant()==VAR_REF && red->variant() == expr->variant()) - { - if (red->symbol()== expr->symbol()) - return 1; - else return 0; - } - -if(red->variant()==ARRAY_REF && red->variant() == expr->variant()) - { - if (red->symbol() == expr->symbol()) - return(ExpCompare(red->lhs(),expr->lhs())); - } -return (FindInExpr(red,expr->lhs())+FindInExpr(red,expr->rhs())); -} - - -int IsReductionOp(SgStatement *st, SgExpression *newl) -{ -reduction_list *rlist; -int variant=0; -SgExpression *ExprList1,*ExprList2,*Reduction; -ExprList1=ExprList2=Reduction=NULL; -if(st || newl) - { - if (st->variant() == ASSIGN_STAT) - { - ExprList1=st->expr(0); - ExprList2=st->expr(1); - //ExprList =st->expr(1); - if (ExprList2&&(ExprList2->variant() != FUNC_CALL)) - { - if (ExprList2->lhs()) - { - /* rv=rv op er */ - if (CompareIfReduction(ExprList1,ExprList2->lhs())) - { - // ExprList =ExprList2->rhs(); - Reduction=ExprList2->lhs(); - variant=11; - } - else - { - if (ExprList2->rhs()) - { - /* rv=er op rv */ - if (CompareIfReduction(ExprList1,ExprList2->rhs())) - { - Reduction=ExprList2->rhs(); - // ExprList =ExprList2->lhs(); - variant=12; - } - } - } - } - } - else - { - /* rv=f(rv,er) or rv=f(er,rv) */ - char *red_name; - red_name = ((ExprList2->symbol())->identifier()); - if(!strcmp(red_name, "max")||!strcmp(red_name, "min")) - { - if (ExprList2->lhs()&&((ExprList2->lhs())->variant()==EXPR_LIST)) - { - /* rv=f(rv,er) */ - if (CompareIfReduction(ExprList1,ExprList2->lhs()->lhs())) - { - variant=21; - Reduction=(ExprList2->lhs())->lhs(); - // ExprList=(ExprList2->lhs())->rhs(); - } - else - { - /* rv=f(er,rv) */ - if (ExprList2->lhs()->rhs()&&CompareIfReduction(ExprList1,ExprList2->lhs()->rhs()->lhs())) - { - variant=22; - Reduction=ExprList2->lhs()->rhs()->lhs(); - // ExprList=ExprList2->lhs()->lhs(); - } - } - } - } - if (!variant) - { - if (IsError(ExprList1,newl,variant)) - err("Illegal statement in the range of parallel loop",94,st); - return (0); - } - } - } - if (IsError(ExprList1,newl,variant)) - { - /*We need check variant 'if ( rv ol er ) rv = er' or 'if ( er ol rv ) rv = er'*/ - if (NodeBefore!=LOGIF_NODE) - err("Illegal statement in the range of parallel loop",94,st); - return (0); - } - NodeBefore=ASSIGN_STAT; - if (Reduction&&variant) - { - if (IsReductionVariable(ExprList1,newl)) - { - if (IsInReductionList(Reduction)||!ReductionFuncNumber(ExprList2,0)) - { - err("Illegal statement in the range of parallel loop",94,st); - return (0); - } - rlist= new reduction_list; - if (rlist) - { - if (!redl) rlist->next=NULL; - else rlist->next=redl; - rlist->red_op=ReductionFuncNumber(ExprList2,0); - rlist->red_var=&(Reduction->copy()); - if(rlist->red_var->variant() == ARRAY_REF) - rlist->red_var->setLhs(NULL); - redl=rlist; - } - else return 0; - return 1; - } - } - return 0; - } - else - return 0; -} - -int IsLIFReductionOp(SgStatement *st, SgExpression *newl) -{ -SgStatement *assign; -PTR_BFND abif; -int variant=0; -if(st || newl) - { - reduction_list *rlist; - /*'if ( rv ol er ) rv = er' or 'if ( er ol rv ) rv = er'*/ - NodeBefore=LOGIF_NODE; - if (st&&(st->variant()==LOGIF_NODE)) - { - /* assign = 'rv = er'*/ - abif= BIF_BLOB1(st->thebif) ? BLOB_VALUE(BIF_BLOB1(st->thebif)):(PTR_BFND)NULL; - assign=new SgStatement(abif); - if (assign&&(assign->variant()==ASSIGN_STAT)) - { - if (assign->expr(0)&&(assign->expr(0)->variant()==VAR_REF)) - if (st->expr(0)&&((st->expr(0)->lhs()->variant()==VAR_REF)||(st->expr(0)->rhs()->variant()==VAR_REF))) - { - if (st->expr(0)->lhs()->variant()==VAR_REF) - { - if (st->expr(0)->lhs()->symbol()==assign->expr(0)->symbol()) - if (!FindInExpr(st->expr(0)->lhs(),st->expr(0)->rhs())&&!FindInExpr(st->expr(0)->lhs(),assign->expr(1))) - { - /*if ( rv ol er ) rv = er*/ - variant= 31; - /*fprintf(stderr,"variant 31\n");*/ - } - } - else if (st->expr(0)->rhs()->symbol()==assign->expr(0)->symbol()) - if (!FindInExpr(st->expr(0)->rhs(),st->expr(0)->lhs())&&!FindInExpr(st->expr(0)->rhs(),assign->expr(1))) - { - /*if ( er ol rv ) rv = er*/ - variant= 32; - /*fprintf(stderr,"variant 32\n");*/ - } - } - if (IsError(assign->expr(0),newl,variant)) - { - err("Illegal statement in the range of parallel loop",94,st); - return (0); - } - if (assign->expr(0)&&variant) - { - if (IsReductionVariable(assign->expr(0),newl)) - { - if (IsInReductionList(assign->expr(0))||!ReductionFuncNumber(st->expr(0),0)) - { - err("Illegal statement in the range of parallel loop",94,st); - return (0); - } - rlist= new reduction_list; - if (rlist) - { - if (!redl) rlist->next=NULL; - else rlist->next=redl; - if (variant==31) rlist->red_op=ReductionFuncNumber(st->expr(0),0); - else rlist->red_op=ReductionFuncNumber(st->expr(0),1); - rlist->red_var=&(assign->expr(0)->copy()); - if(rlist->red_var->variant()==ARRAY_REF) - rlist->red_var->setLhs(NULL); - redl=rlist; - } - else return 0; - return 1; - } - } - return 0; - } - else return 0; - } - } - else - return 0; -return 0; -} - - -/**************************************************************\ -* Miscellaneous functions * -\**************************************************************/ -int isNewVar(SgSymbol *s) -{SgExpression *enl, *el; - enl = indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0);//NEW variable list - for(el=enl; el; el=el->rhs()) { - if(s == el->lhs()->symbol()) // is NEW variable - return(1); - } - return(0); -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/io.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/io.cpp deleted file mode 100644 index bef53c4..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/io.cpp +++ /dev/null @@ -1,2905 +0,0 @@ -/**************************************************************\ -* Fortran DVM * -* * -* Input/Output Statements Processing * -\**************************************************************/ - -#include "dvm.h" -#define NO_ERROR_MSG 0 - -static const char *filePositionArgsStrings[] = { "unit", "fmt", "rec", "err", "iostat", "end", "nml", "eor", "size", "advance", "iomsg" }; - -// enum for new open/close -enum {UNIT_IO, ACCESS_IO, ACTION_IO, ASYNC_IO, BLANK_IO, DECIMAL_IO, DELIM_IO, ENCODING_IO, ERR_IO, FILE_IO, - FORM_IO, IOSTAT_IO, IOMSG_IO, NEWUNIT_IO, PAD_IO, POSITION_IO, RECL_IO, ROUND_IO, SIGN_IO, STATUS_IO, DVM_MODE_IO, NUMB__CL }; -static const char *openCloseArgStrings[] = { "unit", "access", "action", "async", "blank", "decimal", "delim", - "encoding", "err", "file", "form", "iostat", "iomsg", "newunit", "pad", "position", "recl", "round", "sign", - "status", "io_mode" }; - -enum { UNIT_RW, FMT_RW, NML_RW, ADVANCE_RW, ASYNC_RW, BLANK_RW, DECIMAL_RW, DELIM_RW, END_RW, EOR_RW, ERR_RW, ID_RW, - IOMSG_RW, IOSTAT_RW, PAD_RW, POS_RW, REC_RW, ROUND_RW, SIGN_RW, SIZE_RW, NUMB__RW }; -static const char *readWriteArgStrings[] = { "unit", "fmt", "nml", "advance", "async", "blank", "decimal", "delim", "end", "eor", "err", "id", "iomsg", "iostat", "pad", "pos", "rec", "round", "sign", "size"}; - -int Check_ReadWritePrint(SgExpression *ioc[], SgStatement *stmt, int error_msg); -void Replace_ReadWritePrint( SgExpression *ioc[], SgStatement *stmt); - -int TestIOList(SgExpression *iol, SgStatement *stmt, int error_msg) -{SgExpression *el,*e; -int tst=1; -for (el=iol;el;el=el->rhs()) { - e = el->lhs(); // list item - ReplaceFuncCall(e); - if(isSgExprListExp(e)) // implicit loop in output list - e = e->lhs(); - if(isSgIOAccessExp(e)) { - tst=ImplicitLoopTest(e,stmt,error_msg) ? tst : 0; - } - else - tst=IOitemTest(e,stmt,error_msg) ? tst : 0; - } -return (tst); -} - -int ImplicitLoopTest(SgExpression *eim, SgStatement *stmt, int error_msg) -{int tst =1; - SgExpression *ell, *e; - if(isSgExprListExp(eim->lhs())) - for (ell = eim->lhs();ell;ell=ell->rhs()){ //looking through item list of implicit loop - e = ell->lhs(); - if(isSgExprListExp(e)) // implicit loop in output list - e = e->lhs(); - if(isSgIOAccessExp(e)){ - tst=ImplicitLoopTest(e,stmt,error_msg) ? tst : 0; - } - else - tst=IOitemTest(e,stmt,error_msg) ? tst : 0; - } - else - tst=IOitemTest(eim->lhs(),stmt,error_msg) ? tst : 0; - return(tst); -} - -int IOitemTest(SgExpression *e, SgStatement *stmt, int error_msg) -{int tst=1; - if(!e) return(1); - if(isSgArrayRefExp(e)){ - if( HEADER(e->symbol())) { - if(error_msg) - Error("Illegal I/O list item: %s",e->symbol()->identifier(),192,stmt); - return (0); - } else - return(1); - } - if(isSgRecordRefExp(e)) { - SgExpression *eleft = SearchDistArrayField(e); //from right to left - if(eleft) { - if(error_msg) - Error("Illegal I/O list item: %s",isSgRecordRefExp(eleft) ? eleft->rhs()->symbol()->identifier(): eleft->symbol()->identifier(),192,stmt); - return (0); - } else - return(1); - } - if(e->variant() == ARRAY_OP) //substring - return(IOitemTest(e->lhs(),stmt,error_msg)); - if(isSgVarRefExp(e) || isSgValueExp(e)) - return(1); - tst=IOitemTest(e->lhs(),stmt,error_msg) ? tst : 0; - tst=IOitemTest(e->rhs(),stmt,error_msg) ? tst : 0; - return(tst); -} - -SgStatement *Any_IO_Statement(SgStatement *stmt) -{ SgStatement *last; - ReplaceContext(stmt); - if(!IN_COMPUTE_REGION) - LINE_NUMBER_BEFORE(stmt,stmt); - SgExpression *ioEnd[3]; - if(hasEndErrControlSpecifier(stmt, ioEnd)) - ReplaceStatementWithEndErrSpecifier(stmt,ioEnd); - if(perf_analysis){ - InsertNewStatementBefore(St_Biof(),stmt); - InsertNewStatementAfter ((last = St_Eiof()),stmt,stmt->controlParent()); - cur_st = stmt; - return(last); - } - return(stmt); -} - -void IoModeDirective(SgStatement *stmt, char io_modes_str[], int error_msg) -{ - SgExprListExp *modes = isSgExprListExp(stmt->expr(0)); - int imode = 0; - if (!options.isOn(IO_RTS)) { - if(error_msg) - warn("Directive IO_MODE is ignored, -ioRTS option should be specified",623,stmt); - return; - } - for (imode = 0; imode < modes->length(); ++imode) { - SgExpression *mode = modes->elem(imode); - if (mode->variant() == PARALLEL_OP) - io_modes_str[imode] = 'p'; - else if (mode->variant() == ACC_LOCAL_OP) - io_modes_str[imode] = 'l'; - else if (mode->variant() == ACC_ASYNC_OP) - io_modes_str[imode] = 's'; - else - if(error_msg) - err("Illegal elements in IO_MODE directive", 460, stmt); - } - io_modes_str[imode] = '\0'; - if (stmt->lexNext()->variant() != OPEN_STAT) { - if(error_msg) - err("Misplaced directive: no OPEN statement after IO_MODE statement", 103, stmt); - io_modes_str[0]='\0'; - } -} - -void Open_Statement(SgStatement *stmt, char io_modes_str[], int error_msg) -{ - Any_IO_Statement(stmt); - if(options.isOn(IO_RTS) && io_modes_str[0] != '\0') - Open_RTS(stmt, io_modes_str, error_msg); - else - OpenClose(stmt,error_msg); -} - -void Open_RTS(SgStatement* stmt, char* io_modes_str, int error_msg) { - SgExpression *ioc[40]; - int io_err = control_list_open_new(stmt->expr(1), ioc); - if(!io_err) - { - if( error_msg ) - err("Illegal elements in control list", 185, stmt); - return; - } - - bool suitableForNewIO = checkArgsOpen(ioc, stmt, error_msg, io_modes_str); - if (!suitableForNewIO) return; - Dvmh_Open(ioc, io_modes_str); - io_modes_str[0]='\0'; -} - -void Close_Statement(SgStatement *stmt, int error_msg) -{ - Any_IO_Statement(stmt); - if(options.isOn(IO_RTS)) - Close_RTS(stmt,error_msg); - else - OpenClose(stmt,error_msg); -} - -void Close_RTS(SgStatement *stmt, int error_msg) -{ - SgExpression *ioc[NUMB__CL]; - int io_err = control_list_close_new(stmt->expr(1), ioc); - if(!io_err) - { - if( error_msg ) - { - if (!ioc[UNIT_IO]) - err("UNIT not specified in close statement", 456, stmt); - else - err("Illegal elements in control list", 185, stmt); - } - return; - } - - bool suitableForNewIO = checkArgsClose(ioc, stmt, error_msg); - - // generate If construct: - // if (dvmh_ftn_connected (args) then else endif - SgStatement *ifst = IfConnected(stmt,ioc[UNIT_],suitableForNewIO); - SgStatement *last = ifst->lastNodeOfStmt(); //stmt->lexNext(); - //true body - Dvmh_Close(ioc); - - //false body - NewOpenClose(stmt); - cur_st = last; -} - - -void OpenClose(SgStatement *stmt, int error_msg) -{ - SgExpression *ioc[NUM__O]; - int io_err=control_list_open(stmt->expr(1),ioc); // control_list analisys - if(error_msg) - Check_Control_IO_Statement(io_err,ioc,stmt,error_msg); - if(!options.isOn(READ_ALL)) - Replace_IO_Statement(ioc,stmt); - cur_st = stmt; - return; -} - -void NewOpenClose(SgStatement *stmt) -{ - SgExpression *ioc[NUM__O]; - int io_err=control_list_open(stmt->expr(1),ioc); // control_list analisys - io_err = Check_Control_IO_Statement(io_err,ioc,stmt,NO_ERROR_MSG); - if(io_err) - ReplaceByStop(io_err,stmt); - else - Replace_IO_Statement(ioc,stmt); - return; -} - -void Replace_IO_Statement(SgExpression *ioc[],SgStatement *stmt) -{ - cur_st = stmt; - if(ioc[IOSTAT_]) // there is keyed argument IOSTAT - InsertSendIOSTAT(ioc[IOSTAT_]); - ReplaceByIfStmt(stmt); -} - -void ReplaceByStop(int io_err, SgStatement *stmt) -{ - SgStatement *new_stmt = new SgStatement(STOP_STAT); - stmt->insertStmtAfter(*new_stmt,*stmt->controlParent()); - char num3s[4]; - format_num(io_err, num3s); - char *buff = new char[strlen(stmt->fileName()) + 75]; - sprintf(buff, "Illegal IO statement, error %s on line %d of %s", num3s,stmt->lineNumber(), stmt->fileName()); - new_stmt = new SgStatement(PRINT_STAT); - new_stmt->setExpression(0,*new SgExprListExp(*new SgValueExp(buff))); - SgExpression *ecl = new SgExpression(SPEC_PAIR,new SgKeywordValExp("fmt"),new SgKeywordValExp("*"),NULL); - new_stmt->setExpression(1,*new SgExprListExp(*ecl)); - stmt->insertStmtAfter(*new_stmt,*stmt->controlParent()); - stmt-> extractStmt(); //extract IO statement - return; -} - -int Check_Control_IO_Statement(int io_err, SgExpression *ioc[], SgStatement *stmt, int error_msg) -{ - if( !io_err ) - { - if( error_msg ) - err("Illegal elements in control list", 185,stmt); - else - return (185); - } - if( ioc[ERR_] ) - { - if( error_msg ) - err("END= and ERR= specifiers are illegal in FDVM", 186,stmt); - else - return (186); - } - if( inparloop && (ioc[IOSTAT_] || stmt->variant() == INQUIRE_STAT) || stmt->variant() == READ_STAT) //(stmt->variant() == INQUIRE_STAT && ? (SgExpression *) 1 : ioc[IOSTAT_]) && inparloop ) - { - if( error_msg) - err("Illegal I/O statement in the range of parallel loop/region", 184,stmt); - else - return (184); - } - return(0); -} - -void Inquiry_Statement(SgStatement *stmt, int error_msg) -{ - Any_IO_Statement(stmt); - if(options.isOn(IO_RTS)) - ; // Inquiry_RTS(stmt); - else - Inquiry(stmt,error_msg); -} - -void Inquiry(SgStatement *stmt, int error_msg) -{ - SgExpression *ioc[NUM__O+1]; - int io_err; - io_err=control_list_inquire(stmt->expr(1),ioc); // control list analysis - if(error_msg) - Check_Control_IO_Statement(io_err,ioc,stmt,error_msg); - cur_st = stmt; - InsertSendInquire(ioc); - ReplaceByIfStmt(stmt); - cur_st = stmt; -} - -void FilePosition_Statement(SgStatement *stmt, int error_msg) -{ - Any_IO_Statement(stmt); - // RTS BACKSPACE isn't implemented! - if(options.isOn(IO_RTS)) - FilePosition_RTS(stmt, error_msg); - else - FilePosition(stmt,error_msg); -} - -void FilePosition_RTS(SgStatement* stmt, int error_msg) { - - SgExpression *ioc[NUM__R]; - int io_err = control_list1(stmt->expr(1), ioc); - // FIXME: it would be better to replace this error to control_list1 - if (!ioc[UNIT_]) { - if (error_msg) - err("Unit argument not specified in IO-statement", 456, stmt); - return; - } - if(!io_err) - { - if( error_msg ) - err("Illegal elements in control list", 185, stmt); - return; - } - - bool suitableForNewIO = checkArgsEnfileRewind(ioc, stmt, error_msg); - - // generate If construct: - // if (dvmh_ftn_connected (args) then else endif - SgStatement *ifst = IfConnected(stmt,ioc[UNIT_],suitableForNewIO); - SgStatement *last = ifst->lastNodeOfStmt(); //stmt->lexNext(); - //true body - Dvmh_FilePosition(ioc, stmt->variant()); - - //false body - NewFilePosition(stmt); //Replace_IO_Statement(ioc,stmt); - cur_st = last; -} - - -void FilePosition(SgStatement *stmt, int error_msg) -{ - SgExpression *ioc[NUM__R]; - - int io_err; - io_err = control_list1(stmt->expr(1),ioc); // control_list analisys - if(error_msg) - Check_Control_IO_Statement(io_err,ioc,stmt,error_msg); - Replace_IO_Statement(ioc,stmt); - cur_st = stmt; - return; -} - -void NewFilePosition(SgStatement *stmt) -{ - SgExpression *ioc[NUM__R]; - int io_err = control_list1(stmt->expr(1),ioc); // control_list analisys - io_err = Check_Control_IO_Statement(io_err,ioc,stmt,NO_ERROR_MSG); - if(io_err) - ReplaceByStop(io_err,stmt); - else - Replace_IO_Statement(ioc,stmt); - return; -} - -void ReadWrite_Statement(SgStatement *stmt, int error_msg) -{ - Any_IO_Statement(stmt); - if(options.isOn(IO_RTS)) - ReadWrite_RTS(stmt,error_msg); - else - ReadWritePrint_Statement(stmt,error_msg); -} - -void NewReadWritePrint_Statement(SgStatement *stmt) -{ - SgExpression *ioc[NUM__R]; - - int io_err= IOcontrol(stmt->expr(1),ioc,stmt->variant()); //control_list1(stmt->expr(1),ioc); // control_list analisys - io_err = Check_Control_IO_Statement(io_err,ioc,stmt,NO_ERROR_MSG); - if(!io_err) - io_err = Check_ReadWritePrint(ioc,stmt,NO_ERROR_MSG); - if(io_err) - ReplaceByStop(io_err,stmt); - else - Replace_ReadWritePrint(ioc, stmt); - return; -} - -void ReadWrite_RTS(SgStatement *stmt, int error_msg) -{ - SgExpression *ioc[NUMB__RW]; - int io_err = control_list_rw(stmt->expr(1),ioc); - if(!io_err) - { - if( error_msg ) { - if (!ioc[UNIT_RW]) - err("UNIT not specified in read/write statement", 456, stmt); - else - err("Illegal elements in control list", 185, stmt); - } - return; - } - - bool suitableForNewIO = checkArgsRW(ioc, stmt, error_msg); - - // generate If construct: - // if (dvmh_ftn_connected (args) then else endif - SgStatement *ifst = IfConnected(stmt,ioc[UNIT_],suitableForNewIO); - SgStatement *last = ifst->lastNodeOfStmt(); //stmt->lexNext(); - - //true body - Dvmh_ReadWrite(ioc, stmt); - - //false body - NewReadWritePrint_Statement(stmt); - cur_st = last; -} - -int FixError(const char *str, int ierr, SgSymbol *s, SgStatement *stmt, int error_msg) -{ - if(error_msg) { - if(s) - Error(str,s->identifier(),ierr,stmt); - else - err(str,ierr,stmt); - return (-1); - } - else - return(ierr); -} - -int Check_ReadWritePrint(SgExpression *ioc[], SgStatement *stmt, int error_msg) -{ - if(ioc[END_] || ioc[ERR_] || ioc[EOR_]) - return FixError("END=, EOR= and ERR= specifiers are illegal in FDVM",186,NULL,stmt,error_msg); - - if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING) && ioc[UNIT_]->symbol() && HEADER(ioc[UNIT_]->symbol())) - return FixError("'%s' is distributed array",148,ioc[UNIT_]->symbol(),stmt,error_msg); - - if(ioc[FMT_]) - { - SgKeywordValExp *kwe = isSgKeywordValExp(ioc[FMT_]); - if(kwe && strcmp(kwe->value(),"*")) - return FixError("Invalid format specification",189,NULL,stmt,error_msg); - } - SgExpression *iol = stmt->expr(0); // I/O list - SgExpression *e; - if(iol && (e = isSgArrayRefExp(iol->lhs())) && (HEADER(iol->lhs()->symbol()))) - { // first item is distributed array refference - if (iol->rhs() ) // there are other items in I/O-list - return FixError("Illegal I/O list ",190,NULL,stmt,error_msg); - - //if(ioc[IOSTAT_] ) - // return FixError("IOSTAT= specifier is illegal in I/O of distributed array", 187,NULL,stmt,error_msg); - - if(ioc[FMT_] && !isSgKeywordValExp(ioc[FMT_]) || ioc[NML_] ) - return FixError("I/O of distributed array controlled by format specification or NAMELIST is not supported in FDVM", 191,NULL,stmt,error_msg); - - if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING) && ioc[UNIT_]->symbol()) //I/O to internal file - return FixError("'%s' is distributed array",148,e->symbol(),stmt,error_msg); - - if(IN_COMPUTE_REGION && !inparloop && !in_checksection ) - return FixError("Illegal statement in the range of region (not implemented yet)", 576,NULL,stmt,error_msg); - } - else { - if( iol && !TestIOList(iol,stmt,error_msg) && !error_msg) // check I/O list - return (192); - } - return(0); -} - -void Replace_ReadWritePrint( SgExpression *ioc[], SgStatement *stmt) -// READ, WRITE, PRINT statements - -{ - SgExpression *e, *iol; - int IOtype; - - cur_st = stmt; - - // analizes UNIT specifier - if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING)) { - SgKeywordValExp *kwe; - if((kwe=isSgKeywordValExp(ioc[UNIT_])) && (!strcmp(kwe->value(),"*"))) - //"*" - system unit - ; - else // I/O to internal file - return; - } - - // analizes format specifier and determines type of I/O - if(ioc[FMT_]) { - - SgKeywordValExp *kwe = isSgKeywordValExp(ioc[FMT_]); - if(kwe) // Format - if(!strcmp(kwe->value(),"*")) - IOtype = 1; // formatted IO, controlled by IO-list - else - return; // illegal format specifier ?? - - else - IOtype = 2; // formatted IO, controlled by format - // specification or NAMELIST - } - else - IOtype = 3; // unformatted IO - if(ioc[NML_]) - IOtype = 2; // formatted IO, controlled by NAMELIST - - //looking through the IO-list - iol = stmt->expr(0); - if(!iol) { // input list is absent - Replace_IO_Statement(ioc,stmt); - return; - } - if((e = isSgArrayRefExp(iol->lhs())) && (HEADER(iol->lhs()->symbol()))) { - // first item is distributed array refference - if (iol->rhs()) // error: there are other items in I/O-list - return; - if(!e->lhs() && IOtype != 2) //whole array and format=* or unformatted - { - if (ioc[IOSTAT_]) // there is keyed argument IOSTAT - InsertSendIOSTAT(ioc[IOSTAT_]); - - IO_ThroughBuffer(e->symbol(),stmt,ioc[IOSTAT_]); - } - else - return; //error - - } - else { // replicated variable list - if(!TestIOList(iol,stmt,NO_ERROR_MSG)) - return; - if (ioc[IOSTAT_] || (stmt->variant() == READ_STAT)) { - - if(stmt->variant() == READ_STAT) - InsertSendInputList(iol,ioc[IOSTAT_],stmt); - else - InsertSendIOSTAT(ioc[IOSTAT_]); - } - ReplaceByIfStmt(stmt); - } -} - -void ReadWritePrint_Statement(SgStatement *stmt, int error_msg) -// READ, WRITE, PRINT statements - -{ SgSymbol *sio; - SgExpression *e,*iol; - SgExpression *ioc[NUM__R]; - int IOtype, io_err; - cur_st = stmt; - send = 0; - // analizes IO control list and sets on ioc[] - e = stmt->expr(1); // IO control - io_err = IOcontrol(e,ioc,stmt->variant()); - if(!io_err && error_msg){ - err("Illegal elements in control list", 185,stmt); - return; - } - if((ioc[END_] || ioc[ERR_] || ioc[EOR_]) && error_msg) { - err("END=, EOR= and ERR= specifiers are illegal in FDVM", 186,stmt); - return; - } - - if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING)) { - SgKeywordValExp *kwe; - if((kwe=isSgKeywordValExp(ioc[UNIT_])) && (!strcmp(kwe->value(),"*"))) - //"*" - system unit - ; - else { // I/O to internal file - if(ioc[UNIT_]->symbol() && HEADER(ioc[UNIT_]->symbol()) && error_msg) - Error("'%s' is distributed array", ioc[UNIT_]->symbol()->identifier(), 148,stmt); - if(error_msg) - TestIOList(stmt->expr(0),stmt,error_msg); - //err("I/O to internal file is not supported in FDVM", stmt); - return; - } - } - - // analizes format specifier and determines type of I/O - if(ioc[FMT_]) { - - SgKeywordValExp * kwe; - kwe = isSgKeywordValExp(ioc[FMT_]); - if(kwe) // Format - if(!strcmp(kwe->value(),"*")) - IOtype = 1; // formatted IO, controlled by IO-list - else { - IOtype = 0; // illegal format specifier ?? - if(error_msg) - err("Invalid format specification", 189,stmt); - return; - } - else - IOtype = 2; // formatted IO, controlled by format - // specification or NAMELIST - } - else - IOtype = 3; // unformatted IO - if(ioc[NML_]) - IOtype = 2; // formatted IO, controlled by NAMELIST - - //Any_IO_Statement(stmt); - - //looking through the IO-list - iol = stmt->expr(0); - if(!iol) { // input list is absent - if(stmt->variant() != READ_STAT || !options.isOn(READ_ALL)) - Replace_IO_Statement(ioc,stmt); - return; - } - if((e = isSgArrayRefExp(iol->lhs())) && (HEADER(iol->lhs()->symbol()))) { - // first item is distributed array refference - if (iol->rhs() && error_msg) {// there are other items in I/O-list - - err("Illegal I/O list ", 190,stmt); - return; - } - //if(ioc[IOSTAT_] && error_msg) { - // err("IOSTAT= specifier is illegal in I/O of distributed array", 187,stmt); - // return; - // } - if(!e->lhs()) //whole array - if(IOtype != 2) { - sio = e->symbol(); - //buf_use[TypeIndex(sio->type()->baseType())] = 1; - if (ioc[IOSTAT_]) // there is keyed argument IOSTAT - InsertSendIOSTAT(ioc[IOSTAT_]); - - IO_ThroughBuffer(sio,stmt,ioc[IOSTAT_]); - - if(IN_COMPUTE_REGION && !inparloop && !in_checksection && error_msg) - err("Illegal statement in the range of region (not implemented yet)", 576,stmt); - } - else { - if( error_msg) - err("I/O of distributed array controlled by format specification or NAMELIST is not supported in FDVM", 191,stmt); - // illegal format specifier for I/O of distributed array - return; - } - else { - if(error_msg) - err("Illegal I/O list item", 192,stmt); - return; - } - } - else { // replicated variable list - if(!TestIOList(iol,stmt,error_msg)) - return; - if (stmt->variant() == READ_STAT) { - if(!options.isOn(READ_ALL)) - InsertSendInputList(iol,ioc[IOSTAT_],stmt); - } - else if(ioc[IOSTAT_] ) - InsertSendIOSTAT(ioc[IOSTAT_]); - - if(stmt->variant() != READ_STAT || !options.isOn(READ_ALL)) - ReplaceByIfStmt(stmt); - //if(IN_COMPUTE_REGION && !in_checksection) - // ChangeDistArrayRef(iol); - } - if(inparloop && (send || IN_COMPUTE_REGION || parloop_by_handler) && error_msg) - err("Illegal I/O statement in the range of parallel loop/region", 184,stmt); - -} - -void IO_ThroughBuffer(SgSymbol *ar, SgStatement *stmt, SgExpression *eiostat) -{ - SgStatement *dost=NULL, *contst, *ifst, *next; - SgExpression *esize,*econd,*iodo, *iolist,*ubound,*are,*d, *eN[8]; - SgValueExp c1(1),c0(0); - SgLabel *loop_lab=NULL; - //SgSymbol *sio; - int i,l,rank,s,s0,N[8],itype,imem; - int m = -1; - int init,last,step; - int M=0; - cur_st = stmt; - next = stmt->lexNext(); - contst = NULL; - imem=ndvm; - ReplaceContext(stmt); - - itype = TypeIndex(ar->type()->baseType()); - if(itype == -1) //may be derived type - { - Error("Illegal type's array in input-output statement: %s",ar->identifier(),999,stmt); - return; - } else - buf_use[itype] = 1; - l = rank = Rank(ar); - s = IOBufSize; //SIZE_IO_BUF; - for(i=1; i<=rank; i++) { - //calculating size of i-th dimension - esize = ReplaceParameter(ArrayDimSize(ar, i)); - eN[i] = NULL; - if(esize && esize->variant()==STAR_RANGE) - { - Error("Assumed-size array: %s",ar->identifier(),162,stmt); - return; - } - if(esize->isInteger()) - N[i] = esize->valueInteger(); - else - {N[i] = -1; eN[i] = esize;} //!! dummy argument - if((N[i] <= 0) && !eN[i]) - { - Error("Array shape declaration error: '%s'", ar->identifier(),193, stmt); - return; - } - } - // calculating s - for(i=1; i<=rank; i++) { - if(eN[i]) { - l=i-1; - break; - } - s0 = s / N[i]; - if(!s0) { // s0 == 0 - l = i-1; - break; - } - else - s = s0; - } - if(l==rank) { // generating assign statement: m = 1 - // m = ndvm; - //doAssignStmtBefore(&c1.copy(),stmt); - M=1; - } - else - m = ndvm++; - - if(l+1 <= rank) { - // generating DO statement: DO label idvm01 = 0, N[l+1]-1, s - - loop_lab = GetLabel(); - contst = new SgStatement(CONT_STAT); - esize = eN[l+1] ? &(eN[l+1]->copy() - c1.copy()) : new SgValueExp(N[l+1]-1); - dost= new SgForStmt(*loop_var[1], c0.copy(), *esize, *new SgValueExp(s), *contst); - BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; - (dost->lexNext())->setLabel(*loop_lab); - - if(l+2 <= rank) - // generating DO nest: - // DO label idvm02 = 0, N[rank]-1 - // DO label idvm03 = 0, N[rank-1]-1 - // . . . - // DO label idvm0j = 0, N[l+2]-1 - - //for(i=rank; i>l+1; i--) { //27.11.09 - for(i=l+2; i<=rank; i++) { - esize = eN[i] ? &(eN[i]->copy() - c1.copy()) : new SgValueExp(N[i]-1); - dost= new SgForStmt(*loop_var[rank-i+2], c0.copy(), *esize, *dost); - - BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; - } - - cur_st->insertStmtAfter(*dost); - - for(i=l+1; i<=rank; i++) - contst->lexNext()->extractStmt(); // extracting ENDDO - - if((N[l+1]<0) || (N[l+1]-(N[l+1]/s)*s)) { - // generating the construction - // IF (Il+1 + s .LE. Nl+1) THEN - // m = s - // ELSE - // m = Nl+1 - Il+1 - // ENDIF - // and then insert it before CONTINUE statement - esize = eN[l+1] ? &(eN[l+1]->copy()) : new SgValueExp(N[l+1]); - econd = & (( *new SgVarRefExp(*loop_var[1]) + *new SgValueExp(s)) <= *esize); - ifst = new SgIfStmt(*econd, *new SgAssignStmt(*DVM000(m),*new SgValueExp(s)), *new SgAssignStmt(*DVM000(m),*esize - *new SgVarRefExp(*loop_var[1]))); - contst -> insertStmtBefore(*ifst); - } - else - //dost->insertStmtBefore(*new SgAssignStmt(*DVM000(m),*new SgValueExp(s))); - M=s; - //cur_st = ifst; - stmt->extractStmt(); - contst -> insertStmtBefore(*stmt); - // transfering label over D0-statements - BIF_LABEL(dost->thebif) = BIF_LABEL(stmt->thebif); - BIF_LABEL(stmt->thebif) = NULL; - //cur_st = stmt; - } - // creating implicit loop as element of I/O list: - // (BUF(I0), I0= 1,N1*...*Nl*m) - ubound = DVM000(m); - N[0] = 1; - for(i=1; i<=l; i++) - N[0] = N[0] * N[i]; - if(M) // M= const - ubound = new SgValueExp(N[0]*M); - else { - ubound = DVM000(m); - if(N[0] != 1) - ubound = &( *ubound * (*new SgValueExp(N[0])) ); - } - - // ubound = &( *ubound * (*new SgValueExp(N[0]))); - // iodo = new SgExpression(DDOT,&c1.copy(), ubound,NULL); - iodo = & SgDDotOp(c1.copy(),*ubound); - iodo = new SgExpression(SEQ,iodo,NULL,NULL); - iodo = new SgExpression(IOACCESS,NULL,iodo,loop_var[0]); - // iodo = new SgIOAccessExp(*loop_var[0], c1.copy(), *ubound);//Sage error - iodo -> setLhs(new SgArrayRefExp(*bufIO[itype], *new SgVarRefExp(*loop_var[0]))); - iolist = new SgExprListExp(*iodo); - // iolist -> setLhs(iodo); - // replacing I/O list in source I/O statement - stmt -> setExpression(0,*iolist); - //generating assign statement - //dvm000(i) = ArrCpy(...) - are = new SgArrayRefExp(*bufIO[Integer],c1.copy()); //!!! itype=>Integer (bufIO[itype]) - init = ndvm; - //if(l+2 <= rank) - for(i=2; i<(rank-l+1);i++ ) - doAssignStmtBefore(new SgVarRefExp(*loop_var[i]),stmt); - if(l+1 <= rank) - doAssignStmtBefore(new SgVarRefExp(*loop_var[1]),stmt); - - for(i=l; i; i-- ) - doAssignStmtBefore(new SgValueExp(-1),stmt); - last = ndvm; - //if(l+2 <= rank) - for(i=2; i<(rank-l+1);i++ ) - doAssignStmtBefore(new SgVarRefExp(*loop_var[i]),stmt); - if(l+1 <= rank) { - d = new SgVarRefExp(*loop_var[1]); - if(M != 1) - d = (M)? &(*d+(*new SgValueExp(M-1))) : &(*d+(*DVM000(m))-c1.copy()); - doAssignStmtBefore(d,stmt); - } - - step = last+rank; - if(l+1 <= rank) { - ndvm = step + rank - l - 1; - doAssignStmtBefore(&c1.copy(),stmt); - } - ndvm = step+rank; - if(stmt->variant() == READ_STAT){ - doAssignStmtAfter (A_CopyTo_DA(are,HeaderRef(ar),init,last,step,2)); - if(dvm_debug) { - if(contst) - cur_st = contst; - cur_st->insertStmtAfter(*D_Read(GetAddresDVM(HeaderRefInd(ar,1)))); - } - } else - doAssignStmtBefore(DA_CopyTo_A(HeaderRef(ar),are,init,last,step,2),stmt); - // replace I/O statement by: IF(TstIO().NE.0) I/O-statement - ReplaceByIfStmt(stmt); - if(eiostat && dost) - { - LogIf_to_IfThen(stmt->controlParent()); - SgLabel *lab_out = GetLabel(); - doIfIOSTAT(eiostat,stmt,new SgGotoStmt(*lab_out)); - next->setLabel(*lab_out); //next -> send of IOSTAT - } - - //calculating maximal number of used loop variables for I/O - nio = (nio < (rank-l+1)) ? (rank-l+1) : nio; - SET_DVM(imem); -} - -int IOcontrol(SgExpression *e, SgExpression *ioc[],int type) -// analizes IO_control list (e) and sets on ioc[] -{ SgKeywordValExp *kwe; - SgExpression *ee,*el; - int i; - for(i=NUM__R; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR) { - if(type == PRINT_STAT) - ioc[FMT_] = e->rhs(); - else { - // ioc[UNIT_] = e->rhs(); - kwe = isSgKeywordValExp(e->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_] = e->rhs(); - else if (!strcmp(kwe->value(),"fmt")) - ioc[FMT_] = e->rhs(); - else - return(0); - } - return(1); - } - - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return(0); // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"fmt")) - ioc[FMT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"nml")) - ioc[NML_] = ee->rhs(); - else if (!strcmp(kwe->value(),"rec")) - ioc[REC_] = ee->rhs(); - else if (!strcmp(kwe->value(),"iostat")) - ioc[IOSTAT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"end")) - ioc[END_] = ee->rhs(); - else if (!strcmp(kwe->value(),"err")) - ioc[ERR_] = ee->rhs(); - else if (!strcmp(kwe->value(),"eor")) - ioc[EOR_] = ee->rhs(); - else if (!strcmp(kwe->value(),"size")) - ioc[SIZE_] = ee->rhs(); - else if (!strcmp(kwe->value(),"advance")) - ioc[ADVANCE_] = ee->rhs(); - else if (!strcmp(kwe->value(),"pos")) - ioc[POS_] = ee->rhs(); - - else - return(0); - } - return(1); - } - else - return(0); -} - -int control_list_rw(SgExpression *e, SgExpression *ioc[]) -// analizes IO_control list (e) and sets on ioc[] -{ SgKeywordValExp *kwe; - SgExpression *ee,*el; - int i; - for(i=NUMB__RW; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR) { - kwe = isSgKeywordValExp(e->lhs()); - if (!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_RW] = e->rhs(); - else if (!strcmp(kwe->value(),"fmt")) - ioc[FMT_RW] = e->rhs(); - else if (!strcmp(kwe->value(), "nml")) - ioc[NML_RW] = e->rhs(); - else - return(0); - return(1); - } - - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return(0); // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"fmt")) - ioc[FMT_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"nml")) - ioc[NML_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"advance")) - ioc[ADVANCE_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"async")) - ioc[ASYNC_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"blank")) - ioc[BLANK_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"decimal")) - ioc[DECIMAL_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"delim")) - ioc[DELIM_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"end")) - ioc[END_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"err")) - ioc[ERR_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"eor")) - ioc[EOR_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"id")) - ioc[ID_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"iomsg")) - ioc[IOMSG_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"iostat")) - ioc[IOSTAT_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"pad")) - ioc[PAD_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"pos")) - ioc[POS_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"rec")) - ioc[REC_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"round")) - ioc[ROUND_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"sign")) - ioc[SIGN_RW] = ee->rhs(); - else if (!strcmp(kwe->value(),"size")) - ioc[SIZE_RW] = ee->rhs(); - else - return(0); - } - if (!ioc[UNIT_RW]) return(0); - return(1); - } - else - return(0); -} - -int control_list1(SgExpression *e, SgExpression *ioc[]) -// analizes control list (e) for statements BACKSPACE,REWIND and ENDFILE -// and sets on ioc[] -{ SgKeywordValExp *kwe; - SgExpression *ee,*el; - int i; - for(i=NUM__R; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR) { - ioc[UNIT_] = e->rhs(); - return(1); - } - - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return(0); // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"iostat")) - ioc[IOSTAT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"err")) - ioc[ERR_] = ee->rhs(); - //else if (!strcmp(kwe->value(), "iomsg")) - // ioc[IOMSG_] = ee->rhs(); - else - return(0); - } - return(1); - } - else - return(0); -} - -int control_list_inquire (SgExpression *e, SgExpression *ioc[]) -// analizes control list (e) INQUIRE statement -// and sets on ioc[] -{ - SgKeywordValExp *kwe; - int i; - for(i=NUM__O+1; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR && (kwe=isSgKeywordValExp(e->lhs())) && !strcmp(kwe->value(),"iolength")) { // case of INQUIRY (IOLENGTH = ...) outlist - ioc[NUM__O] = e->rhs(); - return (1); - } else - return(control_list_open(e,ioc)); // control_list analisys -} - -int control_list_open(SgExpression *e, SgExpression *ioc[]) -// analizes control list (e) for OPEN,CLOSE and INQUIRE statements -// and sets on ioc[] -{ SgKeywordValExp *kwe; - SgExpression *ee,*el; - int i; - for(i=NUM__O; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR) { - ioc[UNIT_] = e->rhs(); - return(1); - } - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return(0); // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"file")) - ioc[FILE_] = ee->rhs(); - else if (!strcmp(kwe->value(),"status")) - ioc[STATUS_] = ee->rhs(); - else if (!strcmp(kwe->value(),"iostat")) - ioc[IOSTAT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"access")) - ioc[ACCESS_] = ee->rhs(); - else if (!strcmp(kwe->value(),"err")) - ioc[ERR_] = ee->rhs(); - else if (!strcmp(kwe->value(),"form")) - ioc[FORM_] = ee->rhs(); - else if (!strcmp(kwe->value(),"recl")) - ioc[RECL_] = ee->rhs(); - else if (!strcmp(kwe->value(),"blank")) - ioc[BLANK_] = ee->rhs(); - else if (!strcmp(kwe->value(),"exist")) - ioc[EXIST_] = ee->rhs(); - else if (!strcmp(kwe->value(),"opened")) - ioc[OPENED_] = ee->rhs(); - else if (!strcmp(kwe->value(),"number")) - ioc[NUMBER_] = ee->rhs(); - else if (!strcmp(kwe->value(),"named")) - ioc[NAMED_] = ee->rhs(); - else if (!strcmp(kwe->value(),"name")) - ioc[NAME_] = ee->rhs(); - else if (!strcmp(kwe->value(),"sequential")) - ioc[SEQUENTIAL_] = ee->rhs(); - else if (!strcmp(kwe->value(),"direct")) - ioc[DIRECT_] = ee->rhs(); - else if (!strcmp(kwe->value(),"nextrec")) - ioc[NEXTREC_] = ee->rhs(); - else if (!strcmp(kwe->value(),"formatted")) - ioc[FORMATTED_] = ee->rhs(); - else if (!strcmp(kwe->value(),"unformatted")) - ioc[UNFORMATTED_] = ee->rhs(); - else if (!strcmp(kwe->value(),"position")) - ioc[POSITION_] = ee->rhs(); - else if (!strcmp(kwe->value(),"action")) - ioc[ACTION_] = ee->rhs(); - else if (!strcmp(kwe->value(),"readwrite")) - ioc[READWRITE_] = ee->rhs(); - else if (!strcmp(kwe->value(),"read")) - ioc[READ_] = ee->rhs(); - else if (!strcmp(kwe->value(),"write")) - ioc[WRITE_] = ee->rhs(); - else if (!strcmp(kwe->value(),"delim")) - ioc[DELIM_] = ee->rhs(); - else if (!strcmp(kwe->value(),"pad")) - ioc[PAD_] = ee->rhs(); - else if (!strcmp(kwe->value(),"convert")) - ioc[CONVERT_] = ee->rhs(); - - else - return(0); - } - return(1); - } - else - return(0); -} - -void InsertSendIOSTAT(SgExpression * eios) -{int imem; - SgType *t; - imem = ndvm; - doAssignStmtAfter(GetAddresMem(eios)); - t = eios->symbol() ? Base_Type(eios->symbol()->type()) : SgTypeInt();//type of IOSTAT var - doAssignStmtAfter(TypeLengthExpr(t)); //type size - //doAssignStmtAfter(new SgValueExp(TypeSize(t))); 14.03.03 - doCallAfter(SendMemory(1,imem,imem+1)); //count of memory areas = 1 - if(dvm_debug) - InsertNewStatementAfter(D_Read(DVM000(imem)),cur_st,cur_st->controlParent()); - SET_DVM(imem); -} - -void InsertSendInquire(SgExpression * eioc[]) -{int imem,j,i,icount; - imem = ndvm; - j=0; - if(eioc[NUM__O]) { // case of INQUIRY (IOLENGTH = ...) outlist - j=1; - doAssignStmtAfter(GetAddresMem(eioc[NUM__O])); - doAssignStmtAfter(TypeLengthExpr(eioc[NUM__O]->type())); - } else { - for (i=IOST_;itype())); - //doAssignStmtAfter(new SgValueExp(TypeSize(eioc[i]->type()))); 14.03.03 - } - if(j) { - icount = j; //count of memory areas - doCallAfter(SendMemory(icount,imem,imem+j)); - if(dvm_debug) - for(i=0; icontrolParent()); - } - SET_DVM(imem); -} - -int isDependence(SgExpression *e,SgExpression *eprev) -{ - if(!e || !eprev) - return 0; - if(ExpCompare(e, eprev)) - return 1; - return (isDependence(e->lhs(),eprev) || isDependence(e->rhs(),eprev)); -} - -int ElementDependence(SgStatement *st_first, SgStatement *st, SgExpression *e) -{ - SgStatement *st_next = st_first; - for(;st_next != st; st_next=st_next->lexNext()) - if(isDependence(e,st_next->expr(1)->lhs()->lhs())) //st_next is dvm000(i)=getai(el), search for dependency between e and el - return 1; - return 0; -} - -void SendList(SgStatement *st_first, SgExpression *iisize[], int imem, int j0, int nl) -{ - SgStatement *st; - int i,j; - if(j0==nl) return; - for(j = j0,st=st_first; jlexNext()) - { - if( j!=j0 && (ElementDependence(st_first,st,st->expr(1)->lhs()->lhs()) || ElementDependence(st_first,st,iisize[j]))) - break; - } - cur_st = st->lexPrev(); - for(i=j0;ilexNext(),iisize,imem,j,nl); -} - -# define MAXLISTLEN 1000 - -void InsertSendInputList(SgExpression * input_list, SgExpression * io_stat,SgStatement *stmt) -{int imem,j,i,icount,iel; - SgExpression *el,*ein,*iisize[MAXLISTLEN],*iinumb[MAXLISTLEN],*iielem[MAXLISTLEN]; - SgType *t; - SgStatement *st_save = cur_st; - imp_loop = NULL; - - if(dvm_debug) - for(i=0;irhs()) { - ein = el->lhs(); // input list item - if(j== MAXLISTLEN-2) - err("Compiler bug (in InsertSendInputList)",0,stmt); - if(isSgIOAccessExp(ein)) //implicit loop - { if(!SpecialKindImplicitLoop(el->rhs(),ein,&j, iisize, iielem, iinumb, stmt)) - ImplicitLoop(ein,&j, iisize, iielem, iinumb, stmt); - } - else if(isSgArrayRefExp(ein) && !ein->lhs() && (ein->type()->variant()!=T_STRING)){//whole array - doAssignStmtAfter(GetAddresMem(FirstArrayElement(ein->symbol()))); - iisize[j] = InputItemLength(ein,stmt); - if(dvm_debug){ - iielem[j] = ElemLength(ein->symbol()); - iinumb[j] = NumbOfElem(iisize[j], iielem[j]); - } - j++; - } - else if(isSgArrayRefExp(ein) && (ein->type()->variant()==T_ARRAY)){//section of array - doAssignStmtAfter(GetAddresMem (ContinuousSection(ein) ? FirstElementOfSection(ein) : FirstArrayElement(ein->symbol()))); - iisize[j] = InputItemLength(ein,stmt); - if(dvm_debug){ - iielem[j] = ElemLength(ein->symbol()); - iinumb[j] = NumbOfElem(iisize[j], iielem[j]); - } - j++; - - } - else if(isSgRecordRefExp(ein) && ein->type()->variant() == T_ARRAY ) { //structure reference of ArrayType - SgExpression *ein_short = ArrayFieldLast(ein); - doAssignStmtAfter( GetAddresMem( isSgRecordRefExp(ein_short) ? FirstElementOfField(ein_short) : FirstElementOfSection(ein_short) ) ); - iisize[j] = InputItemLength(ein_short,stmt); - if(dvm_debug){ - iielem[j] = ElemLength(isSgRecordRefExp(ein_short) ? RightMostField(ein_short)->symbol() : ein_short->symbol()); - iinumb[j] = NumbOfElem(iisize[j], iielem[j]); - } - j++; - - } - else { - doAssignStmtAfter(GetAddresMem(ein->type()->variant()==T_ARRAY ? FirstElementOfSection(ein) : ein)); - iisize[j] = InputItemLength(ein,stmt); - j++; - } - } - if(io_stat) { - doAssignStmtAfter(GetAddresMem(io_stat)); - t = io_stat->symbol() ? Base_Type(io_stat->symbol()->type()) : SgTypeInt();//type of IOSTAT var - iisize[j] = TypeLengthExpr(t); //new SgValueExp(TypeSize(t)); - j++; - } - - SendList(st_save->lexNext(),iisize,imem,0,j); - - if(dvm_debug){ - for(i=0;icontrolParent()); - SET_DVM(iel); - } else - InsertNewStatementAfter(D_Read(DVM000(imem+i)),cur_st,cur_st->controlParent()); - } - SET_DVM(imem); -} - -int SpecialKindImplicitLoop(SgExpression *el, SgExpression *ein, int *pj, SgExpression *iisize[], SgExpression *iielem[],SgExpression *iinumb[],SgStatement *stmt) -{ - SgExpression *ell, *e, *e1, *enumb, *elen, *bounds; - SgSymbol *s; - SgValueExp c1(1); - - if(el) return(0); //number of input list items > 1 - ell = ein->lhs(); - if(ell->rhs()) return(0); //number of items of implicit loop list - e = ell->lhs(); s = e->symbol(); - bounds = ein->rhs(); - if(bounds->rhs()) return(0); //step of implicit loop is specified - if(isSgArrayRefExp(e) && (e->type()->variant()!=T_STRING) && Rank(s)==1 && (isSgVarRefExp(e->lhs()->lhs())) && (e->lhs()->lhs()->symbol() == ein->symbol()) ) { - e1 = &(e->copy()); - e1->lhs()->setLhs(bounds->lhs()->lhs()->copy()); - doAssignStmtAfter(GetAddresMem(e1)); //initial address of array section - enumb = &(bounds->lhs()->rhs()->copy() - bounds->lhs()->lhs()->copy() + c1); - elen = ElemLength(s); - - iisize[*pj] = &(*enumb * (*elen)); //array section length - if(dvm_debug) { - iielem[*pj] = elen; //ElemLength(s); - iinumb[*pj] = enumb; - } - *pj = *pj+1; - return (1); - } - else - return(0); - -} - -void ImplicitLoop(SgExpression *ein, int *pj, SgExpression *iisize[], SgExpression *iielem[],SgExpression *iinumb[],SgStatement *stmt) -{ - SgExpression *ell, *e; - for (ell = ein->lhs();ell;ell=ell->rhs()){ //looking through item list of implicit loop - e = ell->lhs(); - if(isSgIOAccessExp(e)) - ImplicitLoop(e,pj,iisize,iielem,iinumb,stmt); - else { - if(isSgArrayRefExp(e)) { - SgExpression *e1 ; - SgSymbol *ar; - int has_aster_or_1; - - if(!e->lhs() && e->type()->variant()==T_STRING) {//character object - doAssignStmtAfter(GetAddresMem(e)); - iisize[*pj] = InputItemLength(e,stmt); - *pj = *pj+1; - continue; - } - ar = e->symbol(); - has_aster_or_1 = hasAsterOrOneInLastDim(ar); //testing last dimension : * or 1 - if(! has_aster_or_1) { - if(isInSymbList(imp_loop,ar)) - continue; - else - imp_loop = AddToSymbList(imp_loop,ar); - } - e1 = FirstArrayElement(ar); - doAssignStmtAfter(GetAddresMem(e1)); //initial array address - iisize[*pj] =ArrayLength(ar,stmt,0);// whole array length - if (has_aster_or_1) //testing last dimension : * or 1 - { - if (ein->symbol() == lastDimInd(e->lhs())) - iisize[*pj] = CorrectLastOpnd(iisize[*pj], ar, ein->rhs(), stmt); - //correcting whole array length by implicit loop parameters - else - Error("Can not calculate array length: %s", ar->identifier(), 194, stmt); - } - - if(dvm_debug) { - iielem[*pj] = ElemLength(ar); - iinumb[*pj] = NumbOfElem(iisize[*pj], iielem[*pj]); - } - *pj = *pj+1; - } - else if(e->variant() == ARRAY_OP) {//substring or substring of array element - SgExpression *e1 ; - if( !e->lhs()->lhs()) //substring - { - doAssignStmtAfter(GetAddresMem(e->lhs())); - iisize[*pj] = InputItemLength(e->lhs(),stmt); - *pj = *pj+1; - continue; - } - //substring of array element - e1 = FirstArrayElement(e->lhs()->symbol()); - doAssignStmtAfter(GetAddresMem(e1)); //initial array address - iisize[*pj] = ArrayLength(e->lhs()->symbol(),stmt,1); // whole array length - *pj = *pj+1; - } - else { - doAssignStmtAfter(GetAddresMem(e)); - iisize[*pj] = InputItemLength(e,stmt); - *pj = *pj+1; - } - } - } -} - -/* - * variant when substring is represented by ARRAY_REF node with 2 operands - * -SgExpression * InputItemLength (SgExpression *e, SgStatement *stmt) -{ - if (isSgVarRefExp(e)) - return(new SgValueExp(TypeSize(e->type()))); - if (isSgArrayRefExp(e)) - if(e->type()->variant()!=T_STRING) //whole array or array element of non-character type - if(e->lhs()) //array element - return(new SgValueExp(TypeSize(e->symbol()->type()->baseType()))); - else //whole array - return(ArrayLength(e->symbol(),stmt,1)); - else { //variable, array element, substring or substring of array element of type CHARACTER - if(!(e->lhs())) //variable - return(StringLengthExpr(e->symbol()->type(),e->symbol())); - //return(new SgValueExp(CharLength(e->symbol()->type()))); 14.03.03 - // e = e->lhs()->lhs(); //variant of e->lhs() is EXPR_LIST - - if(!(e->rhs()) && (e->lhs()->lhs()->variant() != DDOT)) //array element of type CHARACTER - return(StringLengthExpr(e->symbol()->type()->baseType(),e->symbol())); - //return(new SgValueExp(CharLength(e->symbol()->type()->baseType()))); - else - return(SubstringLength(e)); - } - return(new SgValueExp(-1)); -} - -SgExpression *SubstringLength(SgExpression *sub) -{ //SgSubscriptExp *sbe; - SgValueExp c1(1); - SgExpression *e,*e1,*e2; - SgType *t; -//err("Sorry, substring length calculating is not jet implemented",cur_st); - if(sub->lhs()->lhs()->variant() == DDOT) { //substring(sub has variant EXPR_LIST) - e = sub->lhs()->lhs(); - t=sub->symbol()->type(); - } - else { //substring of array element - e = sub->rhs(); - t=sub->symbol()->type()->baseType(); - } - if(e->lhs()) - e1 = &(e->lhs()->copy()); - else - e1 = &(c1.copy()); - - if(e->rhs()) - e2 = &(e->rhs()->copy()); - else - e2 = StringLengthExpr(t,sub->symbol()); //new SgValueExp(CharLength(t)); 14.03.03 - return (&(*e2 - *e1 + c1)); -} -*/ - - -SgExpression * InputItemLength (SgExpression *e, SgStatement *stmt) -{ - if(isSgRecordRefExp(e)) - { - e = RightMostField(e); - //printf("FIELD: %s %d ",(e->symbol() ? e->symbol()->identifier() : (char *)"----"),(e->type() ? e->type()->variant() : 0)); - //printf(" LINE %d IN %s\n" ,stmt->lineNumber(),stmt->fileName() ); - } - if (isSgVarRefExp(e)) - return(TypeLengthExpr(e->type())); - //return(new SgValueExp(TypeSize(e->type()))); 14.03.03 - if (isSgArrayRefExp(e)) - { - if (e->symbol()->type()->variant() == T_STRING) // variable of type CHARACTER - return(StringLengthExpr(e->symbol()->type(), e->symbol())); - //return(new SgValueExp(CharLength(e->symbol()->type()))); 14.03.03 - else - { - if (e->lhs() && !isSgArrayType(e->type())) //array element - return(TypeLengthExpr(e->symbol()->type()->baseType())); - else if (e->lhs() && isSgArrayType(e->type())) //array section - return(ContinuousSection(e) ? SectionLength(e, stmt, 1) : ArrayLength(e->symbol(), stmt, 1)); - else //whole array - return(ArrayLength(e->symbol(), stmt, 1)); - } - } - - if (e->variant() == ARRAY_OP) //substring or substring of array element - return(SubstringLength(e)); //substring - - return(new SgValueExp(-1)); -} - -SgExpression *SubstringLength(SgExpression *sub) -{ //SgSubscriptExp *sbe; - SgValueExp c1(1); - SgExpression *e,*e1,*e2; - SgType *t; - -//err("Sorry, substring length calculating is not jet implemented",cur_st); - if(!sub->lhs()->lhs()){ //substring - t=sub->lhs()->symbol()->type(); - e = sub->rhs()->lhs(); // sub->rhs() has variant EXPR_LIST - } - else{ //substring of array element - t=sub->lhs()->symbol()->type()->baseType(); - e = sub->rhs(); - } - if(e->lhs()) - e1 = &(e->lhs()->copy()); - else - e1 = &(c1.copy()); - - if(e->rhs()) - e2 = &(e->rhs()->copy()); - else - e2 = StringLengthExpr(t,sub->lhs()->symbol()); //new SgValueExp(CharLength(t)); - return (&(*e2 - *e1 + c1)); -} - -SgExpression *ArrayLength(SgSymbol *ar, SgStatement *stmt, int err) -{int i,rank; - SgExpression *esize,*len; -rank = Rank(ar); -len = TypeLengthExpr(ar->type()->baseType()); //length of one array element - //len = new SgValueExp(TypeSize(ar->type()->baseType())); 14.03.03 -for(i=1; i<=rank; i++) { - //calculating size of i-th dimension - esize = ReplaceParameter(ArrayDimSize(ar, i)); - if(err && esize && esize->variant()==STAR_RANGE) - Error("Assumed-size array: %s",ar->identifier(),162,stmt); - if(esize->isInteger()) - esize = new SgValueExp( esize->valueInteger()); - if(esize) - len = &(*len * (*esize)); - -} -if (len->isInteger()) // calculating length if it is possible - len = new SgValueExp( len->valueInteger()); -return(len); -} - -SgExpression *SectionLength(SgExpression *ea, SgStatement *stmt, int err) -{int i,rank; - SgExpression *esize,*len, *el, *eup[MAX_DIMS], *ein[MAX_DIMS]; - //rank = ArraySectionRank(ea); - rank = Rank(ea->symbol()); - len = TypeLengthExpr(ea->symbol()->type()->baseType()); //length of one array element - - - for(i=0,el=ea->lhs(); irhs()) { - //calculating size of i-th dimension - UpperBoundInTriplet(el->lhs(),ea->symbol(),i,eup); - LowerBoundInTriplet(el->lhs(),ea->symbol(),i,ein); - esize = &(*eup[i] - *ein[i] + *new SgValueExp(1)); - //if(err && esize && esize->variant()==STAR_RANGE) - // Error("Assumed-size array: %s",ar->identifier(),162,stmt); - //if(esize->isInteger()) - // esize = new SgValueExp( esize->valueInteger()); - if(esize) - len = &(*len * (*esize)); - -} - //if (len->isInteger()) // calculating length if it is possible - // len = new SgValueExp( len->valueInteger()); -return(len); -} - -SgExpression *ArrayLengthInElems(SgSymbol *ar, SgStatement *stmt, int err) -{int i,rank; - SgExpression *esize,*len; -rank = Rank(ar); -len = new SgValueExp(1); -for(i=1; i<=rank; i++) { - //calculating size of i-th dimension - esize = ReplaceParameter(ArrayDimSize(ar, i)); - if(err && esize && esize->variant()==STAR_RANGE) - Error("Assumed-size array: %s",ar->identifier(),162,stmt); - if(esize->isInteger()) - esize = new SgValueExp( esize->valueInteger()); - if(esize) - len = &(*len * (*esize)); - -} -if (len->isInteger()) // calculating length if it is possible - len = new SgValueExp( len->valueInteger()); -return(len); -} - -SgExpression *NumbOfElem(SgExpression *es,SgExpression *el) -{SgExpression *e,*e1 = NULL,*ec; - if(!es) - return(NULL); - if(es->isInteger()) - return(new SgValueExp( es->valueInteger() / el->valueInteger())); - //deleting on length of element - ec = &es->copy(); - for(e=ec; e->variant() == MULT_OP; e=e->lhs()) - e1 = e; - e1->setLhs(new SgValueExp(1)); //replace length of element by 1 - return(ec); -} - -SgExpression *ElemLength(SgSymbol *ar) -{SgExpression *len; -len = TypeLengthExpr(ar->type()->baseType()); //length of one array element -//len = new SgValueExp(TypeSize(ar->type()->baseType())); 14.03.03 - return(len); -} - -SgExpression *CorrectLastOpnd(SgExpression *len, SgSymbol *ar, SgExpression *bounds,SgStatement *stmt) -{SgExpression *elast; - SgValueExp c1(1); - if(!Rank(ar)) - return(len); //error situation - if(!bounds->rhs()){ //step of implicit loop is absent ,by default 1 - elast=&(bounds->lhs()->rhs()->copy() - *Exprn(LowerBound(ar,Rank(ar)-1)) + c1); - //upper_bound_of_implicit_loop - lower_bound_of_last_dimension_of_array + 1 - if (elast->isInteger()) // calculating size if it is possible - elast = new SgValueExp( elast->valueInteger()); - if(len->variant() == MULT_OP) - len->setRhs(elast); //replace last multiplicand of array length - else - len = &(*len * (*elast));//len is the length of array element,it is multiplied by elast - } - else // variant == SEQ,there is a step - Error("Can not calculate array length: %s", ar->identifier(),194,stmt); - if (len->isInteger()) // calculating length if it is possible - len = new SgValueExp( len->valueInteger()); - return(len); -} - -SgSymbol *lastDimInd(SgExpression *el) -{//returns symbol of last subscript expression if it is variable refference - //el - subscript list - SgExpression *last = NULL; - for(; el; el=el->rhs()) //search for last subscript - last = el->lhs(); - if(isSgVarRefExp(last)) //is variable refference - return(last->symbol()); - return(NULL); -} - -int hasAsterOrOneInLastDim(SgSymbol *ar) -{//is dummy argument or array in COMMON declared as a(n,n,*) or a(1) - SgExpression *e; - SgValueExp *ev; - int rank; - rank = Rank(ar); - if(!rank) - return(0); - e=ArrayDimSize(ar,rank); - if(e->variant()==STAR_RANGE) - return(1); - if(rank==1 && (ev = isSgValueExp(e)) && ev->intValue() == 1) - return(1); - return(0); -} - -SgExpression *FirstArrayElement(SgSymbol *ar) -{//generating reference AR(L1,...,Ln), where Li - lower bound of i-th dimension - int i; - SgExpression *esl, *el, *e; - el = NULL; - for (i = Rank(ar); i; i--){ - esl = new SgExprListExp(*Exprn(LowerBound(ar,i-1))); - esl->setRhs(el); - el = esl; - } - e = new SgArrayRefExp(*ar); - e->setLhs(el); - return(e); -} - -SgExpression *FirstElementOfSection(SgExpression *ea) -{SgExpression *el, *ein[MAX_DIMS]; - int i,rank; - SgExpression *esl, *e; - SgSymbol * ar; - ar = ea->symbol(); - rank = Rank(ar); - if(!ea->lhs()) //whole array - return(FirstArrayElement(ar)); - - for(el=ea->lhs(),i=0; el && irhs(),i++) - LowerBoundInTriplet(el->lhs(),ar,i, ein); - el = NULL; - for (i = rank; i; i--){ - esl = new SgExprListExp(*Exprn(ein[i-1])); - esl->setRhs(el); - el = esl; - } - e = new SgArrayRefExp(*ar); - e->setLhs(el); - return(e); -} - -SgExpression *ArrayFieldLast(SgExpression *e) -{ - while(isSgRecordRefExp(e) && RightMostField(e)->type()->variant() != T_ARRAY) - e=e->lhs(); - //e->unparsestdout(); printf("\n"); - return(e); -} - -SgExpression *FirstElementOfField(SgExpression *e_RecRef) -{ - SgExpression *estr = &e_RecRef->copy(); - estr->setRhs(FirstElementOfSection(RightMostField(estr)) ); - return (estr); -} - -int ArraySectionRank(SgExpression *ea) -{SgExpression *el; - int rank; - for(el=ea->lhs(),rank=0; el; el=el->rhs()) - if(el->lhs()->variant() == DDOT) - rank++; - return(rank); -} - -int ContinuousSection(SgExpression *ea) -{ SgExpression *ei; - - ei = ea->lhs(); - if(ei->lhs()->variant() != DDOT) - return(0); - while(ei && isColon(ei->lhs())) - ei = ei->rhs(); - if(!ei) // (:,:,...:) - return(1); - //if(ei->lhs()->variant() == DDOT && ei->lhs()->lhs()->variant() == DDOT) //there is step - // return (0); - ei = ei->rhs(); - while(ei && ei->lhs()->variant() != DDOT) - ei = ei->rhs(); - if(!ei) - return(1); - return(0); - -} - -int isColon(SgExpression *e) -{ - if(!e) - return(0); - if(e->variant() == DDOT && !e->lhs() && !e->rhs()) - return(1); - return(0); - -} - - -int hasEndErrControlSpecifier(SgStatement *stmt, SgExpression *ioEnd[] ) -{ - SgExpression *el, *ee; - SgExpression *e = stmt->expr(1); //control list - ioEnd[0] = ioEnd[1] = ioEnd[2] = NULL; - if(!e) return 0; - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return 0; // IO_control list error - SgKeywordValExp *kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return 0; - if (!strcmp(kwe->value(),"iostat")) - return 0; - else if (!strcmp(kwe->value(),"err")) - ioEnd[0] = el; - else if (!strcmp(kwe->value(),"end")) - ioEnd[1] = el; - //else if (!strcmp(kwe->value(),"eor")) - // ioEnd[2] = el; - else - continue; - } - if(ioEnd[0] || ioEnd[1] || ioEnd[2]) - return 1; - else - return 0; - } - else - return 0; -} - -void ChangeSpecifierByIOSTAT(SgExpression *e) -{ - // e->variant() == SPEC_PAIR - e->setLhs( new SgKeywordValExp("iostat")); - e->setRhs( new SgVarRefExp(IOstatSymbol()) ) ; -} - -void ChangeControlList(SgStatement *stmt, SgExpression *ioEnd[] ) -{ - SgExpression *el; - // replace one of the specifiers with IOSTAT - for(el=stmt->expr(1); el; el=el->rhs()) - if(el==ioEnd[0] || el==ioEnd[1] || el==ioEnd[2]) - { - ChangeSpecifierByIOSTAT(el->lhs()); - break; - } - // delete others - while(el->rhs()) - { - if(el->rhs()==ioEnd[0] || el->rhs()==ioEnd[1] || el->rhs()==ioEnd[2]) - { - el->setRhs(el->rhs()->rhs()); - continue; - } - else - el=el->rhs(); - } - return; -} - -void ReplaceStatementWithEndErrSpecifier(SgStatement *stmt, SgExpression *ioEnd[] ) -{ - int i; - for(i=0; i<3; i++) - if(ioEnd[i]) - doLogIfForIOstat(IOstatSymbol(),ioEnd[i]->lhs(),stmt); - ChangeControlList(stmt,ioEnd); -} - -/*--------------------------------------------------------------------------------------*/ -/* RTS2 interface */ -/*--------------------------------------------------------------------------------------*/ - -static inline int strcmpi(const char *s1, const char *s2) { - size_t l1 = strlen(s1); - size_t l2 = strlen(s2); - size_t min_l = (l1 < l2? l1 : l2); - char c1, c2; - for (size_t i = 0; i < min_l; ++i) { - c1 = tolower(s1[i]); - c2 = tolower(s2[i]); - if (c1 > c2) return 1; - else if (c1 < c2) return -1; - } - if (l1 > min_l) return 1; - else if (l2 > min_l) return -1; - return 0; -} - -const char *stringValuesOfArgs(int argNumber, SgStatement *stmt) { - int variant = stmt->variant(); - - if (variant == OPEN_STAT || variant == CLOSE_STAT) return openCloseArgStrings[argNumber]; - else if (variant == READ_STAT || variant == WRITE_STAT) return readWriteArgStrings[argNumber]; - else if (variant == ENDFILE_STAT || variant == REWIND_STAT || variant == BACKSPACE_STAT) return filePositionArgsStrings[argNumber]; - - return NULL; -}; - -bool checkDefaultStringArg(SgExpression *arg, const char **possible_values, int count, int i, SgStatement *stmt, int error_msg) { - - // if default-string arg isn't a value expression, it can't be checked. - if (!(arg && isSgValueExp(arg))) return true; - SgValueExp *v = isSgValueExp(arg); - - char *string_val = v->stringValue(); - for (int string_arg_number = 0; string_arg_number < count; ++string_arg_number) - if (!strcmpi(string_val, possible_values[string_arg_number])) return true; - - const char *stringArg = stringValuesOfArgs(i, stmt); - if (error_msg) - Error("Wrong value of '%s' argument in IO-statement", stringArg, 454, stmt); - return false; - -} - -bool checkLabelRefArg(SgExpression *arg, SgStatement *stmt, int error_msg) { - if (!arg) return true; - SgLabelRefExp *lbl = isSgLabelRefExp(arg); - if (!lbl) { - if (error_msg) - err("Wrong type of label argument", 450, stmt); - return false; - } - return true; -} - -bool checkIntArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { - if (!arg) return true; - SgValueExp *val = isSgValueExp(arg); - SgVarRefExp *var = isSgVarRefExp(arg); - - if (val && val->variant() == INT_VAL) return true; - if (var && var->symbol()->type()->variant() == T_INT) return true; - if (arg->type()->variant() == T_INT) return true; - - const char *stringArg = stringValuesOfArgs(i, stmt); - if (error_msg) - Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); - return false; - -} - -bool checkStringArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { - if (!arg) return true; - - SgValueExp *val = isSgValueExp(arg); - SgArrayRefExp *arr = isSgArrayRefExp(arg); - if (val && val->variant() == STRING_VAL) return true; - if (arr && arr->symbol()->type()->variant() == T_STRING) return true; - if (arg->type()->variant() == T_STRING) return true; - - const char *stringArg = stringValuesOfArgs(i, stmt); - if (error_msg) - Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); - return false; - -} - -bool checkStringVarArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { - if (!arg) return true; - SgArrayRefExp *arr = isSgArrayRefExp(arg); - if (!arr || arr->symbol()->type()->variant() != T_STRING) { - const char *stringArg = stringValuesOfArgs(i, stmt); - if (error_msg) - Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); - return false; - } - return true; -} - -bool checkVarRefIntArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { - if (!arg) return true; - SgVarRefExp *var = isSgVarRefExp(arg); - - if (!var || !(var->symbol()->type()->variant() == T_INT)) { - const char *stringArg = stringValuesOfArgs(i, stmt); - if (error_msg) - Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); - return false; - } - return true; -} - -bool checkUnitAndNewUnit(SgExpression **ioc, SgStatement *stmt, int error_msg) { - if (ioc[UNIT_IO] && ioc[NEWUNIT_IO]) { - if (error_msg) - err("Wrong combination of arguments: both unit and newunit arguments specified", 452, stmt); - return false; - } - if (!ioc[UNIT_IO] && !ioc[NEWUNIT_IO]) { - if (error_msg) - err("Neither unit nor newunit specified in OPEN statement", 451, stmt); - return false; - } - return true; -} - -// forbids sequential and direct access -bool checkAccessArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { - // stream access is not a default value, so if access it omitted, there's an error - if (!ioc[ACCESS_IO]) { - if (error_msg) - err("Only stream access is allowed in parallel IO", 455, stmt); - return false; - } - SgValueExp *access = isSgValueExp(ioc[ACCESS_IO]); - if (!access) return true; - if (!strcmpi(access->stringValue(), "stream")) return true; - - if (error_msg) - err("Only stream access is allowed in parallel IO", 455, stmt); - return false; -} - -// forbids formatted input -bool checkFormArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { - // if access is stream, default form argument value is formatted - // if access isn't stream, this stmt is already treated as wrong - if (!ioc[FORM_IO]) return true; - SgValueExp *form = isSgValueExp(ioc[FORM_IO]); - if (!form) return true; - if (!strcmpi(form->stringValue(), "unformatted")) return true; - - if (error_msg) - err("Formatted form is not allowed in parallel IO", 455, stmt); - return false; -} - -bool checkFormattedArgs(SgExpression **ioc, SgStatement *stmt, int error_msg) { - /* if form specifier is omitted, it's considered to be unformatted. */ - SgExpression *form = ioc[FORM_IO]; - if (!form || (form && isSgValueExp(form) && !strcmpi(isSgValueExp(form)->stringValue(), "unformatted"))) { - if (ioc[BLANK_IO] || ioc[DECIMAL_IO] || ioc[DELIM_IO] || ioc[ENCODING_IO] || ioc[PAD_IO] || ioc[ROUND_IO] || ioc[SIGN_IO]) - { - if (error_msg) - err("Formatted arguments used in unformatted IO.", 453, stmt); - return false; - } - } - return true; -} - -bool checkStatusArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { - if (!ioc[STATUS_IO]) return true; - if (!isSgValueExp(ioc[STATUS_IO])) return true; - char *string_val = isSgValueExp(ioc[STATUS_IO])->stringValue(); - - if ((!strcmpi(string_val, "new") || !strcmpi(string_val, "replace")) && !ioc[FILE_IO]) { - if (error_msg) - err("Wrong combination of arguments: if status argument is \"new\" or \"replace\", file argument shall be specified", 452, stmt); - return false; - } - if (!strcmpi(string_val, "scratch") && ioc[FILE_IO]) { - if (error_msg) - err("Wrong combination of arguments: if status argument is \"scratch\", file argument shall not be specified", 452, stmt); - return false; - } - return true; - -} - -bool checkDvmModeArg(char const *io_modes_str, SgStatement *stmt, int error_msg) { - - if (!io_modes_str || !io_modes_str[0]) return true; - bool l = false; - bool p = false; - for (int i = 0; *io_modes_str && i < 3; ++i) { - if (io_modes_str[i] == 'l') l = true; - else if (io_modes_str[i] == 'p') p = true; - } - if (l && p) { - if (error_msg) - err("Wrong combination of arguments: local and parallel mode simultaneously used", 452, stmt); - return false; - } - return true; -} - -bool checkNewunitArgument(SgExpression **ioc, SgStatement *stmt, int error_msg) { - /* - If the NEWUNIT= specifier appears in an OPEN statement, either the FILE= specifier shall appear, or the STATUS= specifier shall appear with a value of SCRATCH. The unit identified by a NEWUNIT value shall not be preconnected. - - newunit ==> (file xor status == 'scratch') - - !(newunit ==> (file xor status == 'scratch')) - !(!newunit || (file xor status == 'scratch')) - newunit && !(file xor status == 'scratch') - - a xor b = (!a^b || a^!b) - - newunit && !( (file && status != 'scratch') || (!file && status == 'scratch') ) - newunit && !(file && status != 'scratch') && !(!file && status == 'scratch') - newunit && (!file || status == 'scratch') && (file || status != 'scratch') - - */ - - SgExpression *newunit = ioc[NEWUNIT_IO]; - SgExpression *file = ioc[FILE_IO]; - SgExpression *status = ioc[STATUS_IO]; - - bool status_scratch = (status && !isSgValueExp(status)) || (status && isSgValueExp(status) && !strcmpi(isSgValueExp(status)->stringValue(), "scratch")); - bool status_not_scratch = !status || (status && isSgValueExp(status) && strcmpi(isSgValueExp(status)->stringValue(), "scratch")); - - if (newunit && (!file || status_scratch) && (file || status_not_scratch)) { - if (error_msg) - err("Wrong combination of arguments: newunit argument shall be specified together with either file argument, or with status argument equal to \"scratch\"", 452, stmt); - return false; - } - - return true; - -} - -bool checkFileArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { - // FILE ARG If this specifier is omitted and the unit is not connected to a file, the STATUS= specifier shall be specified with a value of SCRATCH - // !((file && !unit) -> status='scratch') = ((file && !unit) && !status='scratch') - if (isSgVarRefExp(ioc[STATUS_IO])) return true; - if (ioc[FILE_IO] && !ioc[UNIT_IO] && ioc[STATUS_IO] && isSgValueExp(ioc[STATUS_IO]) && strcmpi(isSgValueExp(ioc[STATUS_IO])->stringValue(), "scratch")) { - if (error_msg) - err("Wrong combination of arguments: file argument specified, unit not specified and status isn't \"scratch\"", 452, stmt); - return false; - } - return true; -} - -bool checkReclArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { - - /* - The value of the RECL= specifier shall be positive. - This specifier shall not appear when a file is being connected for stream access. - This specifier shall appear when a file is being connected for direct access. - */ - - SgExpression *recl = ioc[RECL_IO]; - SgExpression *access = ioc[ACCESS_IO]; - - if (isSgVarRefExp(recl)) return true; - if (recl && isSgValueExp(recl)->intValue() <= 0) { - if (error_msg) - err("Wrong value of argument: recl argument should be positive", 455, stmt); - return false; - } - if (isSgVarRefExp(access)) return true; - if (recl && access && isSgValueExp(access) && !(strcmpi(isSgValueExp(access)->stringValue(), "stream"))) { - if (error_msg) - err("Wrong combination of arguments: recl argument used with stream file", 452, stmt); - return false; - } - if (!recl && access && isSgValueExp(access) && !(strcmpi(isSgValueExp(access)->stringValue(), "direct"))) { - if (error_msg) - err("Wrong combination of arguments: recl argument should be used with direct file", 452, stmt); - return false; - } - return true; -} - -bool checkPosArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { - // The connection shall be for sequential or stream access. - // error if is position is specefied, access is scecified and access is direct - SgExpression *access = ioc[ACCESS_IO]; // default is sequantal, so, it's correct if it's omitted - if (isSgValueExp(access)) return true; - if (ioc[POSITION_IO] && access && !strcmpi(isSgValueExp(access)->stringValue(), "direct")) { - if (error_msg) - err("Wrong combination of arguments: position argument may be specified only for direct and sequential access", 452, stmt); - return false; - } - return true; -} - -bool checkArgsClose(SgExpression **ioc, SgStatement *stmt, int error_msg) { - - bool correct = true; - - if (!checkIntArg(ioc[UNIT_IO], UNIT_IO, stmt, error_msg)) correct = false; - if (!checkLabelRefArg(ioc[ERR_IO], stmt, error_msg)) correct = false; - if (!checkVarRefIntArg(ioc[IOSTAT_IO], IOSTAT_IO, stmt, error_msg)) correct = false; - if (!checkStringVarArg(ioc[IOMSG_IO], IOMSG_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[STATUS_IO], STATUS_IO, stmt, error_msg)) correct = false; - - if (!correct) return false; - - const char *pos_val_status[] = { "keep", "delete" }; - if (!checkDefaultStringArg(ioc[STATUS_IO], pos_val_status, 2, STATUS_IO, stmt, error_msg)) correct = false; - return correct; -} - -bool checkArgsOpen(SgExpression **ioc, SgStatement *stmt, int error_msg, char const *io_modes_str) { - - // for every argument we should check if it has a correct type - // then check some special restricitions - // then check that all the arguments have correct values - bool correct = true; - - if (!checkLabelRefArg(ioc[ERR_IO], stmt, error_msg)) correct = false; - - if (!checkIntArg(ioc[UNIT_IO], UNIT_IO, stmt, error_msg)) correct = false; - if (!checkIntArg(ioc[RECL_IO], RECL_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[ACCESS_IO], ACCESS_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[ACTION_IO], ACTION_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[ASYNC_IO], ASYNC_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[BLANK_IO], BLANK_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[DECIMAL_IO], DECIMAL_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[DELIM_IO], DELIM_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[ENCODING_IO], ENCODING_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[FILE_IO], FILE_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[FORM_IO], FORM_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[PAD_IO], PAD_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[POSITION_IO], POSITION_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[ROUND_IO], ROUND_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[SIGN_IO], SIGN_IO, stmt, error_msg)) correct = false; - if (!checkStringArg(ioc[STATUS_IO], STATUS_IO, stmt, error_msg)) correct = false; - - // dvm io mode produces mistake! - if (!checkStringArg(ioc[DVM_MODE_IO], DVM_MODE_IO, stmt, error_msg)) correct = false; - if (!checkVarRefIntArg(ioc[IOSTAT_IO], IOSTAT_IO, stmt, error_msg)) correct = false; - if (!checkVarRefIntArg(ioc[NEWUNIT_IO], NEWUNIT_IO, stmt, error_msg)) correct = false; - if (!checkStringVarArg(ioc[IOMSG_IO], IOMSG_IO, stmt, error_msg)) correct = false; - - if (!correct) return false; - - /* FILE argument may have any value; it shouldn't checked */ - const int string_args[14] = { ACCESS_IO, ACTION_IO, ASYNC_IO, BLANK_IO, DECIMAL_IO, DELIM_IO, ENCODING_IO /*, FILE_IO */, FORM_IO, PAD_IO, POSITION_IO, ROUND_IO, SIGN_IO, STATUS_IO, DVM_MODE_IO }; - - const char *pos_val_access[] = { "sequental", "direct", "stream" }; //3 - const char *pos_val_action[] = { "read", "write", "readwrite"}; //3 - const char *pos_val_async[] = { "yes", "no"}; // 2 - const char *pos_val_blank[] = { "null", "zero"}; // 2 - const char *pos_val_decimal[] = { "comma", "point"}; // 2 - const char *pos_val_delim[] = { "apostrophe", "quote", "none" }; // 3 - const char *pos_val_encoding[] = { "utf-8", "default"}; // 2 - const char *pos_val_form[] = { "formatted", "unformatted"}; // 2 - const char *pos_val_pad[] = { "yes", "no"}; // 2 - const char *pos_val_position[] = { "asis", "rewind", "append"}; // 3 - const char *pos_val_round[] = { "up", "down", "zero", "nearest", "compatible", "processor_defined" }; // 6 - const char *pos_val_sign[] = { "plus", "suppress", "processor_defined" }; // 3 - const char *pos_val_status[] = { "old", "new", "replace", "unknown" }; // 4 - - const char **pos_values[] = {pos_val_access, pos_val_action, pos_val_async, pos_val_blank, pos_val_decimal, pos_val_delim, pos_val_encoding, - pos_val_form, pos_val_pad, pos_val_position, pos_val_round, pos_val_sign, pos_val_status }; - const int arg_count[] = { 3, 3, 2, 2, 2, 3, 2, 2, 2, 3, 6, 3, 4 }; - - for (int i = 0; i < 13; ++i) { - if (!checkDefaultStringArg(ioc[string_args[i]], pos_values[i], arg_count[i], string_args[i], stmt, error_msg)) - correct = false; - } - - if (!checkAccessArg(ioc, stmt, error_msg)) correct = false; - if (!checkFormArg(ioc, stmt, error_msg)) correct = false; - if (!checkFormattedArgs(ioc, stmt, error_msg)) correct = false; - if (!checkPosArg(ioc, stmt, error_msg)) correct = false; - if (!checkUnitAndNewUnit(ioc, stmt, error_msg)) correct = false; - if (!checkNewunitArgument(ioc, stmt, error_msg)) correct = false; - if (!checkReclArg(ioc, stmt, error_msg)) correct = false; - if (!checkStatusArg(ioc, stmt, error_msg)) correct = false; - - if (!checkDvmModeArg(io_modes_str, stmt, error_msg)) correct = false; - return correct; - -} - -bool checkArgsEnfileRewind(SgExpression **ioc, SgStatement *stmt, int error_msg) { - /* - DVMH_API void dvmh_ftn_endfile_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); - DVMH_API void dvmh_ftn_rewind_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); - */ - bool correct = true; - - if (stmt->variant() == BACKSPACE_STAT) { - if (error_msg) - warn("Backspace statement isn't implemented in new IO", 0, stmt); // FIXME: error number - correct = false; - } - - if (!checkIntArg(ioc[UNIT_], UNIT_, stmt, error_msg)) correct = false; - if (!ioc[UNIT_]) { - if (error_msg) - err("Unit argument not specified in file position statement", 456, stmt); - correct = false; - } - if (!checkLabelRefArg(ioc[ERR_], stmt, error_msg)) correct = false; - if (!checkVarRefIntArg(ioc[IOSTAT_],IOSTAT_, stmt, error_msg)) correct = false; - if (!checkStringVarArg(ioc[IOMSG_], IOMSG_, stmt, error_msg)) correct = false; - return correct; - -} - -bool checkArgsRW(SgExpression **ioc, SgStatement *stmt, int error_msg) { - - bool correct = true; - - /* these arguments are forbidden in both new and old IO: blank, delim, decimal, eor, pad, sign */ - if (ioc[BLANK_RW] || ioc[DELIM_RW] || ioc[DECIMAL_RW] || ioc[EOR_RW] || ioc[PAD_RW] || ioc[SIGN_RW] || ioc[ROUND_RW]) - { - if (error_msg) - err("Arguments forbidden in both new and old IO used", 453, stmt); // FIXME: number or error? - correct = false; - } - - /* these arguments are forbidden only in new IO, so only warning should be showed */ - /* these arguments aren't added to argument, so it's unnessecary to care about what will be with them */ - if (ioc[FMT_RW] || ioc[NML_RW] || ioc[ADVANCE_RW] || ioc[REC_RW] || ioc[SIZE_RW]) { - if (error_msg) - warn("Arguments not allowed in new IO used", 453, stmt); // FIXME: number or error? - correct = false; - } - - checkIntArg(ioc[UNIT_RW], UNIT_RW, stmt, error_msg); - - if (stmt->variant() == WRITE_STAT && ioc[END_RW]) { - if (error_msg) - err("Illegal elements in control list", 185, stmt); - correct = false; - } - else if (!checkLabelRefArg(ioc[END_RW], stmt, error_msg)) correct = false; - - if (!checkLabelRefArg(ioc[ERR_RW], stmt, error_msg)) correct = false; - if (!checkVarRefIntArg(ioc[IOSTAT_RW], IOSTAT_RW, stmt, error_msg)) correct = false; - if (!checkStringVarArg(ioc[IOMSG_RW], IOMSG_RW, stmt, error_msg)) correct = false; - if (!checkIntArg(ioc[POS_RW], POS_RW, stmt, error_msg)) correct = false; - - SgExprListExp *items = isSgExprListExp(isSgInputOutputStmt(stmt)->itemList()); - if (items == NULL) { - if (ioc[NML_RW]) { - if (error_msg) - warn("Namelist argument is not supported in new IO", 457, stmt); // FIXME: error number - return false; // further checking is unnecceasry, because there's no item to reading/writing - } - else { - if (error_msg) - err("Subject for reading/writing not specified", 457, stmt); - return false; // further checking is unnecceasry, because there's no item to reading/writing - } - } - - if (stmt->variant() == READ_STAT) { - for (int i = 0; i < items->length(); ++i) { - SgExpression *item = items->elem(i); - if (!(item->variant() == VAR_REF || item->variant() == ARRAY_REF || item->variant() == ARRAY_OP)) { - if (error_msg) - err("Wrong type of argument in IO-statement: reading item is not a variable", 450, stmt); - correct = false; - } - } - } - /* array expressions are not yet implemented in new IO, but are allowed in old IO */ - else { - for (int i = 0; i < items->length(); ++i) { - SgExpression *item = items->elem(i); - // forbidding array expressions such as A+B - // substrings, array elements and sections are still allowed - if (isSgArrayType(item->type()) && !item->symbol()) { - if (error_msg) - warn("Not implemented item type for writing in new IO: array expressions", 458, stmt); - correct = false; - } - } - } - - return correct; -} - -SgStatement *IfConnected(SgStatement *stmt, SgExpression *unit, bool suitableForNewIO) -{ - // generate If construct: - // if (dvmh_ftn_connected ( unit,suitableForNewIO ) then - // CONTINUE - // else - // stmt - // endif - - SgValueExp one(1); - SgStatement *cp = stmt->controlParent(); - cur_st = stmt->lexNext(); - stmt->extractStmt(); - SgStatement *trueBody = new SgStatement(CONT_STAT); //CONTINUE statement - SgStatement *falseBody = stmt; - SgExpression *failIfYes = suitableForNewIO ? ConstRef(0) : ConstRef(1); // ???????? - - SgIfStmt *ifst = new SgIfStmt(SgEqOp(*DvmhConnected(DvmType_Ref(unit), failIfYes), one), *trueBody, *falseBody); - - cur_st->insertStmtBefore(*ifst, *cp); - - cur_st = trueBody; - - if (stmt-> hasLabel()) { // IO statement has label - // the label of IO statement is transfered on IF statement - BIF_LABEL(stmt->thebif) = NULL; - ifst->setLabel(*stmt->label()); - } - char *cmnt=stmt-> comments(); - if (cmnt) { // IO statement has preceeding comments - // the comment of IO statement is transfered on IF statement - BIF_CMNT(stmt->thebif) = NULL; - ifst -> setComments(cmnt); - } - - return ifst; -} - -int control_list_open_new(SgExpression *e, SgExpression *ioc[]) -// analizes control list (e) for OPEN -// and sets on ioc[] -{ SgKeywordValExp *kwe; - SgExpression *ee,*el; - int i; - for(i=NUMB__CL; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR) { - kwe = isSgKeywordValExp(e->lhs()); - if (!kwe || !strcmp(kwe->value(), "unit")) - ioc[UNIT_IO] = e->rhs(); - else if (!strcmp(kwe->value(), "newunit")) - ioc[NEWUNIT_IO] = e->rhs(); - else return 0; - - return(1); - } - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return(0); // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"access")) - ioc[ACCESS_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"action")) - ioc[ACTION_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"async")) - ioc[ASYNC_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"blank")) - ioc[BLANK_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"decimal")) - ioc[DECIMAL_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"delim")) - ioc[DELIM_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"encoding")) - ioc[ENCODING_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"file")) - ioc[FILE_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"form")) - ioc[FORM_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"iostat")) - ioc[IOSTAT_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"iomsg")) - ioc[IOMSG_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"newunit")) - ioc[NEWUNIT_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"pad")) - ioc[PAD_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"position")) - ioc[POSITION_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"recl")) - ioc[RECL_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"round")) - ioc[ROUND_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"sign")) - ioc[SIGN_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"status")) - ioc[STATUS_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"err")) - ioc[ERR_IO] = ee->rhs(); - else - return(0); - } - return(1); - } - else - return(0); -} - -int control_list_close_new(SgExpression *e, SgExpression *ioc[]) -// analizes control list (e) for CLOSE -// and sets on ioc[] -{ SgKeywordValExp *kwe; - SgExpression *ee,*el; - int i; - for(i=NUMB__CL; i; i--) - ioc[i-1] = NULL; - - if(e->variant() == SPEC_PAIR) { - kwe = isSgKeywordValExp(e->lhs()); - if (!kwe || !strcmp(kwe->value(), "unit")) - ioc[UNIT_IO] = e->rhs(); - else return 0; - return(1); - } - if(e->variant() == EXPR_LIST){ - for(el=e; el; el = el->rhs()) { - ee = el->lhs(); - if(ee->variant() != SPEC_PAIR) - return(0); // IO_control list error - kwe = isSgKeywordValExp(ee->lhs()); - if(!kwe) - return(0); - if (!strcmp(kwe->value(),"unit")) - ioc[UNIT_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"iostat")) - ioc[IOSTAT_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"iomsg")) - ioc[IOMSG_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"err")) - ioc[ERR_IO] = ee->rhs(); - else if (!strcmp(kwe->value(),"status")) - ioc[STATUS_IO] = ee->rhs(); - else - return(0); - } - if (!ioc[UNIT_IO]) return(0); - return(1); - } - else - return(0); - -} - - -//enum class ArgType : int { NUMBER = 0, STRING = 1, VAR = 2, STRINGVAR = 3 }; -enum { NUMBER_ARG, STRING_ARG, VAR_ARG, STRING_VAR_ARG }; - -int addArgToCall(SgExpression *ioc[], int type, SgCallStmt *call, int arg) -{ - if (!ioc[arg]) - call->addArg(*ConstRef(0)); - else - switch (type) { - case NUMBER_ARG: - call->addArg(*DvmType_Ref(ioc[arg])); - break; - case STRING_ARG: - call->addArg(*DvmhString(ioc[arg])); - break; - case VAR_ARG: - call->addArg(*DvmhVariable(ioc[arg])); - break; - case STRING_VAR_ARG: - call->addArg(*DvmhStringVariable(ioc[arg])); - break; - default: - return 1; - } - return 0; -} - -int addArgToCalls(SgExpression *ioc[], int type, SgCallStmt **calls, int ncalls, int arg) { - - if (!ioc[arg]) - for (int i = 0; i < ncalls; ++i) - calls[i]->addArg(*ConstRef(0)); - else - switch (type) { - case NUMBER_ARG: - for (int i = 0; i < ncalls; ++i) - calls[i]->addArg(*DvmType_Ref(ioc[arg])); - break; - case STRING_ARG: - for (int i = 0; i < ncalls; ++i) - calls[i]->addArg(*DvmhString(ioc[arg])); - break; - case VAR_ARG: - for (int i = 0; i < ncalls; ++i) - calls[i]->addArg(*DvmhVariable(ioc[arg])); - break; - case STRING_VAR_ARG: - for (int i = 0; i < ncalls; ++i) - calls[i]->addArg(*DvmhStringVariable(ioc[arg])); - break; - default: - return 1; - } - return 0; - -} - -/* for inserting assignment dvm000(index) = 0 after cur_st. insertation is made only if cond = true */ -void OccupyDvm000Elem(SgExpression *cond, int index) { - - if (cond) { - SgValueExp *zero = new SgValueExp(0); - SgStatement *ass = new SgAssignStmt (*DVM000(index), *zero); - - cur_st->lastNodeOfStmt()->insertStmtAfter(*ass, *cur_st->controlParent()); - cur_st = ass; - } -} - -/* for inserting if statement : if (dvm000(index) .ne. 0 goto ... */ -void InsertGotoStmt(SgExpression *err, int index) { - - if (err) { - SgValueExp *zero = new SgValueExp(0); - SgGotoStmt *gotostmt = new SgGotoStmt(*isSgLabelRefExp(err)->label()); - SgIfStmt *ifst = new SgIfStmt(SgNeqOp(*DVM000(index), *zero), *gotostmt); - - cur_st->lastNodeOfStmt()->insertStmtAfter(*ifst, *cur_st->controlParent()); - cur_st = ifst; - - } -} - -void addRefArgToCall(SgExpression *ref_arg, SgCallStmt *call) { - - if (ref_arg) call->addArg(*DvmhVariable(DVM000(ndvm++))); - else call->addArg(*ConstRef(0)); - return; -} - -void addRefArgToCalls(SgExpression *err, SgCallStmt **calls, int ncalls, int *indeces) { - for (int i = 0; i < ncalls; ++i) { - indeces[i] = ndvm; - addRefArgToCall(err, calls[i]); - } -} - - -void Dvmh_Close(SgExpression *ioc[]) { - - /* - DVMH_API void dvmh_ftn_close_( - const DvmType *pUnit, - const VarRef *pErrFlagRef, - const VarRef *pIOStatRef, - const StringVarRef *pIOMsg, - const StringRef *pStatus); - */ - SgStatement *continue_st = cur_st; //true body of IF construct - fmask[FTN_CLOSE] = 2; - SgCallStmt *close_call = new SgCallStmt(*fdvm[FTN_CLOSE]); - - int index_before = ndvm; - - addArgToCall(ioc, NUMBER_ARG, close_call, UNIT_IO); - int index_err = ndvm; - addRefArgToCall(ioc[ERR_IO], close_call); - int index_iostat = ndvm; - addRefArgToCall(ioc[IOSTAT_IO], close_call); - addArgToCall(ioc, STRING_VAR_ARG, close_call, IOMSG_IO); - addArgToCall(ioc, STRING_ARG, close_call, STATUS_IO); - - OccupyDvm000Elem(ioc[ERR_IO], index_err); - OccupyDvm000Elem(ioc[IOSTAT_IO], index_iostat); - //InsertNewStatementAfter(close_call, cur_st, stmt->controlParent()); - doCallAfter(close_call); - if (ioc[IOSTAT_IO]) doAssignTo_After(ioc[IOSTAT_IO], DVM000(index_iostat)); - InsertGotoStmt(ioc[ERR_IO], index_err); - continue_st->extractStmt(); - SET_DVM(index_before); - - return; -} - -void Dvmh_Open(SgExpression *ioc[], const char *io_modes_str) -{ - /* - DVMH_API void dvmh_ftn_open_( - const DvmType *pUnit, - const StringRef *pAccess, - const StringRef *pAction, - const StringRef *pAsync, - const StringRef *pBlank, - const StringRef *pDecimal, - const StringRef *pDelim, - const StringRef *pEncoding, - const StringRef *pFile, - const StringRef *pForm, - const VarRef *pErrFlagRef, - const VarRef *pIOStatRef, - const StringVarRef *pIOMsg, - const VarRef *pNewUnitRef, - const StringRef *pPad, - const StringRef *pPosition, - const DvmType *pRecl, - const StringRef *pRound, - const StringRef *pSign, - const StringRef *pStatus, - const StringRef *pDvmMode); */ - - SgStatement *continue_st = cur_st; //true body of IF construct - if (io_modes_str) ioc[DVM_MODE_IO] = new SgValueExp(io_modes_str); - - int index_before = ndvm; - - fmask[FTN_OPEN] = 2; - SgCallStmt *open_call = new SgCallStmt(*fdvm[FTN_OPEN]); - - addArgToCall(ioc, NUMBER_ARG, open_call, UNIT_IO); - addArgToCall(ioc, STRING_ARG, open_call, ACCESS_IO); - addArgToCall(ioc, STRING_ARG, open_call, ACTION_IO); - addArgToCall(ioc, STRING_ARG, open_call, ASYNC_IO); - addArgToCall(ioc, STRING_ARG, open_call, BLANK_IO); - addArgToCall(ioc, STRING_ARG, open_call, DECIMAL_IO); - addArgToCall(ioc, STRING_ARG, open_call, DELIM_IO); - addArgToCall(ioc, STRING_ARG, open_call, ENCODING_IO); - addArgToCall(ioc, STRING_ARG, open_call, FILE_IO); - addArgToCall(ioc, STRING_ARG, open_call, FORM_IO); - - int index_err = ndvm; - addRefArgToCall(ioc[ERR_IO], open_call); - int index_iostat = ndvm; - addRefArgToCall(ioc[IOSTAT_IO], open_call); - addArgToCall(ioc, STRING_VAR_ARG, open_call, IOMSG_IO); - int index_newunit = ndvm; - addRefArgToCall(ioc[NEWUNIT_IO], open_call); - - addArgToCall(ioc, STRING_ARG, open_call, PAD_IO); - addArgToCall(ioc, STRING_ARG, open_call, POSITION_IO); - addArgToCall(ioc, NUMBER_ARG, open_call, RECL_IO); - addArgToCall(ioc, STRING_ARG, open_call, ROUND_IO); - addArgToCall(ioc, STRING_ARG, open_call, SIGN_IO); - addArgToCall(ioc, STRING_ARG, open_call, STATUS_IO); - - addArgToCall(ioc, STRING_ARG, open_call, DVM_MODE_IO); - - OccupyDvm000Elem(ioc[ERR_IO], index_err); - OccupyDvm000Elem(ioc[IOSTAT_IO], index_iostat); - OccupyDvm000Elem(ioc[NEWUNIT_IO], index_newunit); - doCallAfter(open_call); - if (ioc[IOSTAT_IO]) doAssignTo_After(ioc[IOSTAT_IO], DVM000(index_iostat)); - if (ioc[NEWUNIT_IO]) doAssignTo_After(ioc[NEWUNIT_IO], DVM000(index_newunit)); - InsertGotoStmt(ioc[ERR_IO], index_err); - - continue_st->extractStmt(); - - SET_DVM(index_before); - - return; - -} - -void Dvmh_FilePosition(SgExpression *ioc[], int variant) { - - /* - DVMH_API void dvmh_ftn_endfile_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); - DVMH_API void dvmh_ftn_rewind_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); - */ - - SgStatement *continue_st = cur_st; //true body of IF construct - - SgCallStmt *call; - if (variant == ENDFILE_STAT) { - call = new SgCallStmt(*fdvm[FTN_ENDFILE]); - fmask[FTN_ENDFILE] = 2; - } - else { - call = new SgCallStmt(*fdvm[FTN_REWIND]); - fmask[FTN_REWIND] = 2; - } - - int index_before = ndvm; - - addArgToCall(ioc, NUMBER_ARG, call, UNIT_); - int index_iostat = ndvm; - addRefArgToCall(ioc[IOSTAT_], call); - int index_err = ndvm; - - addRefArgToCall(ioc[ERR_], call); - addArgToCall(ioc, STRING_VAR_ARG, call, IOMSG_); - - OccupyDvm000Elem(ioc[ERR_], index_err); - OccupyDvm000Elem(ioc[IOSTAT_], index_iostat); - doCallAfter(call); - if (ioc[IOSTAT_]) doAssignTo_After(ioc[IOSTAT_], DVM000(index_iostat)); - InsertGotoStmt(ioc[ERR_], index_err); - - continue_st->extractStmt(); - - SET_DVM(index_before); - - return; - -} - -SgExpression *ArrNoSubs(SgExpression *expr) { - SgArrayRefExp *arr = isSgArrayRefExp(expr); - // second part of conjunction is for excluding characters, that also are ArrayRefExp - if (arr && isSgArrayType(expr->symbol()->type())) - return new SgArrayRefExp(*arr->symbol()); - return expr; -} - -void Dvmh_ReadWrite(SgExpression **ioc, SgStatement *stmt) { - - /* - DVMH_API void dvmh_ftn_read_unf_( - const DvmType *pUnit, - const VarRef *pEndFlagRef, - const VarRef *pErrFlagRef, - const VarRef *pIOStatRef, - const StringVarRef *pIOMsg, - const DvmType *pPos, - const DvmType dvmDesc[], - const DvmType *pSpecifiedFlag, - ...); - */ - - /* dvmh_ftn_write_unf() different from read by the absence of the flag pEnd. - DVMH_API void dvmh_ftn_write_unf_( - const DvmType *pUnit, - const VarRef *pErrFlagRef, - const VarRef *pIOStatRef, - const StringVarRef *pIOMsg, - const DvmType *pPos, - const DvmType dvmDesc[], - const DvmType *pSpecifiedRank, ...); - */ - SgStatement *continue_st = cur_st; //true body of IF construct - - SgInputOutputStmt *io_stmt = isSgInputOutputStmt(stmt); - SgExprListExp *items = isSgExprListExp(io_stmt->itemList()); - - if (!items) return; // empty items case. for example, when namelist is used - int ncalls = items->length(); - SgCallStmt *calls[1000]; //ncalls - - if (stmt->variant() == READ_STAT) { - for (int i = 0; i < ncalls; ++i) - calls[i] = new SgCallStmt(*fdvm[FTN_READ]); - fmask[FTN_READ] = 2; - } - else { - for (int i = 0; i < ncalls; ++i) - calls[i] = new SgCallStmt(*fdvm[FTN_WRITE]); - fmask[FTN_WRITE] = 2; - } - - int index_before = ndvm; - - addArgToCalls(ioc, NUMBER_ARG, calls, ncalls, UNIT_RW); - - int *i_endf = new int[ncalls]; - int *i_errf = new int[ncalls]; - - if (stmt->variant() == READ_STAT) - addRefArgToCalls(ioc[END_RW], calls, ncalls, i_endf); - addRefArgToCalls(ioc[ERR_RW], calls, ncalls, i_errf); - - int *i_iostat = new int[ncalls]; - addRefArgToCalls(ioc[IOSTAT_RW], calls, ncalls, i_iostat); - - addArgToCalls(ioc, STRING_VAR_ARG, calls, ncalls, IOMSG_RW); - addArgToCalls(ioc, NUMBER_ARG, calls, ncalls, POS_RW); - - /* - inserting arguments, describing variables and array - for each arument: - 1) if it is dvm-array, adding sections - 2) if it is not-dvm array, insert data_enter before and data_exit after and adding sections - 3) if it is scalar expression, insert only data_enter and data_exit - */ - - for (int i_call = 0; i_call < ncalls; ++i_call) { - SgExpression *item = items->elem(i_call); - - // Data_enter inserting and adding VarGenHeader argument for everything, that is not a dvm-array - if (!(isSgArrayRefExp(item) && HEADER(item->symbol()))) { - doCallAfter(DataEnter(ArrNoSubs(item), ConstRef_F95(0))); - calls[i_call]->addArg(*VarGenHeader(ArrNoSubs(item))); - } - - // array reference - SgArrayRefExp *arr = isSgArrayRefExp(item); - if (arr) { - if (arr && HEADER(arr->symbol())) { - // it should be register_array(arr(1)), not register_array(arr) - SgExprListExp *new_subs = new SgExprListExp(*new SgValueExp(1)); - SgArrayRefExp *new_array_ref = new SgArrayRefExp(*arr->symbol(), *new_subs); - calls[i_call]->addArg(*Register_Array_H2(new_array_ref)); - } - - if (arr->numberOfSubscripts()) { - int nsubs = arr->numberOfSubscripts(); - calls[i_call]->addArg(*ConstRef(nsubs)); - for (int i = nsubs-1; i >= 0; --i) { - SgExpression *lbound; - SgExpression *ubound; - SgSubscriptExp *sub; - // both bounds specified - if ((sub = isSgSubscriptExp(arr->subscript(i)))) { - lbound = sub->lbound(); - ubound = sub->ubound(); - lbound = (lbound? DvmType_Ref(lbound): ConstRef_F95(-2147483648)); - ubound = (ubound? DvmType_Ref(ubound): ConstRef_F95(-2147483648)); - } - // only upper bound specified - else { - lbound = ubound = DvmType_Ref(arr->subscript(i)); - } - calls[i_call]->addArg(*lbound); - calls[i_call]->addArg(*ubound); - } - } - else // array doesn't have subscript or it is an array expression - calls[i_call]->addArg(*ConstRef(0)); - } - else // it isn't array, anyhow it should be specified that there's no sections - calls[i_call]->addArg(*ConstRef(0)); - } - - /* inserting function calling and goto statements in case of error occurring */ - for (int i_call = 0; i_call < ncalls; ++i_call) { - OccupyDvm000Elem(ioc[END_RW], i_endf[i_call]); - OccupyDvm000Elem(ioc[ERR_RW], i_errf[i_call]); - OccupyDvm000Elem(ioc[IOSTAT_RW], i_iostat[i_call]); - doCallAfter(calls[i_call]); - if (ioc[IOSTAT_RW]) doAssignTo_After(ioc[IOSTAT_RW], DVM000(i_iostat[i_call])); - InsertGotoStmt(ioc[END_RW], i_endf[i_call]); - InsertGotoStmt(ioc[ERR_RW], i_errf[i_call]); - } - - /* for every not-dvm-array item, data_exit should be inserted */ - SgExpression *item; - for (int i_call = 0; i_call < ncalls; ++i_call) { - if (items) item = items->elem(i_call); - else item = ConstRef(0); - if (!(isSgArrayRefExp(item) && HEADER(item->symbol()))) { - SgStatement *data_exit = DataExit(ArrNoSubs(ArrNoSubs(item)), 1); - cur_st->lastNodeOfStmt()->insertStmtAfter(*data_exit, *cur_st->controlParent()); - cur_st = data_exit; - } - } - - continue_st->extractStmt(); - - SET_DVM(index_before); - - return; -} - - diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/makefile.uni b/projects/dvm_svn/fdvm/trunk/fdvm/makefile.uni deleted file mode 100644 index 16a8d26..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/makefile.uni +++ /dev/null @@ -1,151 +0,0 @@ -#echo####################################################################### -# Makefile for Fortran DVM back-end -# -#echo####################################################################### - -# dvm/fdvm/fdvm/makefile.uni - -SAGEROOT = ../Sage -LIBDIR = ../lib -BINDIR = ../../bin -LIBINCLUDE = $(SAGEROOT)/lib/include -HINCLUDE = $(SAGEROOT)/h -DVMINCLUDE = ../include -EXECUTABLES = f_dvm - -LOADER = $(LINKER) - -INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(DVMINCLUDE) - -CFLAGS = -c $(INCL) -Wall -LDFLAGS = - -LIBS = $(LIBDIR)/libSage++.a $(LIBDIR)/libsage.a $(LIBDIR)/libdb.a -OBJS = acc.o \ - acc_across.o \ - acc_across_analyzer.o \ - acc_analyzer.o \ - acc_data.o \ - acc_f2c.o \ - acc_f2c_handlers.o \ - acc_rtc.o \ - acc_utilities.o \ - aks_analyzeLoops.o \ - aks_structs.o \ - calls.o \ - checkpoint.o \ - debug.o \ - dvm.o \ - funcall.o \ - help.o \ - hpf.o \ - io.o \ - omp.o \ - ompdebug.o \ - parloop.o \ - stmt.o - -$(BINDIR)/$(EXECUTABLES): $(OBJS) - $(LOADER) $(LDFLAGS) -o $(BINDIR)/$(EXECUTABLES) $(OBJS) $(LIBS) - -all: $(BINDIR)/$(EXECUTABLES) - @echo "****** COMPILING $(EXECUTABLES) DONE ******" - -clean: - rm -f $(OBJS) -cleanall: - rm -f $(OBJS) - -## TODO: create correct dependences -############################# dependences ############################ -acc.o: acc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc.cpp - -acc_across.o: acc_across.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h - $(CXX) $(CFLAGS) acc_across.cpp - -acc_across_analyzer.o: acc_across_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_across_analyzer.h - $(CXX) $(CFLAGS) acc_across_analyzer.cpp - -acc_analyzer.o: acc_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_analyzer.h - $(CXX) $(CFLAGS) acc_analyzer.cpp - -acc_data.o: acc_data.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_data.cpp - -acc_f2c.o: acc_f2c.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_f2c.cpp - -acc_f2c_handlers.o: acc_f2c_handlers.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_f2c_handlers.cpp - -acc_rtc.o: acc_rtc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_data.h - $(CXX) $(CFLAGS) acc_rtc.cpp - -acc_utilities.o: acc_utilities.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) acc_utilities.cpp - -aks_analyzeLoops.o: aks_analyzeLoops.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h - $(CXX) $(CFLAGS) aks_analyzeLoops.cpp - -aks_structs.o: aks_structs.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h - $(CXX) $(CFLAGS) aks_structs.cpp - -calls.o: calls.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) calls.cpp - -checkpoint.o: checkpoint.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) checkpoint.cpp - -debug.o: debug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) debug.cpp - -dvm.o: dvm.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) dvm.cpp - -funcall.o: funcall.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) funcall.cpp - -help.o: help.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) help.cpp - -hpf.o: hpf.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) hpf.cpp - -io.o: io.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) io.cpp - -omp.o: omp.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) omp.cpp - -ompdebug.o: ompdebug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) ompdebug.cpp - -parloop.o: parloop.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) parloop.cpp - -stmt.o: stmt.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ - $(DVMINCLUDE)/dvm.h - $(CXX) $(CFLAGS) stmt.cpp diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/makefile.win b/projects/dvm_svn/fdvm/trunk/fdvm/makefile.win deleted file mode 100644 index 0bfb732..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/makefile.win +++ /dev/null @@ -1,148 +0,0 @@ -####################################################################### -## Copyright (C) 1999 ## -## Keldysh Institute of Appllied Mathematics ## -####################################################################### - -# dvm/fdvm/fdvm/makefile.win - -OUTDIR = ..\obj -BINDIR = ..\..\bin -LIBDIR = ..\lib -SAGEROOT =..\Sage - -LIBINCLUDE = $(SAGEROOT)\lib\include -HINCLUDE = $(SAGEROOT)\h -FDVMINCL = ..\include -EXECUTABLES = f_dvm - -INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(FDVMINCL) - - -# -w don't issue warning now. -#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ -# /Fp"$(OUTDIR)/f_dvm.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c -CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ - /Fp"$(OUTDIR)/f_dvm.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c - -.cpp{$(OUTDIR)/}.obj: - $(CXX) $(CFLAGS) $< - -LINK=$(LINKER) - -LINK_FLAGS=/nologo /subsystem:console /incremental:no\ - /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" - -LINK_FLAGS=/nologo /subsystem:console /incremental:no\ - /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" - -OBJS = $(OUTDIR)/acc.obj \ - $(OUTDIR)/acc_across.obj \ - $(OUTDIR)/acc_across_analyzer.obj \ - $(OUTDIR)/acc_analyzer.obj \ - $(OUTDIR)/acc_data.obj \ - $(OUTDIR)/acc_f2c.obj \ - $(OUTDIR)/acc_f2c_handlers.obj \ - $(OUTDIR)/acc_rtc.obj \ - $(OUTDIR)/acc_utilities.obj \ - $(OUTDIR)/aks_analyzeLoops.obj \ - $(OUTDIR)/aks_structs.obj \ - $(OUTDIR)/calls.obj \ - $(OUTDIR)/checkpoint.obj \ - $(OUTDIR)/debug.obj \ - $(OUTDIR)/dvm.obj \ - $(OUTDIR)/funcall.obj \ - $(OUTDIR)/help.obj \ - $(OUTDIR)/hpf.obj \ - $(OUTDIR)/io.obj \ - $(OUTDIR)/omp.obj \ - $(OUTDIR)/ompdebug.obj \ - $(OUTDIR)/parloop.obj \ - $(OUTDIR)/stmt.obj - -LIBS = $(LIBDIR)/libSage++.lib $(LIBDIR)\libsage.lib $(LIBDIR)\libdb.lib - - -$(BINDIR)/$(EXECUTABLES).exe: $(OBJS) - $(LINK) @<< - $(LINK_FLAGS) $(OBJS) $(LIBS) -<< - -all: $(BINDIR)/$(EXECUTABLES).exe - @echo "*** COMPILING EXECUTABLE $(EXECUTABLES) DONE" - - -clean: - -cleanall: - - -# *********************************************************** -## TODO: create correct dependences -acc.obj: acc.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -acc_across.obj: acc_across.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -acc_across_analyzer.obj: acc_across_analyzer.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h $(FDVMINCL)/acc_across_analyzer.h - -acc_analyzer.obj: acc_analyzer.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h $(FDVMINCL)/acc_analyzer.h - -acc_data.obj: acc_data.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -acc_f2c.obj: acc_f2c.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -acc_f2c_handlers.obj: acc_f2c_handlers.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -acc_rtc.obj: acc_rtc.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -acc_utilities.obj: acc_utilities.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -aks_analyzeLoops.obj: aks_analyzeLoops.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h $(FDVMINCL)/aks_structs.h - -aks_structs.obj: aks_structs.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h $(FDVMINCL)/aks_structs.h - -calls.obj: calls.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -checkpoint.obj: checkpoint.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -debug.obj: debug.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -dvm.obj: dvm.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -funcall.obj: funcall.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -help.obj: help.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -hpf.obj: hpf.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -io.obj: io.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -omp.obj: omp.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -ompdebug.obj: ompdebug.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -parloop.obj: parloop.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h - -stmt.obj: stmt.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ - $(FDVMINCL)/dvm.h diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/omp.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/omp.cpp deleted file mode 100644 index b69aa72..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/omp.cpp +++ /dev/null @@ -1,879 +0,0 @@ -#include "dvm.h" -void AddSharedClauseForDVMVariables (SgStatement *first, SgStatement *last); - -int IsPositiveDoStep(SgExpression *step) { - int s; - if (step == NULL) return (1); - if(step->isInteger()) - s=step->valueInteger(); - else - s = 0; - if(s >= 0) - return(1); - else - return(0); -} - - -int isOmpDir (SgStatement * st) { - if ((BIF_CODE(st->thebif)>800) && (BIF_CODE(st->thebif)<847)) { - return 1; - } - return 0; -} -inline int isDvmDir (SgStatement * st) { - switch (BIF_CODE(st->thebif)) { - case DVM_INTERVAL_DIR: - case DVM_ENDINTERVAL_DIR: - case DVM_DEBUG_DIR: - case DVM_ENDDEBUG_DIR: - case DVM_TRACEON_DIR: - case DVM_TRACEOFF_DIR: - case DVM_PARALLEL_ON_DIR: - case DVM_SHADOW_START_DIR: - case DVM_SHADOW_GROUP_DIR: - case DVM_SHADOW_WAIT_DIR: - case DVM_REDUCTION_START_DIR: - case DVM_REDUCTION_GROUP_DIR: - case DVM_REDUCTION_WAIT_DIR: - case DVM_DYNAMIC_DIR: - case DVM_ALIGN_DIR: - case DVM_REALIGN_DIR: - case DVM_REALIGN_NEW_DIR: - case DVM_REMOTE_ACCESS_DIR: - case HPF_INDEPENDENT_DIR: - case DVM_SHADOW_DIR: - case DVM_NEW_VALUE_DIR: - case DVM_VAR_DECL: - case DVM_POINTER_DIR: - case HPF_TEMPLATE_STAT: - case HPF_ALIGN_STAT: - case HPF_PROCESSORS_STAT: - case DVM_REDISTRIBUTE_DIR: - case DVM_TASK_REGION_DIR: - case DVM_END_TASK_REGION_DIR: - case DVM_ON_DIR: - case DVM_END_ON_DIR: - case DVM_TASK_DIR: - case DVM_MAP_DIR: - case DVM_PARALLEL_TASK_DIR: - case DVM_INHERIT_DIR: - case DVM_INDIRECT_GROUP_DIR: - case DVM_INDIRECT_ACCESS_DIR: - case DVM_REMOTE_GROUP_DIR: - case DVM_RESET_DIR: - case DVM_PREFETCH_DIR: - case DVM_OWN_DIR: - case DVM_HEAP_DIR: - case DVM_ASYNCID_DIR: - case DVM_ASYNCHRONOUS_DIR: - case DVM_ENDASYNCHRONOUS_DIR: - case DVM_ASYNCWAIT_DIR: - case DVM_F90_DIR: - case DVM_BARRIER_DIR: - case DVM_CONSISTENT_GROUP_DIR: - case DVM_CONSISTENT_START_DIR: - case DVM_CONSISTENT_WAIT_DIR: - case DVM_CONSISTENT_DIR: - case DVM_CHECK_DIR: return 1; break; - } - return 0; -} - -int HideOmpStmt (SgStatement * st) { - int res=0; - SgStatement *prev = st->lexPrev (); - SgStatement *next =st->lexNext (); - while (prev && (isDvmDir(prev) || isOmpDir(prev))) prev = prev -> lexPrev (); - while (next && (isDvmDir(next) || isOmpDir(next))) next = next -> lexNext (); - if (prev && next) { - int length=st->numberOfAttributes(); - int i=0; - SgAttribute *sa=NULL; - res=1; - switch (st->variant ()) { - case OMP_END_PARALLEL_DO_DIR: - case OMP_END_DO_DIR: { - for (i=0; igetAttribute(i); - prev->addAttribute(sa->getAttributeType(),sa->getAttributeData(),sa->getAttributeSize()); - } - for (i=length; i>0; i--) { - st->deleteAttribute(i); - } - prev->addAttribute(OMP_STMT_AFTER, (void*) st->copyPtr (), sizeof(SgStatement *)); - break; - } - default: { - for (i=0; igetAttribute(i); - next->addAttribute(sa->getAttributeType(),sa->getAttributeData(),sa->getAttributeSize()); - } - for (i=length; i>0; i--) { - st->deleteAttribute(i); - } - next->addAttribute(OMP_STMT_BEFORE, (void*) st->copyPtr (), sizeof(SgStatement *)); - break; - } - } - } - return res; -} - -void AddAttributeOmp (SgStatement *stmt) { - SgStatement *last; - if (!stmt) return; - last = stmt->lastNodeOfStmt ()->lexNext (); - for (SgStatement *st=stmt;st && (st != last); st=st->lexNext ()) { - st->addAttribute (OMP_MARK); - } -} - -void DelAttributeFromStmt (int type, SgStatement *st) { -int length=st->numberOfAttributes(); -for (int i=0; igetAttribute(i); - if (sa->getAttributeType() == type) { - st->deleteAttribute(i); - break; - } -} -} - -int AddOmpStmt (SgStatement * st) { - int res = 0; - int length=st->numberOfAttributes(OMP_STMT_BEFORE); - int i=0; - SgStatement *stmt = NULL; - SgStatement *last = st->lastNodeOfStmt (); - for (i=0;igetAttribute(i,OMP_STMT_BEFORE); - stmt = ((SgStatement *)sa->getAttributeData()); - AddAttributeOmp (stmt); - if ((st->variant () == FOR_NODE) && (stmt->variant () == ASSIGN_STAT)) { - SgExpression *expr = stmt->expr (1); - if (expr->variant () == FUNC_CALL) { - if (!strcmp(expr->symbol()->identifier(),"min")) { - SgExprListExp *exp = isSgExprListExp(expr->lhs ()); - if (exp) { - exp = isSgExprListExp(exp->rhs ()); - if (exp) { - SgForStmt *forst = isSgForStmt (st); - if (forst) { - //TO DO - if ((forst->step () != NULL)&&(forst->step ()->isInteger ())) { - if (forst->step ()->valueInteger ()>0) - exp->setValue (*forst->end () - *forst->start()); - else - exp->setValue (*forst->start () - *forst->end()); - } else if (forst->step () == NULL) { - exp->setValue (*forst->end () - *forst->start()); - } else { - SgFunctionCallExp *func = new SgFunctionCallExp(*new SgVariableSymb("abs")); - func->addArg(*forst->end () - *forst->start()); - exp->setValue (*func); - } - } - } - } - } - } - } - st->insertStmtBefore (*stmt); - } - length=st->numberOfAttributes(OMP_STMT_AFTER); - for (i=length; i>0; i--) { - SgAttribute *sa=st->getAttribute(i-1,OMP_STMT_AFTER); - stmt = ((SgStatement *)sa->getAttributeData()); - AddAttributeOmp (stmt); - last->insertStmtAfter (*stmt); - res++; - } - return res; -} - -SgStatement * GetLexNextIgnoreOMP(SgStatement *st) { - SgStatement *ret=st->lexNext (); - if (ret && isOmpDir (ret)) { - return GetLexNextIgnoreOMP (ret); - } - return ret; -} - -int isOmpGetNumThreads(SgExpression *e) -{ - int replace = 0; - if (e == NULL) return 0; - if ((e->variant()==FUNC_CALL) && !strcmp(e->symbol()->identifier(),"omp_get_num_threads")) { - NODE_CODE(e->thellnd)=INT_VAL; - NODE_TYPE(e->thellnd) = GetAtomicType(T_INT); - NODE_INT_CST_LOW (e->thellnd) = 1; - replace = 1; - } - if((e->variant()==ADD_OP) || (e->variant()==SUBT_OP)){ - replace = isOmpGetNumThreads (e->rhs()); - if (!replace) replace = isOmpGetNumThreads (e->lhs()); - } - return replace; -} - -SgExpression * FindSubExpression (SgExpression *expr1,SgExpression *expr2) { - SgExpression * res= NULL; - if ((expr1 == NULL) || (expr2 == NULL)) return res; - if ((expr1->variant () == expr2->variant ()) && - (expr1->lhs () != NULL) && - (expr2->lhs () != NULL) && - (expr1->rhs () != NULL) && - (expr2->rhs () != NULL) && - isSgVarRefExp(expr1->lhs ()) && - isSgVarRefExp(expr1->rhs ()) && - isSgVarRefExp(expr2->lhs ()) && - isSgVarRefExp(expr2->rhs ())) { - SgSymbol *expr1_sym1=expr1->lhs ()->symbol (); - SgSymbol *expr1_sym2=expr1->rhs ()->symbol (); - SgSymbol *expr2_sym1=expr2->lhs ()->symbol (); - SgSymbol *expr2_sym2=expr2->rhs ()->symbol (); - if (!strcmp (expr1_sym1->identifier(),expr2_sym1->identifier()) && !strcmp (expr1_sym2->identifier(),expr2_sym2->identifier())) return expr1; - } - res = FindSubExpression(expr1->lhs (), expr2); - if (res == NULL) return FindSubExpression(expr1->rhs (), expr2); - return res; -} - -SgSymbol *ChangeParallelDir (SgStatement *stmt) { - SgExprListExp *exp=isSgExprListExp (stmt->expr(1)); - int i=0; - if (exp == NULL) return NULL; - for (SgExpression *expr=exp->elem(i); ilength(); i++) { - if (expr->variant () == ACROSS_OP) { - SgStatement *st; - SgStatement *loop=GetLexNextIgnoreOMP (stmt); - for(st=loop; st && (st != loop->lastNodeOfStmt ()); st=st->lexNext ()) { - if (st->variant () == ASSIGN_STAT) { - if (st->lexNext ()->variant () == FOR_NODE) { - SgStatement *forst = st->lexNext (); - int length=forst->numberOfAttributes(OMP_STMT_BEFORE); - int find=0; - for (int i=0; igetAttribute(i,OMP_STMT_BEFORE); - if (((SgStatement *)sa->getAttributeData())->variant () == OMP_DO_DIR) { - find=1; break; - } - } - if (find == 0) return NULL; - SgSymbol *j=st->expr(0)->symbol(); - SgSymbol *newj=st->expr(1)->lhs()->symbol(); - SgExpression *newj_iam=st->expr(1); - SgExpression *res = FindSubExpression (stmt->expr(0),newj_iam); - if (res != NULL) { - NODE_CODE(res->thellnd) = VAR_REF; - res->setSymbol (*j); - delete res->lhs(); - delete res->rhs(); - res->setLhs (NULL); - res->setRhs (NULL); - } - stmt->replaceSymbBySymb(*newj,*j); - loop->setSymbol (*j); - if (HideOmpStmt (st)) st->extractStmt (); - return newj; - } - } - if (isSgForStmt (st)) loop = st; - } - } - } - return NULL; -} - -void ChangeAccrossOpenMPParam (SgStatement *stmt, SgSymbol *newj, int ub) { - SgStatement *st=stmt; - SgStatement *loop=NULL; - SgValueExp c1(1); - if (ub == 0) return; - int find=0; - for(; st && st->lexNext () && (st != stmt->lastNodeOfStmt ()); st=st->lexNext ()) { - if (st->variant ()== FOR_NODE) loop = st; - SgStatement * forst=st->lexNext (); - int length=forst->numberOfAttributes(OMP_STMT_BEFORE); - find=0; - for (int i=0; igetAttribute(i,OMP_STMT_BEFORE); - if (((SgStatement *)sa->getAttributeData())->variant () == OMP_DO_DIR) { - find=1; break; - } - } - if (find == 1) break; - } - if ((find==1) && loop && (newj != NULL)) { - SgForStmt *accr_do = isSgForStmt(loop); - for (;st && (st->lexNext() != NULL) && (st != loop->lastNodeOfStmt ()); st=st->lexNext ()) - if ((st->lexNext()!= NULL) && (st->lexNext()->lexNext() != NULL)) { - SgExpression *expr = new SgVarRefExp (loop->symbol ()); - SgStatement *stIfStmt = st->lexNext()->lexNext(); - if (IsPositiveDoStep(accr_do->step())) { - *expr = expr->copy() < accr_do->start()->copy() || expr->copy() > accr_do->end()->copy (); - } else { - *expr = expr->copy() < accr_do->end()->copy() || expr->copy() > accr_do->start()->copy (); - } - if (stIfStmt->lexNext()->variant () == CYCLE_STMT) { - SgIfStmt *ifst = isSgIfStmt (stIfStmt); - if (ifst != NULL) { - ifst->setExpression (0, *expr); - } else { - SgLogIfStmt *logifst = isSgLogIfStmt (stIfStmt); - if (logifst != NULL) { - logifst->setExpression (0, *expr); - } - } - } - } - if (ub == 1) { - SgExpression *ind = accr_do->end (); - *ind = *ind + *new SgFunctionCallExp(*new SgVariableSymb("OMP_GET_NUM_THREADS")) - c1.copy (); - accr_do->setEnd(*ind); - } else if (ub == 2) { - SgExpression *ind = accr_do->start (); - *ind = *ind + *new SgFunctionCallExp(*new SgVariableSymb("OMP_GET_NUM_THREADS")) - c1.copy (); - accr_do->setStart(*ind); - } - loop->setSymbol (*newj); - } -} - -void ChangeParallelLoopHideOpenmp(SgStatement *stmt) -{ - int nloop=0; - SgStatement *prev=NULL; - SgStatement *st; - stmt_list *stmt_to_delete = NULL; - for(SgExpression *dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) nloop++; - SgStatement *next=stmt->lexNext (); - SgStatement *forst, *last; - prev=stmt->lexPrev (); - if ((next->variant () == OMP_PARALLEL_DO_DIR) || - (next->variant () == OMP_DO_DIR)) { - forst = next->lexNext (); - if (forst->variant () == FOR_NODE) { - forst->addAttribute(OMP_STMT_BEFORE, (void*) next->copyPtr (), sizeof(SgStatement *)); - stmt_to_delete = addToStmtList(stmt_to_delete, next); - last=forst->lastNodeOfStmt ()->lexNext (); - if ((last->variant () == OMP_END_PARALLEL_DO_DIR) || - (last->variant () == OMP_END_DO_DIR)) { - forst->addAttribute(OMP_STMT_AFTER, (void*) last->copyPtr (), sizeof(SgStatement *)); - stmt_to_delete = addToStmtList(stmt_to_delete, last); - } - } - } else { - if ((prev->variant () == OMP_PARALLEL_DO_DIR) || - (prev->variant () == OMP_DO_DIR)) { - forst = next; - if (forst->variant () == FOR_NODE) { - forst->addAttribute(OMP_STMT_BEFORE, (void*) prev->copyPtr (), sizeof(SgStatement *)); - stmt_to_delete = addToStmtList(stmt_to_delete, prev); - } - last=forst->lastNodeOfStmt ()->lexNext (); - if ((last->variant () == OMP_END_PARALLEL_DO_DIR) || - (last->variant () == OMP_END_DO_DIR)) { - forst->addAttribute(OMP_STMT_AFTER, (void*) last->copyPtr (), sizeof(SgStatement *)); - stmt_to_delete = addToStmtList(stmt_to_delete, last); - } - } else { - if (next->variant () == FOR_NODE) { - for(st=next, prev=st; st && (nloop>0); st=st->lexNext ()) { - if (st->variant () == FOR_NODE) { - if ((prev != st) && (prev->lexNext () != st)) { - for(SgStatement *s=prev->lexNext (); s && (s!= st); s=s->lexNext ()) { - st->addAttribute(OMP_STMT_BEFORE, (void*) s->copyPtr (), sizeof(SgStatement *)); - stmt_to_delete = addToStmtList(stmt_to_delete, s); - s=s->lastNodeOfStmt (); - } - SgStatement *last=prev->lastNodeOfStmt(); - for(SgStatement *s=st->lastNodeOfStmt()->lexNext (); s && (s!= last); s=s->lexNext ()) { - st->addAttribute(OMP_STMT_AFTER, (void*) s->copyPtr (), sizeof(SgStatement *)); - stmt_to_delete = addToStmtList(stmt_to_delete, s); - s=s->lastNodeOfStmt (); - } - } - prev = st; - nloop--; - } - } - } - } - } - for(;stmt_to_delete; stmt_to_delete= stmt_to_delete->next) Extract_Stmt(stmt_to_delete->st);// extracting OpenMP Directives -} - -void MarkAndReplaceOriginalStmt (SgStatement *func) { - SgStatement *stmt = NULL; - SgStatement *first = func->lexNext(); - SgStatement *last = func->lastNodeOfStmt(); - SgStatement *next = NULL; - int res=0; - for (stmt = first; stmt && (stmt != last);stmt=stmt->lexNext ()) { - if (stmt->hasLabel ()&& (stmt->variant() != FORMAT_STAT)&& (stmt->variant() != CONT_STAT)) { - SgStatement *tmp = new SgStatement (CONT_STAT); - tmp->setLabel (*stmt->label ()); - tmp->setlineNumber (stmt->lineNumber()); - tmp->addAttribute(OMP_MARK); - stmt->insertStmtBefore(*tmp, *stmt->controlParent()); - BIF_LABEL(stmt->thebif)=NULL; - } - stmt->addAttribute(OMP_MARK); - if (stmt->variant () == DVM_PARALLEL_ON_DIR) ChangeParallelLoopHideOpenmp(stmt); - continue; - switch (stmt->variant ()) { - case OMP_PARALLEL_DO_DIR: - case OMP_DO_DIR: - case OMP_END_PARALLEL_DO_DIR: - case OMP_END_DO_DIR: res=HideOmpStmt (stmt); break; - case LOGIF_NODE: LogIf_to_IfThen(stmt); break; - } - if (res == 0) { - stmt = stmt->lexNext(); - } else { - res = 0; - next = stmt->lexNext(); - stmt->extractStmt (); - stmt = next; - } - } -} -stmt_list * PushToStmtList(stmt_list *pstmt, SgStatement *stat) { - stmt_list *stl; - if (!pstmt) { - pstmt = new stmt_list; - pstmt->st = stat; - pstmt->next = NULL; - } else { - stl = new stmt_list; - stl->st = stat; - stl->next = pstmt; - pstmt = stl; - } - return (pstmt); -} - -int ValFromStmtList(stmt_list *pstmt) { - if (pstmt) { - return pstmt->st->variant (); - } - return 0; -} - -stmt_list * PopFromStmtList(stmt_list *pstmt) { - if (pstmt) { - stmt_list *tmp = pstmt; - pstmt = pstmt->next; - tmp->next = NULL; - delete tmp; - return (pstmt); - } - return NULL; -} - -int isFromOneThread (int variant) { - switch (variant) { - case OMP_ONETHREAD_DIR: - case OMP_DO_DIR: - case OMP_SECTIONS_DIR: - case OMP_SINGLE_DIR: - case OMP_WORKSHARE_DIR: - case OMP_PARALLEL_DO_DIR: - case OMP_PARALLEL_SECTIONS_DIR: - case OMP_PARALLEL_WORKSHARE_DIR: - case OMP_MASTER_DIR: - case OMP_CRITICAL_DIR: - case PROG_HEDR: - case OMP_ORDERED_DIR: { - return 1; break; - } - case PROC_HEDR: - case FUNC_HEDR: - case OMP_PARALLEL_DIR: { - return 0; break; - } - default: { - return -1; - break; - } - } - return -1; -} - -SgStatement * InsertBeginSynchroStat (SgStatement *current) { /*OMP*/ - if (isADeclBif(current->variant ())) return NULL; - return current; -} - -int InsertEndSynchroStat (SgStatement *current) { /*OMP*/ - if (isADeclBif(current->variant ())) return 0; - if (current->variant () != CONTROL_END) { - current->insertStmtAfter(*new SgStatement (OMP_BARRIER_DIR),*current->controlParent()); /*OMP*/ - //current->insertStmtAfter(*new SgStatement (OMP_END_MASTER_DIR),*current->controlParent()); /*OMP*/ - } else { - current->lexNext ()->insertStmtBefore(*new SgStatement (OMP_BARRIER_DIR),*current->lexNext ()->controlParent()); /*OMP*/ - //current->lexNext ()->insertStmtBefore(*new SgStatement (OMP_END_MASTER_DIR),*current->lexNext ()->controlParent()); /*OMP*/ - } - return 1; -} - -void InsertSynchroBlock (SgStatement *begin, SgStatement *end) { - SgStatement *last=end->lexPrev (); - SgStatement *barrier = new SgStatement (OMP_BARRIER_DIR); - SgStatement *master = new SgStatement (OMP_MASTER_DIR); - barrier->addAttribute (OMP_MARK); - master->addAttribute (OMP_MARK); - if (begin->lexPrev ()->variant () != OMP_BARRIER_DIR) begin->insertStmtBefore(*barrier,*begin->controlParent()); - begin->insertStmtBefore(*master,*begin->controlParent()); - barrier = new SgStatement (OMP_BARRIER_DIR); - master = new SgStatement (OMP_END_MASTER_DIR); - barrier->addAttribute (OMP_MARK); - master->addAttribute (OMP_MARK); - if (end->lexNext () != NULL) { - if (end->lexNext ()->variant () != OMP_BARRIER_DIR) last->insertStmtAfter(*barrier,*last->controlParent()); - } else { - last->insertStmtAfter(*barrier,*last->controlParent()); - } - last->insertStmtAfter(*master,*last->controlParent()); -} - -SgStatement * InsertCriticalBlock (SgStatement *begin, SgStatement *end) { - SgStatement *critical = new SgStatement (OMP_CRITICAL_DIR); - critical->setExpression (0,*new SgVarRefExp(new SgSymbol (VARIABLE_NAME,"dvmcritical"))); - critical->addAttribute (OMP_MARK); - begin->insertStmtBefore(*critical,*begin->controlParent()); - critical = new SgStatement (OMP_END_CRITICAL_DIR); - critical->setExpression (0,*new SgVarRefExp(new SgSymbol (VARIABLE_NAME,"dvmcritical"))); - critical->addAttribute (OMP_MARK); - end->insertStmtBefore(*critical,*end->controlParent()); - return critical; -} - -void MarkParameters (SgStatement *st) { - SgExprListExp *list=isSgExprListExp(st->expr(0)); - if (list!= NULL) { - for (int i=0;ilength (); i++) { - SgExpression *exp=list->elem (i); - if (exp->variant ()== CONST_REF) { - exp->symbol ()->addAttribute (OMP_MARK); - } - } - } -} - -void AddOpenMPSynchro (SgStatement *func) { - SgStatement *stmt = NULL; - SgStatement *first = func->lexNext(); - SgStatement *last = func->lastNodeOfStmt(); - stmt_list *omp_list = NULL; - omp_list = PushToStmtList (omp_list, func); - int FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - SgStatement * SynchroBlockBegin = NULL; - for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { - AddOmpStmt (stmt); - } - for(stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { - if (stmt->variant () == OMP_ONETHREAD_DIR) { - FromOneThread = 1; - omp_list = PushToStmtList (omp_list, stmt); - continue; - } - if (stmt->variant () == PARAM_DECL) { - MarkParameters (stmt); - continue; - } - if (isADeclBif(stmt->variant ())) continue; - if (isOmpDir (stmt) || stmt->variant () == CONTROL_END || stmt->variant () == CONT_STAT) { - switch (stmt->variant ()) { - case OMP_END_PARALLEL_DIR: { - if (ValFromStmtList (omp_list) == OMP_PARALLEL_DIR) { - AddSharedClauseForDVMVariables (omp_list->st, stmt); - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP PARALLEL directive for this $OMP END PARALLEL directive %s", "", 701, stmt); - } - break; - } - case OMP_END_DO_DIR: { - if (ValFromStmtList (omp_list) == OMP_DO_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP DO directive for this $OMP END DO directive %s", "", 702, stmt); - } - break; - } - case OMP_END_SECTIONS_DIR: { - if (ValFromStmtList (omp_list) == OMP_SECTIONS_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP SECTIONS directive for this $OMP END SECTIONS directive %s", "", 703, stmt); - } - break; - } - case OMP_END_SINGLE_DIR: { - if (ValFromStmtList (omp_list) == OMP_SINGLE_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP SINGLE directive for this $OMP END SINGLE directive %s", "", 704, stmt); - } - break; - } - case OMP_END_WORKSHARE_DIR: { - if (ValFromStmtList (omp_list) == OMP_WORKSHARE_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP WORKSHARE directive for this $OMP END WORKSHARE directive %s", "", 705, stmt); - } - break; - } - case OMP_END_PARALLEL_DO_DIR: { - if (ValFromStmtList (omp_list) == OMP_PARALLEL_DO_DIR) { - AddSharedClauseForDVMVariables (omp_list->st, stmt); - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP PARALLEL DO directive for this $OMP END PARALLEL DO directive %s", "", 706, stmt); - } - break; - } - case OMP_END_PARALLEL_SECTIONS_DIR: { - if (ValFromStmtList (omp_list) == OMP_PARALLEL_SECTIONS_DIR) { - AddSharedClauseForDVMVariables (omp_list->st, stmt); - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP PARALLEL SECTIONS directive for this $OMP END PARALLEL SECTIONS directive %s", "", 707, stmt); - } - break; - } - case OMP_END_PARALLEL_WORKSHARE_DIR: { - if (ValFromStmtList (omp_list) == OMP_PARALLEL_WORKSHARE_DIR) { - AddSharedClauseForDVMVariables (omp_list->st, stmt); - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP PARALLEL WORKSHARE directive for this $OMP END PARALLEL WORKSHARE directive %s", "", 708, stmt); - } - break; - } - case OMP_END_MASTER_DIR: { - if (ValFromStmtList (omp_list) == OMP_MASTER_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP MASTER directive for this $OMP END MASTER directive %s", "", 709, stmt); - } - break; - } - case OMP_END_CRITICAL_DIR: { - if (ValFromStmtList (omp_list) == OMP_CRITICAL_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP CRITICAL directive for this $OMP END CRITICAL directive %s", "", 710, stmt); - } - break; - } - case OMP_END_ORDERED_DIR: { - if (ValFromStmtList (omp_list) == OMP_ORDERED_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } else { - Error("Can`t find $OMP ORDERED directive for this $OMP END ORDERED directive %s", "", 711, stmt); - } - break; - } - case OMP_PARALLEL_DIR: - case OMP_DO_DIR: - case OMP_SECTIONS_DIR: - case OMP_SINGLE_DIR: - case OMP_WORKSHARE_DIR: - case OMP_PARALLEL_DO_DIR: - case OMP_PARALLEL_SECTIONS_DIR: - case OMP_PARALLEL_WORKSHARE_DIR: - case OMP_MASTER_DIR: - case OMP_CRITICAL_DIR: - case OMP_ORDERED_DIR: { - omp_list = PushToStmtList (omp_list, stmt); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - break; - } - case CONT_STAT: - case CONTROL_END: { - SgStatement *next =stmt->lexNext (); - if (next && (next->variant () == OMP_END_PARALLEL_DO_DIR || next->variant () == OMP_END_DO_DIR)) break; - SgStatement *cp =stmt->controlParent (); - if (cp && cp->variant () == FOR_NODE) { - SgStatement *prev = cp->lexPrev (); - if (prev) { - if (prev->variant () == OMP_DO_DIR) { - if (ValFromStmtList (omp_list) == OMP_DO_DIR) { - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } - break; - } - if (prev->variant () == OMP_PARALLEL_DO_DIR) { - if (ValFromStmtList (omp_list) == OMP_PARALLEL_DO_DIR) { - AddSharedClauseForDVMVariables (omp_list->st, stmt); - omp_list = PopFromStmtList (omp_list); - FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); - } - break; - } - } - } - } - } - } - if (stmt->numberOfAttributes(OMP_CRITICAL) != 0) { - SgStatement *tmp=stmt; - for (; tmp; tmp = tmp->lexNext ()) { - if (tmp->numberOfAttributes(OMP_CRITICAL) == 0) break; - } - if (SynchroBlockBegin == NULL) stmt = InsertCriticalBlock (stmt, tmp); - else stmt = tmp->lexPrev (); - continue; - } - if ((stmt->numberOfAttributes(OMP_MARK) == 0) || (stmt->numberOfAttributes(OMP_CRITICAL) != 0)) { - if ((SynchroBlockBegin != NULL) || (FromOneThread == 1)) continue; - else { - SynchroBlockBegin = stmt; - } - } else { - if (SynchroBlockBegin != NULL) { - InsertSynchroBlock (SynchroBlockBegin, stmt); - SynchroBlockBegin = NULL; - } - } - } - if (SynchroBlockBegin != NULL) InsertSynchroBlock (SynchroBlockBegin, last); -} - -SgExprListExp * FindDVMVariableRefsInExpr (SgExpression *expr, SgExprListExp *list) -{ - if (expr==NULL) - return list; - if (expr->variant() == VAR_REF) - { - SgSymbol *sym = expr->symbol (); - if (sym->numberOfAttributes(OMP_MARK) == 0) { - if (list != NULL) { - if (!list->IsSymbolInExpression (*sym)) list->append (*expr); - } else { - list = new SgExprListExp (*expr); - } - } - } - if (expr->variant() == ARRAY_REF) - { - SgSymbol *sym = expr->symbol (); - if (sym->numberOfAttributes(OMP_MARK) == 0) { - if (list != NULL) { - if (!list->IsSymbolInExpression (*sym)) list->append (*new SgArrayRefExp(*sym)); - } else { - list = new SgExprListExp (*new SgArrayRefExp(*sym)); - } - } - } - list = FindDVMVariableRefsInExpr(expr->lhs (),list); - list = FindDVMVariableRefsInExpr(expr->rhs (),list); - return list; -} - -SgExprListExp * FindDVMVariableRefsInStmt (SgStatement *stmt, SgExprListExp *list) -{ - if (stmt==NULL) - return list; - list = FindDVMVariableRefsInExpr(stmt->expr (0),list); - list = FindDVMVariableRefsInExpr(stmt->expr (1),list); - list = FindDVMVariableRefsInExpr(stmt->expr (2),list); - return list; -} - -SgExprListExp * FindDVMVariableRefsInStmts (SgStatement *first, SgStatement *last) -{ - SgExprListExp *list = NULL; - for (SgStatement * stmt=first; stmt && (stmt != last); stmt=stmt->lexNext ()) { - list = FindDVMVariableRefsInStmt (stmt, list); - } - return list; -} - -void AddSharedClauseForDVMVariables (SgStatement *first, SgStatement *last) -{ - SgExprListExp *list = FindDVMVariableRefsInStmts (first->lexNext (), last); - if (list!=NULL) { - switch (first->variant ()) { - case OMP_PARALLEL_DIR: - case OMP_PARALLEL_DO_DIR: - case OMP_PARALLEL_SECTIONS_DIR: - case OMP_PARALLEL_WORKSHARE_DIR: - if (first->expr (0)) { - SgExprListExp *ll = isSgExprListExp (first->expr (0)); - if (ll) ll->append (* new SgExpression (OMP_SHARED, list,NULL,NULL,NULL)); - } else { - first->setExpression (0, *new SgExprListExp (* new SgExpression (OMP_SHARED, list,NULL,NULL,NULL))); - } - } - } -} - - -void TranslateFileOpenMPDVM(SgFile *f) -{ - SgStatement *func,*stat; - //int i,numfun; - SgStatement *end_of_unit; // last node (END or CONTAINS statement ) of program unit - - -// grab the first statement in the file. - stat = f->firstStatement(); // file header - //numfun = f->numberOfFunctions(); // number of functions -// function is program unit accept BLOCKDATA and MODULE (F90),i.e. -// PROGRAM, SUBROUTINE, FUNCTION - if(debug_fragment || perf_fragment) // is debugging or performance analizing regime specified ? - BeginDebugFragment(0,NULL);// begin the fragment with number 0 (involving whole file(program) - //for(i = 0; i < numfun; i++) { - // func = f -> functions(i); - - for (SgSymbol *sym=f->firstSymbol(); sym; sym=sym->next ()) { - sym->addAttribute (OMP_MARK); - } - for(stat=stat->lexNext(); stat; stat=end_of_unit->lexNext()) { - if(stat->variant() == CONTROL_END) { //end of procedure or module with CONTAINS statement - end_of_unit = stat; - continue; - } - - if( stat->variant() == BLOCK_DATA){//BLOCK_DATA header - TransBlockData(stat,end_of_unit); //changing variant VAR_DECL with VAR_DECL_90 - continue; - } - // PROGRAM, SUBROUTINE, FUNCTION header - func = stat; - cur_func = func; - - //scanning the Symbols Table of the function - // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); - - - // translating the function - if(only_debug) - InsertDebugStat(func, end_of_unit); - else { - MarkAndReplaceOriginalStmt (func); - TransFunc (func, end_of_unit); - AddOpenMPSynchro (func); - } - } -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/ompdebug.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/ompdebug.cpp deleted file mode 100644 index dc7b596..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/ompdebug.cpp +++ /dev/null @@ -1,3557 +0,0 @@ -#include -#include -#include -#undef IN_DVM_ -#include "dvm.h" -#define Max(a,b) ((a)>(b)?(a):(b)) - -#define MaxContextBufferLength 4000 - -struct ref_list { - SgExpression *ref; - ref_list *next; -} *ListOfRefs = NULL; - -int isIOStmt (SgStatement *st) { - switch(st->variant ()){ - case WRITE_STAT: - case PRINT_STAT: - case READ_STAT: - case OPEN_STAT: - case CLOSE_STAT: - case ENDFILE_STAT: - case BACKSPACE_STAT: - case INQUIRE_STAT: - case REWIND_STAT: - return 1; - } - return 0; -} - -void IntoArrayRefList (SgExpression *exp) { - if (ListOfRefs == NULL) { - ListOfRefs = new ref_list; - ListOfRefs->ref = exp; - ListOfRefs->next = NULL; - } else { - ref_list *tmp = new ref_list; - tmp->ref = exp; - tmp->next = ListOfRefs; - ListOfRefs = tmp; - } -} - -int InArrayRefList (SgExpression *exp) { - if (ListOfRefs == NULL) { - return 0; - } else { - for (ref_list *tmp = ListOfRefs; tmp; tmp = tmp->next) { - if (ExpCompare(tmp->ref, exp)) return 1; - } - } - return 0; -} - -void ClearArrayRefList () { - if (ListOfRefs == NULL) { - return; - } - for (ref_list *tmp=ListOfRefs; ListOfRefs != NULL; ) { - tmp = ListOfRefs; - ListOfRefs = ListOfRefs->next; - tmp->ref = NULL; - tmp->next = NULL; - delete tmp; - } - ListOfRefs = NULL; -} - - -void DBGSearchVarsInFunction (SgStatement *func); -void RegisterSymbol (SgSymbol *sym); -void RegistrateVariable (SgSymbol *sym); -void RegisterArray(SgSymbol *sym); -void RegisterAllocatableArrays(SgStatement *stat); -void UnregisterAllocatableArrays(SgStatement *stat); -void RegisterVar(SgSymbol *sym); -int GenerateCallGetHandle (char * strContextString); -void InstrumentOmpParallelDir (SgStatement *st,char * strContextString); -void InstrumentOmpDoDir (SgStatement *st,char * strContextString); -void InstrumentSerialDoLoop(SgStatement *st, char *strStaticContext); -void InstrumentAssignStat(SgStatement *st, char *strStaticContext); -void InstrumentIfStat (SgStatement *st, char *strStaticContext); -void InstrumentProcStat(SgStatement *st, char *strStaticContext); -void InstrumentFuncCall (SgStatement *st, SgExpression *exp); -void InstrumentFunctionBegin(SgStatement *st, char *strStaticContext, SgStatement *func); -void InstrumentFunctionEnd(SgStatement *st, SgStatement *func); -void InstrumentGotoStmt(SgStatement *st); -void InstrumentExitFromLoops (SgStatement *st); -void InstrumentOmpSingleDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpCriticalDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpOrderelDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpMasterDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpBarrierDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpFlushDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpThreadPrivateDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpThreadPrivateDir (SgStatement *st, SgStatement *before, char *strStaticContext); -void InstrumentOmpSectionsDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpSectionDir (SgStatement *st, char *strStaticContext); -void InstrumentOmpWorkshareDir (SgStatement *st, char *strStaticContext); -void InstrumentExitStmt (SgStatement *stat); -SgStatement *GetLastStatementOfLoop (SgStatement *forst); -void InstrumentReadVar (SgStatement *st, SgExpression *exp, SgArrayRefExp *var); -void InstrumentReadArray (SgStatement *st, SgExpression *exp, SgArrayRefExp *var); -void InstrumentIntervalDir (SgStatement *bst, SgStatement *st, char *strStaticContext); -void InstrumentIOStmt (SgStatement *st, char *strStaticContext); -void MarkFormalParameters (SgStatement *st); -void DeclareExternalProcedures (SgStatement *debug); -void UpdateIncludeVarsFile(SgStatement *st, const char *input_file); -void UpdateIncludeInitFile(SgStatement *st, const char *input_file); -SgExpression *GetOmpAddresMem (SgExpression *exp); -void FindExternalProcedures (SgStatement *debug); -void GenerateNowaitPlusBarrier (SgStatement *st); -void GenerateFileAndLine (SgStatement *st, char *strStaticContext); -SgStatement *GetFirstExecutableStatement (SgStatement *func); -SgStatement *GetFirstExecutableNotDebugStatement (SgStatement *func); - -int nArrStaticHandleCount = 0; //StaticContextStringsCount -int nArrHandleCount = 0; //Dynamic -int nMaxArrHandleCount = 0; -SgVarRefExp *varThreadID = NULL; -SgSymbol *symStatMP = NULL; -SgSymbol *symDynMP = NULL; -SgStatement *stLastDebug = NULL; -SgValueExp *C4,*C3,*C2,*C1,*C0, *M1; -SgVarRefExp *atomic_varref = NULL; - -SgSymbol *sym_dbg_init=NULL; -SgSymbol *sym_dbg_finalize=NULL; -SgSymbol *symDbgInitHandles=NULL; -SgSymbol *sym_dbg_get_handle=NULL; -SgSymbol *sym_dbg_regarr=NULL; -SgSymbol *sym_dbg_unregarr=NULL; -SgSymbol *sym_dbg_regvar=NULL; -SgSymbol *sym_dbg_before_parallel=NULL; -SgSymbol *sym_dbg_after_parallel=NULL; -SgSymbol *sym_dbg_parallel_event=NULL; -SgSymbol *sym_dbg_parallel_event_end=NULL; - -SgSymbol *sym_dbg_before_omp_loop=NULL; -SgSymbol *sym_dbg_after_omp_loop=NULL; -SgSymbol *sym_dbg_omp_loop_event=NULL; - -SgSymbol *sym_dbg_before_loop=NULL; -SgSymbol *sym_dbg_after_loop=NULL; -SgSymbol *sym_dbg_loop_event=NULL; - -SgSymbol *sym_dbg_write_var_begin=NULL; -SgSymbol *sym_dbg_write_arr_begin=NULL; -SgSymbol *sym_dbg_write_var_end=NULL; -SgSymbol *sym_dbg_write_arr_end=NULL; -SgSymbol *sym_dbg_read_var=NULL; -SgSymbol *sym_dbg_read_arr=NULL; - -SgSymbol *sym_dbg_regcommon=NULL; -SgSymbol *sym_dbg_regpararr=NULL; -SgSymbol *sym_dbg_regparvar=NULL; -SgSymbol *sym_dbg_get_addr=NULL; - -SgSymbol *sym_dbg_before_sections=NULL; -SgSymbol *sym_dbg_after_sections=NULL; -SgSymbol *sym_dbg_section_event=NULL; -SgSymbol *sym_dbg_section_event_end=NULL; -SgSymbol *sym_dbg_before_single=NULL; -SgSymbol *sym_dbg_single_event=NULL; -SgSymbol *sym_dbg_single_event_end=NULL; -SgSymbol *sym_dbg_after_single=NULL; -SgSymbol *sym_dbg_before_workshare=NULL; -SgSymbol *sym_dbg_after_workshare=NULL; -SgSymbol *sym_dbg_master_begin=NULL; -SgSymbol *sym_dbg_master_end=NULL; -SgSymbol *sym_dbg_before_critical=NULL; -SgSymbol *sym_dbg_critical_event=NULL; -SgSymbol *sym_dbg_critical_event_end=NULL; -SgSymbol *sym_dbg_after_critical=NULL; -SgSymbol *sym_dbg_before_barrier=NULL; -SgSymbol *sym_dbg_after_barrier=NULL; -SgSymbol *sym_dbg_before_flush=NULL; -SgSymbol *sym_dbg_flush_event=NULL; -SgSymbol *sym_dbg_before_ordered=NULL; -SgSymbol *sym_dbg_ordered_event=NULL; -SgSymbol *sym_dbg_after_ordered=NULL; -SgSymbol *sym_dbg_threadprivate=NULL; -SgSymbol *sym_dbg_before_funcall=NULL; -SgSymbol *sym_dbg_funcparvar=NULL; -SgSymbol *sym_dbg_funcpararr=NULL; -SgSymbol *sym_dbg_after_funcall=NULL; -SgSymbol *sym_dbg_funcbegin=NULL; -SgSymbol *sym_dbg_funcend=NULL; -SgSymbol *sym_dbg_if_loop_event=NULL; -SgSymbol *sym_dbg_omp_if_loop_event=NULL; -SgFunctionSymb *FuncLeftBound = NULL; -SgFunctionSymb *FuncRightBound = NULL; -SgSymbol *sym_dbg_interval_begin=NULL; -SgSymbol *sym_dbg_interval_end=NULL; -SgSymbol *sym_dbg_before_io=NULL; -SgSymbol *sym_dbg_after_io=NULL; - -int isMainProgram = 0; -void ConvertLoopWithLabelToEnddoLoop (SgStatement *stat) { - SgForStmt *forst = isSgForStmt (stat); - if (forst != NULL) { - if (forst->isEnddoLoop()) return; - if (!forst->convertLoop()) { - SgStatement *last_st,*lst; - last_st= LastStatementOfDoNest(forst); - if(last_st != (lst=forst->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) { - last_st=ReplaceLabelOfDoStmt(forst,last_st, GetLabel()); - ReplaceDoNestLabel_Above(last_st,forst,GetLabel()); - forst->convertLoop(); - } - } - } -} - -void ComputedGoTo_to_IfGoto (SgStatement *stmt) -{//GO TO (lab1,lab2,..,labk), -// is replaced by -// [ iv = int_expr ] -// IF ( iv.EQ.1) THEN -// GO TO lab1 -// ENDIF -// IF ( iv.EQ.2) THEN -// GO TO lab2 -// ENDIF -// . . . -// IF ( iv.EQ.k) THEN -// GO TO labk -// ENDIF - SgStatement *ass, *ifst; - SgLabel *lab_st, *labgo; - SgGotoStmt *gost; - SgExpression *cond, *el; - SgSymbol *sv; - int lnum,i; - lnum = stmt->lineNumber(); - lab_st = stmt->label(); - if(isSgVarRefExp(stmt->expr(1))) - { sv = stmt->expr(1)->symbol(); - ass = NULL; - } - else - { sv = DebugGoToSymbol(stmt->expr(1)->type()); - ass = new SgAssignStmt (*new SgVarRefExp(sv),*stmt->expr(1)); - stmt->insertStmtBefore(*ass,*stmt->controlParent());//inserting before stmt - if(lab_st) - ass-> setLabel(*lab_st); - BIF_LINE(ass->thebif) = lnum; - } - for(el=stmt->expr(0),i=1; el; el=el->rhs(),i++) - { - labgo = ((SgLabelRefExp *) (el->lhs()))->label(); - gost = new SgGotoStmt(*labgo); - BIF_LINE(gost->thebif) = lnum; - cond = &SgEqOp(*new SgVarRefExp(sv), *new SgValueExp(i)); - ifst = new SgIfStmt( *cond, *gost); - stmt->insertStmtBefore(*ifst,*stmt->controlParent());//inserting before stmt - - if(i==1 && lab_st && !ass ) - ifst-> setLabel(*lab_st); - } - Extract_Stmt(stmt); -} - -void ArithIF_to_IfGoto(SgStatement *stmt) -{//IF (expr) lab1,lab2,lab3 -// is replaced by -// [ iv = expr ] -// IF ( v.LT.0) THEN -// GO TO lab1 -// ENDIF -// IF ( v.EQ.0) THEN -// GO TO lab2 -// ENDIF -// //IF ( v.GT.0) THEN -// GO TO lab3 -// //ENDIF - SgStatement *ass, *ifst; - SgLabel *lab_st, *labgo; - SgGotoStmt *gost; - SgExpression *cond; - SgSymbol *sv; - int lnum; - - lnum = stmt->lineNumber(); - lab_st = stmt->label(); - if(isSgVarRefExp(stmt->expr(0))) - { sv = stmt->expr(0)->symbol(); - ass = NULL; - } - else - { sv = DebugGoToSymbol(stmt->expr(0)->type()); - ass = new SgAssignStmt (*new SgVarRefExp(sv),*stmt->expr(0)); - stmt->insertStmtBefore(*ass,*stmt->controlParent());//inserting before stmt - if(lab_st) - ass-> setLabel(*lab_st); - } - labgo = ((SgLabelRefExp *) (stmt->expr(1)->lhs()))->label(); - gost = new SgGotoStmt(*labgo); - BIF_LINE(gost->thebif) = lnum; - cond = &operator < (*new SgVarRefExp(sv), *new SgValueExp(0)); - ifst = new SgIfStmt( *cond, *gost); - stmt->insertStmtBefore(*ifst,*stmt->controlParent());//inserting before stmt - if(lab_st && !ass) - ifst-> setLabel(*lab_st); - - labgo = ((SgLabelRefExp *) (stmt->expr(1)->rhs()->lhs()))->label(); - gost = new SgGotoStmt(*labgo); - BIF_LINE(gost->thebif) = lnum; - cond = &SgEqOp(*new SgVarRefExp(sv), *new SgValueExp(0)); - ifst = new SgIfStmt(*cond, *gost); - stmt->insertStmtBefore(*ifst,*stmt->controlParent());//inserting before stmt - labgo = ((SgLabelRefExp *) (stmt->expr(1)->rhs()->rhs()->lhs()) )->label(); - gost = new SgGotoStmt(*labgo); - BIF_LINE(gost->thebif) = lnum; - stmt->insertStmtBefore(*gost,*stmt->controlParent());//inserting before stmt - Extract_Stmt(stmt); -} - - -void SearchVarAndArrayInExpression(SgStatement *st, SgExpression *exp); -void RegisterCommonBlock (SgStatement *st, SgStatement *func) { - char *strStaticContext = new char [MaxContextBufferLength]; - SgExpression *exp = st->expr(0); - for (SgExpression *ex=exp; ex; ex=ex->rhs()) { - SgExpression *e=ex->lhs (); - if (e != NULL) { - SgSymbol *sym=ex->symbol(); - if (strcmp (sym->identifier(),"dbg_stat")&& - strcmp (sym->identifier(),"dbg_dyn")&& - strcmp (sym->identifier(),"dbg_thread")) { - SgCallStmt *fe; - SgStatement *stFirst = GetFirstExecutableNotDebugStatement(func); - if (stFirst == NULL) continue; - if (sym_dbg_regcommon == NULL) sym_dbg_regcommon = new SgSymbol (PROCEDURE_NAME, "dbg_regcommon"); - fe = new SgCallStmt(*sym_dbg_regcommon); - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stFirst->insertStmtBefore(*fe, *stFirst->controlParent()); - sprintf (strStaticContext, "*type=common_name*file=%s*line1=%d*name1=%s*name2=%s",st->fileName(),st->lineNumber(),sym->identifier(),UnparseExpr (e)); - GenerateCallGetHandle (strStaticContext); - } - } - } - delete strStaticContext; -} -void MarkSymbolsInDecl (SgStatement *st) { - for (SgExpression *ex=st->expr(2); ex; ex=ex->rhs()) { - if (ex != NULL) { - SgExprListExp *list = isSgExprListExp (ex); - if (list !=NULL){ - for (int i=0; ilength (); i++) { - SgExpression *exp = list->elem(i); - if (exp->variant()== SAVE_OP){ - for (SgExpression *expr=st->expr(0); expr; expr=expr->rhs()) { - SgExprListExp *varlist = isSgExprListExp (expr); - if (varlist !=NULL){ - for (int j=0; jlength (); j++) { - SgExpression *varexp = varlist->elem(j); - switch (varexp->variant ()){ - case ARRAY_REF: - case VAR_REF: varexp->symbol()->addAttribute(SAVE_VAR); - break; - } - - } - } - } - break; - } - } - } - } - } -} - -void MarkSymbolsInCommon (SgStatement *st) { - for (SgExpression *ex=st->expr(0); ex; ex=ex->rhs()) { - SgExpression *e=ex->lhs (); - if (e != NULL) { - SgExprListExp *list = isSgExprListExp (e); - if (list !=NULL){ - for (int i=0; ilength (); i++) { - SgExpression *exp = list->elem(i); - switch (exp->variant ()){ - case ARRAY_REF: - case VAR_REF: exp->symbol()->addAttribute(COMMON_VAR); - break; - } - } - } - } - } -} - -void MarkFormalParameters (SgStatement *st) { - SgFunctionSymb *func = isSgFunctionSymb (st->symbol ()); - if (func != NULL) { - for (int i=0; inumberOfParameters(); i++) { - SgSymbol *sym=func->parameter(i); - int *pos = new int; - *pos = i+1; - switch (sym->variant ()){ - case VARIABLE_NAME: sym->addAttribute(FORMAL_PARAM,(void*) pos, sizeof(int)); - break; - } - } - } -} -void MarkSymbolsInSave (SgStatement *st) { - SgExprListExp *list = isSgExprListExp (st->expr(0)); - if (list !=NULL){ - for (int i=0; ilength (); i++) { - SgExpression *exp = list->elem(i); - switch (exp->variant ()){ - case ARRAY_REF: - case VAR_REF: exp->symbol()->addAttribute(SAVE_VAR); - break; - } - } - } -} - -int GenerateCallGetHandle (char * strContextString) { - if (stLastDebug != NULL) { - if (sym_dbg_get_handle == NULL) { - sym_dbg_get_handle = new SgSymbol(PROCEDURE_NAME, "dbg_get_handle"); - } - SgCallStmt *fe = new SgCallStmt(*sym_dbg_get_handle); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - int nLen = strlen (strContextString); - char *strString = new char [MaxContextBufferLength]; - sprintf (strString,"%d%s**", (nLen+2), strContextString); - fe->addArg(*arrStaticRef); - fe->addArg(*new SgValueExp(strString)); - fe->addAttribute(COMMON_VAR); - stLastDebug->insertStmtBefore(*fe, *stLastDebug->controlParent()); - return ++nArrStaticHandleCount; - } - return -1; -} - -int GenerateCallGetHandle (char * strContextString, int nArrStaticHandleCount) { - if (stLastDebug != NULL) { - if (sym_dbg_get_handle == NULL) { - sym_dbg_get_handle = new SgSymbol(PROCEDURE_NAME, "dbg_get_handle"); - } - SgCallStmt *fe = new SgCallStmt(*sym_dbg_get_handle); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - int nLen = strlen (strContextString); - char *strString = new char [MaxContextBufferLength]; - sprintf (strString,"%d%s**", (nLen+2), strContextString); - fe->addArg(*arrStaticRef); - fe->addArg(*new SgValueExp(strString)); - fe->addAttribute(COMMON_VAR); - stLastDebug->insertStmtBefore(*fe, *stLastDebug->controlParent()); - return nArrStaticHandleCount+1; - } - return -1; -} - - -SgStatement *doOmpAssignStmt(SgExpression *re, SgStatement *before) { - SgExpression *le; - SgValueExp * index; - SgStatement *assign; - // creating assign statement with right part "re" and inserting it - // before first executable statement (after last generated statement) - index = new SgValueExp (nArrHandleCount++); - le = new SgArrayRefExp(*symDynMP,*index); - assign = new SgAssignStmt (*le,*re); - assign->addAttribute(DEBUG_STAT); - before->insertStmtBefore(*assign,*before->controlParent()); - nMaxArrHandleCount = Max (nMaxArrHandleCount,nArrHandleCount); - return assign; -} - -SgStatement * doOmpAssignTo(SgExpression *le, SgExpression *re, SgStatement *before) { - SgStatement *assign = new SgAssignStmt (*le,*re); - assign->addAttribute(DEBUG_STAT); - before->insertStmtBefore(*assign,*before->controlParent()); - return assign; -} - -char *ReplaceInExpr(char *val) { // Delete spaces from expression and replace "*" by "\*" - int count=0; - char *res = NULL; - int vallen = strlen(val); - for (int i=0; i< vallen; i++) { - if (val[i]=='*') count++; - if (val[i]==' ') count--; - } - if (count==0) return val; - res = new char [vallen + count + 1]; - memset(res, 0, vallen + count); - for (int i=0,j=0; i< vallen; i++,j++) { - if (val[i]!='*') { - if (val[i] ==' ') { - j--; - continue; - } - res[j]=val[i]; - } else { - res[j++]='\\'; - res[j]=val[i]; - } - } - res[vallen + count]='\0'; - return res; -} -void ConvertElseIFToElse_IF(SgStatement *stat) { - stat->setVariant(IF_NODE); - addControlEndToStmt(stat->controlParent()->thebif); -} - -char *GenerateContextStringForExpressionList (SgExpression *e){ - char *result = NULL; - int maxlen=0; - SgExprListExp *exp = isSgExprListExp (e); - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *elem = exp->elem (i); - if (elem->variant () == VAR_REF) { - maxlen += strlen(elem->symbol()->identifier ()) + 1; - } else if (elem->variant () == ARRAY_REF) { - maxlen += strlen(UnparseExpr (elem)) + 1; - } else if (elem->variant () == OMP_THREADPRIVATE) { - maxlen += strlen(elem->lhs ()->symbol()->identifier ()) + 3; - } else { - fprintf (stderr, "Error: Incorrect member in EXPR_LIST"); - exit (-1); - } - } - result = new char [maxlen]; - memset(result, 0, maxlen); - for (int i=0; ilength(); i++) { - SgExpression *elem = exp->elem (i); - if (strlen (result)!=0) { - strcat(result,","); - } - if (elem->variant () == VAR_REF) { - strcat(result,elem->symbol()->identifier ()); - } else if (elem->variant () == ARRAY_REF) { - strcat(result,UnparseExpr (elem)); - } else if (elem->variant () == OMP_THREADPRIVATE) { - strcat(result,"/"); - strcat(result,elem->lhs ()->symbol()->identifier ()); - strcat(result,"/"); - } else { - fprintf (stderr, "Error: Incorrect member in EXPR_LIST"); - exit (-1); - } - } - } - if (result == NULL) { - result = new char[1]; - result[0] = '\0'; - } - - return result; -} - -void GenerateFileAndLine (SgStatement *st, char *strStaticContext) { - sprintf(strStaticContext,"%s*file=%s*line1=%d",strStaticContext,st->fileName(),st->lineNumber()); -} - -SgStatement *GetLastDeclarationStatement (SgStatement *func){ - SgStatement *st = func->lastDeclaration (); - for (;st && st->lexNext ();st=st->lexNext ()) { - int variant=st->lexNext()->variant (); - if (isADeclBif (variant)) continue; - else switch (variant) { - case COMM_STAT: - case SAVE_DECL: - case DATA_DECL: - case STMTFN_STAT: - case ENTRY_STAT: - case INTERFACE_STMT: - case INTERFACE_ASSIGNMENT: - case INTERFACE_OPERATOR: - case USE_STMT: - case STRUCT_DECL: - case FORMAT_STAT: - case HPF_TEMPLATE_STAT: - case HPF_PROCESSORS_STAT: - case DVM_DYNAMIC_DIR: - case DVM_SHADOW_DIR: - case DVM_TASK_DIR: - case DVM_CONSISTENT_DIR: - case DVM_INDIRECT_GROUP_DIR: - case DVM_REMOTE_GROUP_DIR: - case DVM_CONSISTENT_GROUP_DIR: - case DVM_REDUCTION_GROUP_DIR: - case DVM_INHERIT_DIR: - case DVM_ALIGN_DIR: - case DVM_DISTRIBUTE_DIR: - case DVM_POINTER_DIR: - case DVM_HEAP_DIR: - case DVM_ASYNCID_DIR: - case DVM_VAR_DECL: continue; - default: { - return st; - } - } - } - return st; -} - -SgStatement *GetFirstExecutableStatement (SgStatement *func){ - SgStatement *st = func->lastDeclaration ()->lexNext (); - for (;st;st=st->lexNext ()) { - int variant=st->variant (); - if (isADeclBif (variant)) continue; - else switch (variant) { - case COMM_STAT: - case SAVE_DECL: - case DATA_DECL: - case STMTFN_STAT: - case ENTRY_STAT: - case INTERFACE_STMT: - case INTERFACE_ASSIGNMENT: - case INTERFACE_OPERATOR: - case USE_STMT: - case STRUCT_DECL: - case FORMAT_STAT: - case HPF_TEMPLATE_STAT: - case HPF_PROCESSORS_STAT: - case DVM_DYNAMIC_DIR: - case DVM_SHADOW_DIR: - case DVM_TASK_DIR: - case DVM_CONSISTENT_DIR: - case DVM_INDIRECT_GROUP_DIR: - case DVM_REMOTE_GROUP_DIR: - case DVM_CONSISTENT_GROUP_DIR: - case DVM_REDUCTION_GROUP_DIR: - case DVM_INHERIT_DIR: - case DVM_ALIGN_DIR: - case DVM_DISTRIBUTE_DIR: - case DVM_POINTER_DIR: - case DVM_HEAP_DIR: - case DVM_ASYNCID_DIR: - case DVM_VAR_DECL: continue; - default: { - return st; - } - } - } - return st; -} - -SgStatement *GetFirstExecutableNotDebugStatement (SgStatement *func) { - SgStatement *st = func->lastDeclaration ()->lexNext (); - for (;st;st=st->lexNext ()) { - int variant=st->variant (); - if (isADeclBif (variant)) continue; - else switch (variant) { - case COMM_STAT: - case SAVE_DECL: - case DATA_DECL: - case STMTFN_STAT: - case ENTRY_STAT: - case INTERFACE_STMT: - case INTERFACE_ASSIGNMENT: - case INTERFACE_OPERATOR: - case USE_STMT: - case STRUCT_DECL: - case FORMAT_STAT: - case HPF_TEMPLATE_STAT: - case HPF_PROCESSORS_STAT: - case DVM_DYNAMIC_DIR: - case DVM_SHADOW_DIR: - case DVM_TASK_DIR: - case DVM_CONSISTENT_DIR: - case DVM_INDIRECT_GROUP_DIR: - case DVM_REMOTE_GROUP_DIR: - case DVM_CONSISTENT_GROUP_DIR: - case DVM_REDUCTION_GROUP_DIR: - case DVM_INHERIT_DIR: - case DVM_ALIGN_DIR: - case DVM_DISTRIBUTE_DIR: - case DVM_POINTER_DIR: - case DVM_HEAP_DIR: - case DVM_ASYNCID_DIR: - case DVM_VAR_DECL: continue; - default: { - if (st->getAttribute(0,DEBUG_STAT)!=NULL) continue; - return st; - } - } - } - return st; -} - - -void GenerateContextStringForClauses (SgExpression *elem, char *strStaticContext) { - switch (elem->variant ()) { - case OMP_PRIVATE: { - strcat(strStaticContext,"*private="); - strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); - break; - } - case OMP_FIRSTPRIVATE: { - strcat(strStaticContext,"*firstprivate="); - strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); - break; - } - case OMP_LASTPRIVATE: { - strcat(strStaticContext,"*lastprivate="); - strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); - break; - } - case OMP_COPYIN: { - strcat(strStaticContext,"*copyin="); - strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); - break; - } - case OMP_SHARED: { - strcat(strStaticContext,"*shared="); - strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); - break; - } - case OMP_DEFAULT: { - SgValueExp *val = isSgValueExp (elem->lhs ()); - if (val != NULL) { - strcat(strStaticContext,"*default="); - strcat(strStaticContext,NODE_STR(val->thellnd)); - } - break; - } - case OMP_REDUCTION: { - SgExprListExp *ex = isSgExprListExp (elem->lhs ()); - if (ex != NULL) { - if (ex->elem(0)->variant() == DDOT) { - strcat(strStaticContext,"*redop="); - strcat(strStaticContext,NODE_STR(ex->elem(0)->lhs()->thellnd)); - SgExprListExp *e = isSgExprListExp (ex->elem(0)->rhs()); - if (e != NULL) { - strcat(strStaticContext,"*reduction="); - strcat(strStaticContext,GenerateContextStringForExpressionList (e)); - } - } - } - break; - } - case OMP_IF: { - char *ifexpr = UnparseExpr (elem->lhs ()); - if (ifexpr != NULL) { - strcat(strStaticContext,"*if="); - strcat(strStaticContext,ReplaceInExpr(ifexpr)); - } - break; - } - case OMP_NUM_THREADS: { - char *numthreads = UnparseExpr (elem->lhs ()); - if (numthreads != NULL) { - strcat(strStaticContext,"*num_threads="); - strcat(strStaticContext,ReplaceInExpr(numthreads)); - } - break; - } - case OMP_SCHEDULE: { - char *schedule = NULL; - if (elem->rhs () != NULL ) schedule = UnparseExpr (elem->rhs ()); - SgValueExp *val = isSgValueExp (elem->lhs ()); - if (val != NULL) { - strcat(strStaticContext,"*schedule="); - strcat(strStaticContext,NODE_STR(val->thellnd)); - } - if (schedule != NULL) { - strcat(strStaticContext,"*chunk_size="); - strcat(strStaticContext,ReplaceInExpr(schedule)); - } - break; - } - case OMP_ORDERED: { - strcat(strStaticContext,"*ordered=1"); - break; - } - case OMP_NOWAIT: { - strcat(strStaticContext,"*nowait=1"); - break; - } - case OMP_COPYPRIVATE: { - strcat(strStaticContext,"*copyprivate="); - strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); - break; - } - } -} - -void TempVarOmpDebug(SgStatement * func) { - - SET_DVM(1); - SgValueExp C16(16); - SgArrayType *typearray; - SgStatement *stFirstExecutableFunc = GetFirstExecutableStatement(func); - typearray = new SgArrayType(*SgTypeInt()); - typearray = new SgArrayType(*SgTypeFloat()); - typearray-> addRange(*C2); - Rmem = new SgVariableSymb("r0000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*Rmem->makeVarDeclStmt ()); - typearray = new SgArrayType(*SgTypeDouble()); - typearray-> addRange(*C2); - Dmem = new SgVariableSymb("d0000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*Dmem->makeVarDeclStmt ()); - typearray = new SgArrayType(*SgTypeInt()); - typearray-> addRange(C16); - Imem = new SgVariableSymb("i0000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*Imem->makeVarDeclStmt ()); - typearray = new SgArrayType(*SgTypeBool()); - typearray-> addRange(*C2); - Lmem = new SgVariableSymb("l0000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*Lmem->makeVarDeclStmt ()); - typearray = new SgArrayType(* SgTypeComplex(current_file)); - typearray-> addRange(*C2); - Cmem = new SgVariableSymb("c0000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*Cmem->makeVarDeclStmt ()); - typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); - typearray-> addRange(*C2); - DCmem = new SgVariableSymb("dc000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*DCmem->makeVarDeclStmt ()); - typearray = new SgArrayType(*SgTypeChar()); - typearray-> addRange(*C2); - Chmem = new SgVariableSymb("ch000m", *typearray, *func); - stFirstExecutableFunc->insertStmtBefore (*Chmem->makeVarDeclStmt ()); - return; -} - -void TypeControlOmpDebug(SgStatement *func, SgStatement *before) { - int n, k ; - SgCallStmt *call = new SgCallStmt(*new SgFunctionSymb(FUNCTION_NAME, "dbg_type_control", *SgTypeInt(), *func)); - TempVarOmpDebug(func); - nArrHandleCount = 1; - n = (bind_ == 1 ) ? 6 : 5; - //generating assign statement - // and inserting it before first executable statement - k = (bind_ == 1 ) ? 1 : 2; - call -> addArg(*new SgValueExp(n)); - call -> addArg(*new SgArrayRefExp(*symDynMP,*new SgValueExp(1))); - call -> addArg(*new SgArrayRefExp(*symDynMP,*new SgValueExp(n+1))); - call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k))); - call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k+10))); - if (sym_dbg_init == NULL) sym_dbg_init = new SgSymbol(PROCEDURE_NAME, "dbg_init"); - SgCallStmt *init = new SgCallStmt(*sym_dbg_init); - init->addArg(*varThreadID); - init->addAttribute(DEBUG_STAT); - before->insertStmtBefore(*init,*before->controlParent()); - if (sym_dbg_finalize == NULL) sym_dbg_finalize = new SgSymbol(PROCEDURE_NAME, "dbg_finalize"); - SgCallStmt *finalize = new SgCallStmt(*sym_dbg_finalize); - finalize->addAttribute(DEBUG_STAT); - func->lastNodeOfStmt ()->insertStmtBefore(*finalize,*func); - symDbgInitHandles = new SgSymbol(PROCEDURE_NAME, "dbg_init_handles"); - init = new SgCallStmt(*symDbgInitHandles); - init->addAttribute(DEBUG_STAT); - before->insertStmtBefore(*init,*before->controlParent()); - call->addAttribute(DEBUG_STAT); - before->insertStmtBefore(*call,*before->controlParent()); - if(bind_ == 1) - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*symDynMP,*C1)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Imem,*C1)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Lmem,*C1)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Rmem,*C1)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Dmem,*C1)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Chmem,*C1)),call); - if(bind_ == 1) - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*symDynMP,*C2)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Imem,*C2)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Lmem,*C2)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Rmem,*C2)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Dmem,*C2)),call); - doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Chmem,*C2)),call); - if(bind_ == 1) - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(1)),new SgValueExp(DVMTypeLength()),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(2)),new SgValueExp(TypeSize(SgTypeInt())),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(3)),new SgValueExp(TypeSize(SgTypeBool())),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(4)),new SgValueExp(TypeSize(SgTypeFloat())),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(5)),new SgValueExp(TypeSize(SgTypeDouble())),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(6)),new SgValueExp(TypeSize(SgTypeChar())),call); - if(bind_ == 1) - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(11)),new SgValueExp(DVMType()),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(12)),new SgValueExp(VarType_RTS(Imem)),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(13)),new SgValueExp(VarType_RTS(Lmem)),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(14)),new SgValueExp(VarType_RTS(Rmem)),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(15)),new SgValueExp(VarType_RTS(Dmem)),call); - doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(16)),new SgValueExp(5),call); - return; -} - -void InstrumentFunctionForOpenMPDebug(SgStatement *func, SgStatement *debug) { - SgStatement *stat; - SgStatement *stLastFunc = func->lastNodeOfStmt (); - SgStatement *stLastSpecFunc = GetLastDeclarationStatement(func); - SgStatement *stFirstExecutableFunc = GetFirstExecutableStatement(func); - if (func->variant () == PROG_HEDR) { - isMainProgram = 1; - char *data_str = new char[20]; - sprintf(data_str,"include 'dbg_vars.h'"); - SgStatement *st = new SgStatement(DATA_DECL);// creates DATA statement - SgExpression *es = new SgExpression(STMT_STR); - NODE_STR(es->thellnd) = data_str; - st -> setExpression(0,*es); - st->addAttribute(DEBUG_STAT); - stLastSpecFunc -> insertStmtAfter(*st); - stLastSpecFunc = st; - TypeControlOmpDebug (func, stFirstExecutableFunc); - } else { - char *data_str = new char[20]; - sprintf(data_str,"include 'dbg_vars.h'"); - SgStatement *st = new SgStatement(DATA_DECL);// creates DATA statement - SgExpression *es = new SgExpression(STMT_STR); - NODE_STR(es->thellnd) = data_str; - st -> setExpression(0,*es); - st->addAttribute(DEBUG_STAT); - stLastSpecFunc -> insertStmtAfter(*st); - stLastSpecFunc = st; - } - char *strStaticContext = new char [MaxContextBufferLength]; - for (stat=func; stat && stat != stLastFunc; stat=stat->lexNext ()) { - ClearArrayRefList (); - if (func->variant () != PROG_HEDR) { - if (stat == stLastSpecFunc) { - memset(strStaticContext, 0, MaxContextBufferLength); - strcat(strStaticContext,"*type=function"); - InstrumentFunctionBegin (stat, strStaticContext, func); - GenerateCallGetHandle (strStaticContext); - } - } - if (stat->getAttribute(0,DEBUG_STAT)!=NULL) continue; - if ((stat->variant () == FORALL_STAT) || - (stat->variant () == OMP_WORKSHARE_DIR)) { - stat=stat->lastNodeOfStmt (); - continue; - } - memset(strStaticContext, 0, MaxContextBufferLength); - if (stat->hasLabel ()&& (stat->variant() != FORMAT_STAT)&& (stat->variant() != CONT_STAT)) { - SgStatement *tmp = new SgStatement (CONT_STAT); - tmp->setLabel (*stat->label ()); - stat->insertStmtBefore(*tmp, *stat->controlParent()); - BIF_LABEL(stat->thebif)=NULL; - } - /*if (stat->variant () == ARITHIF_NODE) { - ArithIF_to_IfGoto(stat); - continue; - } - if (stat->variant () == COMGOTO_NODE) { - ComputedGoTo_to_IfGoto(stat); - continue; - }*/ - if (stat->variant () == COMM_STAT) { - if (omp_debug>=D3){ - RegisterCommonBlock (stat, func); - } - continue; - } - if (stat->variant () == OMP_PARALLEL_DIR) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=parallel"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpParallelDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_DO_DIR) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=omploop"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpDoDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == DVM_INTERVAL_DIR) { - if (omp_debug==DPERF){ - OpenInterval(stat); - } - continue; - } - if (stat->variant () == DVM_ENDINTERVAL_DIR) { - if (omp_debug==DPERF){ - if(!St_frag){ - err("Unmatched directive",182,stat); - break; - } - if(St_frag && St_frag->begin_st && (St_frag->begin_st->controlParent() != stat->controlParent())) - err("Misplaced directive",103,stat); //interval must be a block - strcat(strStaticContext,"*type=interval"); - GenerateFileAndLine (St_frag->begin_st, strStaticContext); - InstrumentIntervalDir (St_frag->begin_st, stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - CloseInterval(); - } - continue; - } - if (stat->variant () == FOR_NODE) { - if (omp_debug>=D2 && omp_debug!=DPERF){ - strcat(strStaticContext,"*type=seqloop"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentSerialDoLoop (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant()== IF_NODE) { - if (omp_debug>=D3) { - strcat(strStaticContext,"*type=file_name"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentIfStat (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant()==ALLOCATE_STMT) { - RegisterAllocatableArrays (stat); - continue; - } - if (stat->variant()==DEALLOCATE_STMT) { - UnregisterAllocatableArrays (stat); - continue; - } - //NULLIFY_STMT - if (stat->variant () == ASSIGN_STAT) { - //printf ("%d\n",stat->expr(0)->variant()); - //if (stat->expr(0)->lhs()&&stat->expr(0)->lhs()->lhs()) - // printf ("-%d\n",stat->expr(0)->lhs()->lhs()->variant()); - if (omp_debug>=D3) { - strcat(strStaticContext,"*type=file_name"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentAssignStat (stat, strStaticContext); - } - continue; - } - if (stat->variant () == PROC_STAT) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=func_call"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentProcStat (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_SINGLE_DIR) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=single"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpSingleDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_CRITICAL_DIR) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=critical"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpCriticalDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_ORDERED_DIR) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=ordered"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpOrderelDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_MASTER_DIR) { - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=master"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpMasterDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if ((stat->variant () == OMP_BARRIER_DIR) || (stat->variant () == DVM_BARRIER_DIR)){ - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=barrier"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpBarrierDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_FLUSH_DIR){ - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=flush"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpFlushDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_THREADPRIVATE_DIR){ - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=threadprivate"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpThreadPrivateDir(stat, stFirstExecutableFunc, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_SECTIONS_DIR){ - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=sections"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpSectionsDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_SECTION_DIR){ - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=sect_ev"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpSectionDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if (stat->variant () == OMP_WORKSHARE_DIR){ - if (omp_debug>=D2){ - strcat(strStaticContext,"*type=workshare"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpWorkshareDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - if ((stat->variant () == EXIT_STMT) || - (stat->variant () == STOP_STAT)) { - if (omp_debug>=D2){ - InstrumentExitFromLoops (stat); - InstrumentExitStmt (stat); - } - continue; - } - if (stat->variant () == RETURN_STAT) { - if (omp_debug>=D2){ - InstrumentExitFromLoops (stat); - InstrumentFunctionEnd (stat, func); - } - continue; - } - if (stat->variant () == GOTO_NODE) { - if (omp_debug>=D2){ - InstrumentGotoStmt (stat); - } - continue; - } - if (isIOStmt (stat)){ - if (omp_debug==DPERF){ - strcat(strStaticContext,"*type=io"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentIOStmt (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); - } - continue; - } - - } - if ((stat->variant () == CONTROL_END) && ((stat->controlParent ()->variant () == FUNC_HEDR) || (stat->controlParent ()->variant () == PROC_HEDR))) { - if (omp_debug>=D2){ - InstrumentFunctionEnd (stat, func); - } - } - delete strStaticContext; -} - -void FindOrDeclareOmpDebugVariables (SgStatement *debug) { - SgStatement *stat; - SgSymbol *symThreadID=NULL; - stLastDebug = debug->lastNodeOfStmt (); - SgStatement *stLastSpecDebug = GetLastDeclarationStatement(debug); - for (stat=debug; stat && (stat != stLastSpecDebug->lexNext ()); stat=stat->lexNext ()) { - if (stat->variant () == EXTERN_STAT) { - FindExternalProcedures (stat); - continue; - } - SgVarListDeclStmt *vardecl = isSgVarListDeclStmt (stat); - if (vardecl != NULL) { - for (int i=0; i< vardecl->numberOfSymbols(); i++) { - SgSymbol *sym = vardecl->symbol(i); - if (!strcmp (sym->identifier(),"ithreadid")) { - symThreadID = sym; - continue; - } - if (!strcmp (sym->identifier(),"dbg_get_addr")) { - sym_dbg_get_addr = sym; - continue; - } - if (!strcmp (sym->identifier(),"istat_mp")) { - symStatMP = sym; - SgArrayType *ArrStaticHandle = isSgArrayType (sym->type()); - if (ArrStaticHandle != NULL) { - if (ArrStaticHandle->dimension() == 1) { - if (ArrStaticHandle->sizeInDim(0)->isInteger ()) { - nArrStaticHandleCount=ArrStaticHandle->sizeInDim(0)->valueInteger (); - } - } - } - continue; - } - if (!strcmp (sym->identifier(),"idyn_mp")) { - symDynMP = sym; - SgArrayType *ArrHandle = isSgArrayType (sym->type()); - if (ArrHandle != NULL) { - if (ArrHandle->dimension() == 1) { - if (ArrHandle->sizeInDim(0)->isInteger ()) { - nArrHandleCount=ArrHandle->sizeInDim(0)->valueInteger (); - } - } - } - } - } - } else { - SgVarDeclStmt *vardec = isSgVarDeclStmt (stat); - if (vardec != NULL) { - for (int i=0; i< vardec->numberOfSymbols(); i++) { - SgSymbol *sym = vardec->symbol(i); - if (!strcmp (sym->identifier(),"ithreadid")) { - symThreadID = sym; - continue; - } - if (!strcmp (sym->identifier(),"dbg_get_addr")) { - sym_dbg_get_addr = sym; - continue; - } - } - } - } - } - if (nArrStaticHandleCount == 0) { - (void)fprintf (stderr, "Error: Array istat_mp in file \"dbg_vars.h\" not found\n"); - exit(1); - } - if (nArrHandleCount == 0) { - (void)fprintf (stderr, "Error: Array idyn_mp in file \"dbg_vars.h\" not found\n"); - exit(1); - } - nMaxArrHandleCount = nArrHandleCount; - if (symThreadID == NULL) { - SgExprListExp *list = NULL; - symThreadID = new SgSymbol(VARIABLE_NAME, "ithreadid"); - varThreadID = new SgVarRefExp(symThreadID); - sym_dbg_get_addr = new SgSymbol(VARIABLE_NAME, "dbg_get_addr"); - list = new SgExprListExp (*varThreadID); - SgType *type = NULL; - if (len_DvmType) { - SgExpression *le = new SgExpression(LEN_OP); - le->setLhs(new SgValueExp(8)); - type = new SgType(T_INT, le, SgTypeInt()); - } else { - type = new SgType(T_INT); - } - if (symStatMP!=NULL) list->append (*new SgVarRefExp(symStatMP)); - if (symDynMP!=NULL) list->append (*new SgVarRefExp(symDynMP)); - if (sym_dbg_get_addr!=NULL) list->append (*new SgVarRefExp(sym_dbg_get_addr)); - SgVarDeclStmt *vdecl = new SgVarDeclStmt (*list,*type); - vdecl->addAttribute(DEBUG_STAT); - stLastSpecDebug->insertStmtAfter(*vdecl); - } else { - varThreadID = new SgVarRefExp(symThreadID); - } -} -int ompdbgvar=0; -void Arg_FunctionCallSearch(SgExpression *e, SgStatement *st, SgExpression *parent, int left); -SgExpression *GenerateTemporaryVariable (SgType *type, SgStatement *stat) { - char *strString = new char [12]; - sprintf (strString,"dbgomp%d", ompdbgvar++); - SgStatement *scope = stat->getScopeForDeclare(); - SgSymbol *sym = new SgSymbol(VARIABLE_NAME, strString, type, scope); - if (type->variant()==T_FLOAT) sym->setType (new SgType (T_DOUBLE)); - SgExpression *expr = new SgVarRefExp (*sym); - SgStatement *stLastSpecDebug = GetLastDeclarationStatement(scope); - SgStatement *thrprivate = new SgStatement (OMP_THREADPRIVATE_DIR); - thrprivate->setExpression(0, *new SgExprListExp (*expr)); - thrprivate->setlineNumber(stat->lineNumber()); - stLastSpecDebug->insertStmtAfter(*thrprivate,*stLastSpecDebug->controlParent()); - SgStatement *vardecl = sym->makeVarDeclStmt (); - sym->addAttribute(SAVE_VAR); - vardecl->setlineNumber(stat->lineNumber()); - SgExprListExp *exprlist = isSgExprListExp(vardecl->expr(2)); - if (exprlist != NULL) exprlist->append(*new SgAttributeExp(SAVE_OP)); - else { - exprlist = new SgExprListExp (*new SgAttributeExp(SAVE_OP)); - vardecl->setExpression(2,*exprlist); - } - stLastSpecDebug->insertStmtAfter(*vardecl); - return expr; -} - -void FunctionCallSearch(SgExpression *e, SgStatement *st,SgExpression *parent, int left) -{ - SgExpression *el; - if(!e)return; - if(isSgFunctionCallExp(e)) { - for(el=e->lhs(); el; el=el->rhs()) - Arg_FunctionCallSearch(el->lhs(),st,el,1); - if (parent) { - if (e->symbol()->type()){ - SgExpression *var=GenerateTemporaryVariable (e->symbol()->type(), st); - SgAssignStmt *as=new SgAssignStmt (*var,*e); - as->setlineNumber (st->lineNumber()); - st->insertStmtBefore(*as,*st->controlParent()); - if (left){ - parent->setLhs (*var); - } else { - parent->setRhs (*var); - } - } - } - return; - } - if ((e->variant ()!= ASSGN_OP) && (e->variant ()!= POINTST_OP)) - FunctionCallSearch(e->lhs(),st,e,1); - FunctionCallSearch(e->rhs(),st,e,0); - return; -} - -void Arg_FunctionCallSearch(SgExpression *e, SgStatement *st, SgExpression *parent, int left) -{ - if (!e->rhs ()) { - FunctionCallSearch(e,st,parent,left); - } else { - if (parent) { - if (e->type()) { - SgExpression *var=GenerateTemporaryVariable (e->type(), st); - SgAssignStmt *as=new SgAssignStmt (*var,*e); - as->setlineNumber (st->lineNumber()); - st->insertStmtBefore(*as,*st->controlParent()); - if (left){ - parent->setLhs (*var); - } else { - parent->setRhs (*var); - } - FunctionCallSearch(as->expr(0),as,NULL,1); // left part - FunctionCallSearch(as->expr(1),as,NULL,0); // right part - } - } - } - return; -} - -void InstrumentForOpenMPDebug(SgFile *f) { - SgStatement *stat, *func=NULL; - SgStatement *debug=NULL; - stat = f->firstStatement(); // file header - C4=new SgValueExp(4); - C3=new SgValueExp(3); - C2=new SgValueExp(2); - C1=new SgValueExp(1); - C0=new SgValueExp(0); - M1=new SgValueExp(-1); - nfrag = 0 ; //counter of intervals for performance analizer - St_frag = NULL; - for(stat=stat->lexNext(); stat; stat=stat->lastNodeOfStmt()->lexNext ()) { - // PROGRAM, SUBROUTINE, FUNCTION header - if (stat->variant () != PROC_HEDR) continue; - if(!strcmp(stat->symbol()->identifier(),"dbg_init_handles")) { - debug = func = stat; - break; - } - } - if (func == NULL) { - (void)fprintf (stderr, "Error: Subroutine DBG_Init_Handles in file \"dbg_init.h\" not found\n"); - exit(1); - } - FindOrDeclareOmpDebugVariables (func); - stat = f->firstStatement(); // file header - for(stat=stat->lexNext(); stat; stat=stat->lexNext ()) { - if (!strcmp(stat->fileName(),"dbg_init.h")) { - stat=stat->lastNodeOfStmt(); - continue; - } - if (stat->variant () == COMM_STAT) { - MarkSymbolsInCommon(stat); - continue; - } - if (stat->variant () == SAVE_DECL) { - MarkSymbolsInSave(stat); - continue; - } - if (stat->variant () == VAR_DECL) { - MarkSymbolsInDecl(stat); - continue; - } - if(stat->variant () == DATA_DECL) { - continue; - } - if ((stat->variant () == PROC_HEDR) || - (stat->variant () == FUNC_HEDR)) { - MarkFormalParameters (stat); - continue; - } - if (stat->variant () == FOR_NODE) { - ConvertLoopWithLabelToEnddoLoop (stat); - continue; - } - if (stat->variant()== ELSEIF_NODE) { - ConvertElseIFToElse_IF(stat); - } - if (stat->variant () == LOGIF_NODE) { - LogIf_to_IfThen(stat); - } - if (stat->variant () == OMP_ATOMIC_DIR) { - SgStatement *assign = stat->lexNext (); - if (atomic_varref == NULL) { - atomic_varref = new SgVarRefExp(*new SgSymbol (VARIABLE_NAME, "dbg_atomic")); - } - stat->setExpression (0, *atomic_varref); - stat->setVariant (OMP_CRITICAL_DIR); - SgStatement *endst = new SgStatement (OMP_END_CRITICAL_DIR); - endst->setlineNumber (stat->lineNumber ()); - endst->setExpression (0, *atomic_varref); - assign->insertStmtAfter (*endst, *stat); - SgStatement *tmp = &assign->copy (); - tmp->setlineNumber (assign->lineNumber ()); - assign->insertStmtAfter (*tmp, *stat); - assign->extractStmt (); - continue; - } - if (stat->variant () == OMP_PARALLEL_DO_DIR) { - stat->setVariant (OMP_PARALLEL_DIR); - SgExprListExp *list = NULL; - SgExprListExp *parallel_clause = NULL; - SgExprListExp *do_clause = NULL; - if (stat->expr(0) != NULL) { - list = isSgExprListExp (stat->expr(0)); - for (int i=0; ilength (); i++) { - SgExpression *exp = list->elem (i); - switch (exp->variant ()) { - case OMP_SCHEDULE: - case OMP_ORDERED: - case OMP_LASTPRIVATE: { - if (do_clause != NULL) { - do_clause->append (*exp); - } else { - do_clause = new SgExprListExp (*exp); - } - break; - } - default: { - if (parallel_clause != NULL) { - parallel_clause->append (*exp); - } else { - parallel_clause = new SgExprListExp (*exp); - } - break; - } - } - } - } - if (parallel_clause != NULL) stat->setExpression (0, *parallel_clause); - else BIF_LL1(stat->thebif)=NULL; - ConvertLoopWithLabelToEnddoLoop (stat->lexNext ()); - SgForStmt *forst= isSgForStmt (stat->lexNext ()); - if (forst) { - SgStatement *last = GetLastStatementOfLoop (forst)->lexNext (); - if (last->variant () == OMP_END_PARALLEL_DO_DIR) { - SgStatement * tmp = last; - last=last->lexNext (); - tmp->extractStmt (); - } - SgStatement *dodir = new SgStatement (OMP_DO_DIR); - if (do_clause != NULL) dodir->setExpression (0, *do_clause); - dodir->setlineNumber (stat->lineNumber ()); - SgStatement *enddodir = new SgStatement (OMP_END_DO_DIR); - SgStatement *endparalleldir = new SgStatement (OMP_END_PARALLEL_DIR); - enddodir->setlineNumber (last->lineNumber ()); - endparalleldir->setlineNumber (last->lineNumber ()); - forst->insertStmtBefore (*dodir, *stat); - if (forst->controlParent () != NULL) { - PTR_BLOB bl1,bl2,blob=NULL; - for (bl1 = bl2 = BIF_BLOB1(forst->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { - if (BLOB_VALUE (bl1) == forst->thebif) { - BLOB_NEXT (bl2) = BLOB_NEXT (bl1); - blob=bl1; - } - bl2 = bl1; - } - for (bl1 = bl2 = BIF_BLOB2(forst->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { - if (BLOB_VALUE (bl1) == forst->thebif) { - BLOB_NEXT (bl2) = BLOB_NEXT (bl1); - blob=bl1; - } - bl2 = bl1; - } - } - appendBfndToList1(forst->thebif, stat->thebif); - last->insertStmtBefore (*enddodir, *stat); - last->insertStmtBefore (*endparalleldir, *stat); - } - continue; - } - if (stat->variant () == OMP_PARALLEL_SECTIONS_DIR) { - stat->setVariant (OMP_SECTIONS_DIR); - SgExprListExp *list = NULL; - SgExprListExp *parallel_clause = NULL; - SgExprListExp *section_clause = NULL; - if (stat->expr(0) != NULL) { - list = isSgExprListExp (stat->expr(0)); - for (int i=0; ilength (); i++) { - SgExpression *exp = list->elem (i); - switch (exp->variant ()) { - case OMP_LASTPRIVATE: { - if (section_clause != NULL) { - section_clause->append (*exp); - } else { - section_clause = new SgExprListExp (*exp); - } - break; - } - default: { - if (parallel_clause != NULL) { - parallel_clause->append (*exp); - } else { - parallel_clause = new SgExprListExp (*exp); - } - break; - } - } - } - } - SgStatement *last = stat->lastNodeOfStmt (); - last->setVariant (OMP_END_SECTIONS_DIR); - if (section_clause != NULL) stat->setExpression (0, *section_clause); - else BIF_LL1(stat->thebif)=NULL; - SgStatement *parallel = new SgStatement (OMP_PARALLEL_DIR); - if (parallel_clause != NULL) parallel->setExpression (0, *parallel_clause); - parallel->setlineNumber (stat->lineNumber ()); - SgStatement *endparallel = new SgStatement (OMP_END_PARALLEL_DIR); - endparallel->setlineNumber (last->lineNumber ()); - stat->insertStmtBefore (*parallel, *stat->controlParent()); - last->insertStmtAfter (*endparallel, *stat->controlParent()); - if (stat->controlParent () != NULL) { - PTR_BLOB bl1,bl2,blob=NULL; - for (bl1 = bl2 = BIF_BLOB1(stat->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { - if (BLOB_VALUE (bl1) == stat->thebif) { - BLOB_NEXT (bl2) = BLOB_NEXT (bl1); - blob=bl1; - } - bl2 = bl1; - } - } - if (stat->controlParent () != NULL) { - PTR_BLOB bl1,bl2,blob=NULL; - for (bl1 = bl2 = BIF_BLOB1(stat->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { - if (BLOB_VALUE (bl1) == endparallel->thebif) { - BLOB_NEXT (bl2) = BLOB_NEXT (bl1); - blob=bl1; - } - bl2 = bl1; - } - } - appendBfndToList1(stat->thebif, parallel->thebif); - appendBfndToList1(endparallel->thebif, parallel->thebif); - continue; - } - if (stat->variant () == OMP_PARALLEL_WORKSHARE_DIR) { - stat->setVariant (OMP_PARALLEL_DIR); - SgExprListExp *list = NULL; - SgExprListExp *parallel_clause = NULL; - SgExprListExp *workshare_clause = NULL; - if (stat->expr(0) != NULL) { - list = isSgExprListExp (stat->expr(0)); - for (int i=0; ilength (); i++) { - SgExpression *exp = list->elem (i); - switch (exp->variant ()) { - case OMP_SCHEDULE: - case OMP_ORDERED: - case OMP_LASTPRIVATE: { - if (workshare_clause != NULL) { - workshare_clause->append (*exp); - } else { - workshare_clause = new SgExprListExp (*exp); - } - break; - } - default: { - if (parallel_clause != NULL) { - parallel_clause->append (*exp); - } else { - parallel_clause = new SgExprListExp (*exp); - } - break; - } - } - } - } - SgStatement *last = stat->lastNodeOfStmt (); - if (parallel_clause != NULL) stat->setExpression (0, *parallel_clause); - else BIF_LL1(stat->thebif)=NULL; - SgStatement *workshare = new SgStatement (OMP_WORKSHARE_DIR); - if (workshare_clause != NULL) workshare->setExpression (0, *workshare_clause); - workshare->setlineNumber (stat->lineNumber ()); - SgStatement *endworkshare = new SgStatement (OMP_END_WORKSHARE_DIR); - endworkshare->setlineNumber (last->lineNumber ()); - last->setVariant (OMP_END_PARALLEL_DIR); - stat->insertStmtAfter (*workshare, *stat); - last->insertStmtBefore (*endworkshare, *stat); - continue; - } - if (omp_debug>=D5) { - switch (stat->variant()) { - case ENTRY_STAT: - // !!!!!!! - break; - case SWITCH_NODE: // SELECT CASE ... - case ARITHIF_NODE: // Arithmetical IF - case IF_NODE: // IF... THEN - case WHILE_NODE: // DO WHILE (...) - case CASE_NODE: // CASE ... - case ELSEIF_NODE: // ELSE IF... - case LOGIF_NODE: // Logical IF - FunctionCallSearch(stat->expr(0),stat,NULL,1); - break; - case COMGOTO_NODE: // Computed GO TO - case OPEN_STAT: - case CLOSE_STAT: - case INQUIRE_STAT: - case BACKSPACE_STAT: - case ENDFILE_STAT: - case REWIND_STAT: - FunctionCallSearch(stat->expr(1),stat,NULL,0); - break; - case PROC_STAT: { // CALL - SgExpression *el; - // looking through the arguments list - for(el=stat->expr(0); el; el=el->rhs()) - Arg_FunctionCallSearch(el->lhs(),stat,el,1); // argument - } - break; - case ASSIGN_STAT: // Assign statement - FunctionCallSearch(stat->expr(0),stat,NULL,1); // left part - FunctionCallSearch(stat->expr(1),stat,NULL,0); // right part - break; - case WRITE_STAT: - case READ_STAT: - case PRINT_STAT: - case FOR_NODE: - FunctionCallSearch(stat->expr(0),stat,NULL,1); // left part - FunctionCallSearch(stat->expr(1),stat,NULL,0); // right part - break; - } - } - } - if (omp_debug>=D3){ - for (SgSymbol *sym=f->firstSymbol(); sym; sym=sym->next ()) { - RegisterSymbol (sym); - } - } - stat = f->firstStatement(); // file header - for(stat=stat->lexNext(); stat; stat=stat->lastNodeOfStmt()->lexNext ()) { - if(strcmp(stat->symbol()->identifier(),"dbg_init_handles")) { - InstrumentFunctionForOpenMPDebug (stat, func); - } - } - if (symStatMP != NULL) { - SgArrayType *type = isSgArrayType (symStatMP->type()); - if (type != NULL) { - if (TYPE_RANGES(type->thetype) != NULL) { - if (NODE_OPERAND0(TYPE_RANGES(type->thetype)) != NULL) { - if (NODE_OPERAND0(TYPE_RANGES(type->thetype))->variant == INT_VAL) { - NODE_INT_CST_LOW (NODE_OPERAND0(TYPE_RANGES(type->thetype))) = nArrStaticHandleCount; - } - } - } - } - } - if (symDynMP != NULL) { - SgArrayType *type = isSgArrayType (symDynMP->type()); - if (type != NULL) { - if (TYPE_RANGES(type->thetype) != NULL) { - if (NODE_OPERAND0(TYPE_RANGES(type->thetype)) != NULL) { - if (NODE_OPERAND0(TYPE_RANGES(type->thetype))->variant == INT_VAL) { - NODE_INT_CST_LOW (NODE_OPERAND0(TYPE_RANGES(type->thetype))) = nMaxArrHandleCount; - } - } - } - } - } - if (debug != NULL) { - DeclareExternalProcedures (GetLastDeclarationStatement(debug)); - UpdateIncludeVarsFile(debug, "dbg_vars.h"); - UpdateIncludeInitFile(debug, "dbg_init.h"); - } -} - -void RegisterSymbol(SgSymbol *sym) { - if (sym->variant ()== VARIABLE_NAME) { - RegistrateVariable (sym); - } -} - -void DBGSearchVarsInExpression (SgExpression *exp) { - if (exp == NULL) return; - if (exp->symbol() != NULL) { - RegisterSymbol(exp->symbol ()); - } - DBGSearchVarsInExpression (exp->lhs()); - DBGSearchVarsInExpression (exp->rhs()); -} - -void DBGSearchVarsInFunction (SgStatement *func) { - return; - SgStatement *st; - for (st=func; st; st=st->lexNext ()) { - if (st->hasSymbol ()) { - RegisterSymbol (st->symbol ()); - } else { - for (int i=0; i<3; i++) { - DBGSearchVarsInExpression (st->expr(i)); - } - } - } -} - -void RegistrateVariable (SgSymbol *sym) { - if (sym->type()->variant () == T_ARRAY) { - RegisterArray(sym); - } else { - RegisterVar(sym); - } -} - -void RegisterVar (SgSymbol *sym) { - SgStatement *stFirst = NULL; - SgCallStmt *fe; - if (!strcmp (sym->identifier(),"dbg_get_addr")) return; - if (!strcmp (sym->identifier(),"ithreadid")) return; - if (!strcmp (sym->identifier(),"dbg000")) return; - if (!strcmp (sym->identifier(),"mem000")) return; - if (!strcmp (sym->identifier(),"heap00")) return; - if (!strcmp (sym->identifier(),"dbg_atomic")) return; - if (sym->scope () != NULL) { - stFirst = GetFirstExecutableNotDebugStatement(sym->scope ()); - } - if (stFirst == NULL) return; - SgStatement *stDeclared = sym->declaredInStmt (); - if (stDeclared == NULL) stDeclared = stFirst; - char *strStaticContext = new char [MaxContextBufferLength]; - memset(strStaticContext, 0, MaxContextBufferLength); - strcat(strStaticContext,"*type=var_name"); - GenerateFileAndLine (stDeclared, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE - sprintf (strStaticContext,"%s*name1=%s*vtype=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),((sym->getAttribute(0,COMMON_VAR)==NULL)?0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); - int *pos = new int; - pos = ((int *)sym->attributeValue(0,FORMAL_PARAM)); - if (pos != NULL) { - if (sym_dbg_regparvar == NULL) sym_dbg_regparvar = new SgSymbol (PROCEDURE_NAME, "dbg_regparvar"); - fe = new SgCallStmt(*sym_dbg_regparvar); - } else { - if (sym_dbg_regvar == NULL) sym_dbg_regvar = new SgSymbol (PROCEDURE_NAME, "dbg_regvar"); - fe = new SgCallStmt(*sym_dbg_regvar); - } - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgVarRefExp(sym)); - if (pos != NULL) { - fe->addArg(*new SgValueExp (*pos)); - } - fe->addAttribute(DEBUG_STAT); - stFirst->insertStmtBefore(*fe, *stFirst->controlParent()); - sym->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); - GenerateCallGetHandle (strStaticContext); -} - -SgExpression *GetLeftBoundFunction(SgSymbol *ar, int i) { - SgFunctionCallExp *fe; - // generating function call: LBOUND(ARRAY, DIM) - if(!FuncLeftBound) - FuncLeftBound = new SgFunctionSymb(FUNCTION_NAME, "lbound", *SgTypeInt(), *ar->scope()); - fe = new SgFunctionCallExp(*FuncLeftBound); - fe -> addArg(*new SgArrayRefExp(*ar));//array - if(i != 0) fe -> addArg(*new SgValueExp(i)); // dimension number - return(fe); -} - -SgExpression *GetRightBoundFunction(SgSymbol *ar, int i) { - SgFunctionCallExp *fe; - // generating function call: UBOUND(ARRAY, DIM) - if(!FuncRightBound) FuncRightBound = new SgFunctionSymb(FUNCTION_NAME, "ubound", *SgTypeInt(), *ar->scope()); - fe = new SgFunctionCallExp(*FuncRightBound); - fe -> addArg(*new SgArrayRefExp(*ar));//array - if(i != 0) fe -> addArg(*new SgValueExp(i)); // dimension number - return(fe); -} - -void RegisterArray (SgSymbol *sym) { - SgStatement *stFirst = NULL; - SgCallStmt *fe = NULL; - if (IS_ALLOCATABLE_POINTER (sym)) return; - if (!strcmp (sym->identifier(),"istat_mp")) return; - if (!strcmp (sym->identifier(),"idyn_mp")) return; - if (sym->scope () != NULL) { - stFirst = GetFirstExecutableNotDebugStatement(sym->scope ()); - } - if (stFirst == NULL) return; - SgExpression **arrFirstElement = new (SgExpression *); - *arrFirstElement = FirstArrayElement(sym); - SgArrayType *arType= isSgArrayType(sym->type()); - SgExpression *arrLowerSize = NULL; - SgExpression *arrUpperSize = NULL; - SgStatement *stDeclared = sym->declaredInStmt (); - if (stDeclared == NULL) stDeclared = stFirst; - char *strStaticContext = new char [MaxContextBufferLength]; - memset(strStaticContext, 0, MaxContextBufferLength); - strcat(strStaticContext,"*type=arr_name"); - GenerateFileAndLine (stDeclared, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE - sprintf (strStaticContext,"%s*name1=%s*vtype=%d*rank=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),arType->dimension(),((sym->getAttribute(0,COMMON_VAR)==NULL) ? 0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); - nArrHandleCount=1; - if (arType != NULL) { - for (int i=0; idimension(); i++) { - SgExpression *exp = arType->sizeInDim(i); - SgSubscriptExp *sbe = isSgSubscriptExp(exp); - if (sbe != NULL) { - if ((sbe->ubound() == NULL)||(sbe->ubound()->variant() == STAR_RANGE)) { - sprintf (strStaticContext,"%s*isassumed=1",strStaticContext); - if (sbe->lbound() != NULL) { - arrUpperSize = sbe->lbound(); - arrLowerSize = sbe->lbound(); - } else { - Error("Assumed-size array: %s",sym->identifier(), 162, stFirst); - } - } else { - if(sbe->lbound() != NULL) { - arrLowerSize = sbe->lbound(); - } else { - arrLowerSize = C1; - } - if(sbe->ubound() != NULL) { - arrUpperSize = sbe->ubound(); - } - } - } else { - if(exp->variant() != STAR_RANGE) {// dim=ubound = * - arrLowerSize = C1; - arrUpperSize = exp; - } else { - sprintf (strStaticContext,"%s*isassumed=1",strStaticContext); - arrUpperSize = C1; - arrLowerSize = C1; - } - } - doOmpAssignStmt(arrLowerSize, stFirst); - doOmpAssignStmt(arrUpperSize, stFirst); - } - int *pos = new int; - pos = ((int *)sym->attributeValue(0,FORMAL_PARAM)); - if (pos != NULL) { - if (sym_dbg_regpararr == NULL) sym_dbg_regpararr = new SgSymbol (PROCEDURE_NAME, "dbg_regpararr"); - fe = new SgCallStmt(*sym_dbg_regpararr); - } else { - if (sym_dbg_regarr == NULL) sym_dbg_regarr = new SgSymbol (PROCEDURE_NAME, "dbg_regarr"); - fe = new SgCallStmt(*sym_dbg_regarr); - } - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - SgArrayRefExp *arrDynamicRef = new SgArrayRefExp(*symDynMP,*C1); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*arrDynamicRef); - fe->addArg(**arrFirstElement); - if (pos != NULL) { - fe->addArg(*new SgValueExp (*pos)); - } - fe->addAttribute(DEBUG_STAT); - stFirst->insertStmtBefore(*fe, *stFirst->controlParent()); - sym->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); - sym->addAttribute (FIRST_ELEM, (void *)arrFirstElement, sizeof(SgExpression *)); - GenerateCallGetHandle (strStaticContext); - } -} - -void RegisterAllocatableArrays (SgStatement *stat) { - SgCallStmt *fe = NULL; - SgExprListExp *list = isSgExprListExp(stat->expr(0)); - SgStatement *next=stat->lexNext(); - for (int i=0; ilength (); i++) { - if (list->elem(i)->variant()==ARRAY_REF) { - SgSymbol *sym = list->elem(i)->symbol(); - SgExprListExp *arrlist = isSgExprListExp(list->elem(i)->lhs ()); - SgArrayRefExp *leftbound = new SgArrayRefExp (*sym); - SgArrayRefExp *rightbound = new SgArrayRefExp (*sym); - nArrHandleCount=1; - if (arrlist) { - for (int j=0;jlength();j++) { - if (arrlist->elem(j)->variant()==DDOT) { - leftbound->addSubscript(*arrlist->elem(j)->lhs()); - rightbound->addSubscript(*arrlist->elem(j)->rhs()); - doOmpAssignStmt(arrlist->elem(j)->lhs(), next); - doOmpAssignStmt(arrlist->elem(j)->rhs(), next); - } else { - leftbound->addSubscript(*C1); - rightbound->addSubscript(*arrlist->elem(j)); - doOmpAssignStmt(C1, next); - doOmpAssignStmt(arrlist->elem(j), next); - } - } - } - SgExpression **arrFirstElement = new (SgExpression *); - *arrFirstElement = leftbound; - SgArrayType *arType= isSgArrayType(sym->type()); - //SgStatement *stDeclared = sym->declaredInStmt (); - //if (stDeclared == NULL) stDeclared = stat; - char *strStaticContext = new char [MaxContextBufferLength]; - memset(strStaticContext, 0, MaxContextBufferLength); - strcat(strStaticContext,"*type=arr_name"); - GenerateFileAndLine (stat, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE - sprintf (strStaticContext,"%s*name1=%s*vtype=%d*rank=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),arType->dimension(),((sym->getAttribute(0,COMMON_VAR)==NULL) ? 0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); - if (sym_dbg_regarr == NULL) sym_dbg_regarr = new SgSymbol (PROCEDURE_NAME, "dbg_regarr"); - fe = new SgCallStmt(*sym_dbg_regarr); - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - SgArrayRefExp *arrDynamicRef = new SgArrayRefExp(*symDynMP,*C1); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*arrDynamicRef); - fe->addArg(**arrFirstElement); - fe->addAttribute(DEBUG_STAT); - next->insertStmtBefore(*fe, *next->controlParent()); - for (int j=0; jnumberOfAttributes();j++) { - if ((sym->attributeType(j)==STATIC_CONTEXT) || - (sym->attributeType(j)==FIRST_ELEM)) - sym->deleteAttribute(j); - } - sym->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); - sym->addAttribute (FIRST_ELEM, (void *)arrFirstElement, sizeof(SgExpression *)); - GenerateCallGetHandle (strStaticContext); - } - } -} - -void UnregisterAllocatableArrays (SgStatement *stat) { - SgCallStmt *fe = NULL; - SgExprListExp *list = isSgExprListExp(stat->expr(0)); - for (int i=0; ilength (); i++) { - if (list->elem(i)->variant()==ARRAY_REF) { - SgSymbol *sym = list->elem(i)->symbol(); - SgExpression **arrFirstElement = NULL; - arrFirstElement = new (SgExpression *); - arrFirstElement = (SgExpression **) sym->attributeValue(0,FIRST_ELEM); - SgArrayType *arType= isSgArrayType(sym->type()); - char *strStaticContext = new char [MaxContextBufferLength]; - memset(strStaticContext, 0, MaxContextBufferLength); - strcat(strStaticContext,"*type=arr_name"); - GenerateFileAndLine (stat, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE - sprintf (strStaticContext,"%s*name1=%s*vtype=%d*rank=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),arType->dimension(),((sym->getAttribute(0,COMMON_VAR)==NULL) ? 0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); - if (sym_dbg_unregarr == NULL) sym_dbg_unregarr = new SgSymbol (PROCEDURE_NAME, "dbg_unregarr"); - fe = new SgCallStmt(*sym_dbg_unregarr); - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)sym->attributeValue(0,STATIC_CONTEXT); - if (StatContext != NULL) { - fe->addArg(**StatContext); - } - fe->addArg(*varThreadID); - if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - for (int j=0; jnumberOfAttributes();j++) { - if ((sym->attributeType(j)==STATIC_CONTEXT) || - (sym->attributeType(j)==FIRST_ELEM)) - sym->deleteAttribute(j); - } - GenerateCallGetHandle (strStaticContext); - } - } -} - -void InstrumentOmpParallelDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - SgCallStmt *fperf = NULL; - if (sym_dbg_before_parallel == NULL) sym_dbg_before_parallel = new SgSymbol (PROCEDURE_NAME, "dbg_before_parallel"); - if (sym_dbg_after_parallel == NULL) sym_dbg_after_parallel = new SgSymbol (PROCEDURE_NAME, "dbg_after_parallel"); - if (sym_dbg_parallel_event == NULL) sym_dbg_parallel_event = new SgSymbol (PROCEDURE_NAME, "dbg_parallel_event"); - if (omp_debug == DPERF) { - if (sym_dbg_interval_begin == NULL) sym_dbg_interval_begin = new SgSymbol (PROCEDURE_NAME, "dbg_interval_begin"); - if (sym_dbg_interval_end == NULL) sym_dbg_interval_end = new SgSymbol (PROCEDURE_NAME, "dbg_interval_end"); - if (sym_dbg_parallel_event_end == NULL) sym_dbg_parallel_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_parallel_event_end"); - } - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_parallel); - SgExprListExp *exp = isSgExprListExp (st->expr(0)); - nArrHandleCount = 1; - int nNumThreads = 0; - int nIfExpr = 0; - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - if (ex->variant () == OMP_NUM_THREADS){ - nNumThreads = nArrHandleCount; - doOmpAssignStmt (ex->lhs(),st); - continue; - } - if (ex->variant () == OMP_IF) { - nIfExpr = nArrHandleCount; - doOmpAssignStmt (ex->lhs(),st); - } - } - SgExpression *expStatMPPrivate = new SgExpression (OMP_SHARED); - expStatMPPrivate->setLhs (*new SgExprListExp (*new SgVarRefExp(symStatMP))); - exp->append (*expStatMPPrivate); - } - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - if (omp_debug == DPERF) { - fperf = new SgCallStmt(*sym_dbg_interval_begin); - fperf->addArg(*arrStaticRef); - fperf->addArg(*varThreadID); - fperf->addArg(*new SgValueExp (nArrStaticHandleCount)); - fperf->addAttribute(DEBUG_STAT); - } - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - if (nNumThreads == 0) { - fe->addArg(*M1); - } else { - fe->addArg(*new SgArrayRefExp(*symDynMP,((nNumThreads==1)? *C1:*C2 ))); - } - if (nIfExpr == 0) { - fe->addArg(*M1); - } else { - fe->addArg(*new SgArrayRefExp(*symDynMP,((nIfExpr==1)? *C1:*C2 ))); - } - fe->addAttribute(DEBUG_STAT); - if (fperf != NULL) stat->insertStmtBefore(*fperf, *stat->controlParent()); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_parallel_event); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - stat=st->lastNodeOfStmt (); - if (omp_debug==DPERF) { - fe = new SgCallStmt(*sym_dbg_parallel_event_end); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fperf = new SgCallStmt(*sym_dbg_interval_end); - fperf->addArg(*arrStaticRef); - fperf->addArg(*varThreadID); - fperf->addArg(*new SgValueExp (nArrStaticHandleCount)); - fperf->addAttribute(DEBUG_STAT); - } - fe = new SgCallStmt(*sym_dbg_after_parallel); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - if (fperf != NULL) stat->insertStmtBefore(*fperf, *stat->controlParent()); -} - -void InstrumentOmpDoDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - SgForStmt *ForStat = isSgForStmt (st->lexNext ()); - if (ForStat == NULL) { - (void)fprintf (stderr, "Error: Incorrect OpenMP loop in %s line %d\n", st->fileName(), st->lineNumber ()); - exit (-1); - } - if (ForStat->hasLabel ()) { - SgStatement *tmp = new SgStatement (CONT_STAT); - tmp->setLabel (*ForStat->label ()); - st->insertStmtBefore(*tmp, *st->controlParent()); - BIF_LABEL(ForStat->thebif)=NULL; - } - if (sym_dbg_before_omp_loop == NULL) sym_dbg_before_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_before_omp_loop"); - if (sym_dbg_after_omp_loop == NULL) sym_dbg_after_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_omp_loop"); - if (sym_dbg_omp_loop_event == NULL) sym_dbg_omp_loop_event = new SgSymbol (PROCEDURE_NAME, "dbg_omp_loop_event"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_omp_loop); - SgExprListExp *exp = isSgExprListExp (st->expr(0)); - nArrHandleCount = 1; - int nChunk = 0; - doOmpAssignStmt(ForStat->start(),st); - doOmpAssignStmt(ForStat->end(),st); - if (ForStat->step() != NULL) { - doOmpAssignStmt(ForStat->step(),st); - } else { - doOmpAssignStmt(C1,st); - } - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - if (ex->variant () == OMP_SCHEDULE) { - if (ex->rhs () != NULL) { - doOmpAssignStmt (ex->rhs(),st); - nChunk = 1; - } - } - } - } - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgArrayRefExp(*symDynMP,*C1)); - fe->addArg(*new SgArrayRefExp(*symDynMP,*C2)); - fe->addArg(*new SgArrayRefExp(*symDynMP,*C3)); - if (nChunk == 0) { - fe->addArg(*M1); - } else { - fe->addArg(*new SgArrayRefExp(*symDynMP,*C4)); - } - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_omp_loop_event); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgVarRefExp (*ForStat->symbol ())); - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)ForStat->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (StatContext != NULL) { - fe->addArg(**StatContext); - } - stat=ForStat->lexNext (); - fe->addAttribute(DEBUG_STAT); - if (omp_debug!=DPERF){ - stat->insertStmtBefore(*fe, *stat->controlParent()); - } - fe = new SgCallStmt(*sym_dbg_after_omp_loop); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - stat=GetLastStatementOfLoop (ForStat); - stat = stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - if (stat->variant () == OMP_END_DO_DIR) { - stat->lexNext ()->insertStmtBefore(*fe, *stat->controlParent()); - exp = isSgExprListExp (stat->expr(0)); - if (exp != NULL) { - for (int i=0; ilength (); i++) { - GenerateContextStringForClauses (exp->elem (i), strStaticContext); - } - } - if (omp_debug == DPERF) { - GenerateNowaitPlusBarrier (stat); - } - } else { - stat->insertStmtBefore(*fe, *stat->controlParent()); - if (omp_debug == DPERF) { - SgStatement *enddodir = new SgStatement (OMP_END_DO_DIR); - enddodir->setlineNumber (stat->lineNumber()); - enddodir->addAttribute(DEBUG_STAT); - fe->insertStmtBefore(*enddodir,*stat->controlParent()); - GenerateNowaitPlusBarrier (enddodir); - } - } - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - ForStat->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); -} - -void InstrumentSerialDoLoop (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - SgForStmt *ForStat = isSgForStmt(st); - if (ForStat->hasLabel ()) { - SgStatement *tmp = new SgStatement (CONT_STAT); - tmp->setLabel (*ForStat->label ()); - st->insertStmtBefore(*tmp, *st->controlParent()); - BIF_LABEL(ForStat->thebif)=NULL; - } - if (sym_dbg_before_loop == NULL) sym_dbg_before_loop = new SgSymbol (PROCEDURE_NAME, "dbg_before_loop"); - if (sym_dbg_after_loop == NULL) sym_dbg_after_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_loop"); - if (sym_dbg_loop_event == NULL) sym_dbg_loop_event = new SgSymbol (PROCEDURE_NAME, "dbg_loop_event"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_loop); - isSgExprListExp (st->expr(0)); - nArrHandleCount = 1; - doOmpAssignStmt(ForStat->start(),st); - doOmpAssignStmt(ForStat->end(),st); - if (ForStat->step() != NULL) { - doOmpAssignStmt(ForStat->step(),st); - } else { - doOmpAssignStmt(C1,st); - } - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgArrayRefExp(*symDynMP,*C1)); - fe->addArg(*new SgArrayRefExp(*symDynMP,*C2)); - fe->addArg(*new SgArrayRefExp(*symDynMP,*C3)); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_loop_event); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgVarRefExp (*ForStat->symbol ())); - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)ForStat->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (StatContext != NULL) { - fe->addArg(**StatContext); - } - stat=ForStat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_loop); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - stat=GetLastStatementOfLoop (ForStat); - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - stat = stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - ForStat->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); -} - -void InstrumentOmpSingleDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_before_single == NULL) sym_dbg_before_single = new SgSymbol (PROCEDURE_NAME, "dbg_before_single"); - if (sym_dbg_after_single == NULL) sym_dbg_after_single = new SgSymbol (PROCEDURE_NAME, "dbg_after_single"); - if (sym_dbg_single_event == NULL) sym_dbg_single_event = new SgSymbol (PROCEDURE_NAME, "dbg_single_event"); - if (omp_debug == DPERF) { - if (sym_dbg_single_event_end == NULL) sym_dbg_single_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_single_event_end"); - } - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_single); - SgExprListExp *exp = isSgExprListExp (st->expr(0)); - nArrHandleCount = 1; - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - } - } - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_single_event); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - stat=st->lastNodeOfStmt (); - if (omp_debug == DPERF) { - fe = new SgCallStmt(*sym_dbg_single_event_end); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe->addAttribute(DEBUG_STAT); - } - fe = new SgCallStmt(*sym_dbg_after_single); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - exp = isSgExprListExp (stat->expr(0)); - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - } - } - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - stat=stat->lexNext (); - if (omp_debug == DPERF) { - GenerateNowaitPlusBarrier (stat->lexPrev()); - } - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); -} - -SgStatement *GetLastStatementOfLoop (SgStatement *forst) { - SgStatement *st, *res=NULL; - int lbl=-1; - if (forst->thebif->entry.for_node.doend !=NULL) - lbl=forst->thebif->entry.for_node.doend->stateno; - if (forst != NULL){ - res = forst->lastNodeOfStmt (); - } - if (res->variant () == CONTROL_END) { - return res; - } - for (st=res;st; st=st->lexNext()) { - if (st->variant() == CONT_STAT) { - if (lbl != 0) { - if (st->hasLabel()) { - if (st->label()->thelabel->stateno == lbl) { - return st; - } - } - } - } - if (st->variant() == CONTROL_END) { - if (st->controlParent() == forst) { - return st; - } - } - } - return res; -} - -void InstrumentOmpCriticalDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_before_critical == NULL) sym_dbg_before_critical = new SgSymbol (PROCEDURE_NAME, "dbg_before_critical"); - if (sym_dbg_after_critical == NULL) sym_dbg_after_critical = new SgSymbol (PROCEDURE_NAME, "dbg_after_critical"); - if (sym_dbg_critical_event == NULL) sym_dbg_critical_event = new SgSymbol (PROCEDURE_NAME, "dbg_critical_event"); - if (omp_debug == DPERF) { - if (sym_dbg_critical_event_end == NULL) sym_dbg_critical_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_critical_event_end"); - } - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_critical); - nArrHandleCount = 1; - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_critical_event); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - stat=st->lastNodeOfStmt (); - if (omp_debug==DPERF) { - fe = new SgCallStmt(*sym_dbg_critical_event_end); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - } - fe = new SgCallStmt(*sym_dbg_after_critical); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - if (st->expr(0)!= NULL) { - sprintf(strStaticContext,"%s*name1=%s*line2=%d",strStaticContext,UnparseExpr (st->expr(0)),stat->lineNumber()); - } else { - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - } - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); -} - -void InstrumentOmpOrderelDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_before_ordered == NULL) sym_dbg_before_ordered = new SgSymbol (PROCEDURE_NAME, "dbg_before_ordered"); - if (sym_dbg_after_ordered == NULL) sym_dbg_after_ordered = new SgSymbol (PROCEDURE_NAME, "dbg_after_ordered"); - if (sym_dbg_ordered_event == NULL) sym_dbg_ordered_event = new SgSymbol (PROCEDURE_NAME, "dbg_ordered_event"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_ordered); - nArrHandleCount = 1; - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_ordered_event); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_ordered); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=st->lastNodeOfStmt (); - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); -} - -void InstrumentOmpMasterDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st->lexNext (); - if (sym_dbg_master_begin == NULL) sym_dbg_master_begin = new SgSymbol (PROCEDURE_NAME, "dbg_master_begin"); - if (sym_dbg_master_end == NULL) sym_dbg_master_end = new SgSymbol (PROCEDURE_NAME, "dbg_master_end"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_master_begin); - nArrHandleCount = 1; - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *st); - fe = new SgCallStmt(*sym_dbg_master_end); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat=st->lastNodeOfStmt (); - stat->insertStmtBefore(*fe, *st); - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); -} - -void InstrumentOmpBarrierDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st->lexNext (); - if (sym_dbg_before_barrier == NULL) sym_dbg_before_barrier = new SgSymbol (PROCEDURE_NAME, "dbg_before_barrier"); - if (sym_dbg_after_barrier == NULL) sym_dbg_after_barrier = new SgSymbol (PROCEDURE_NAME, "dbg_after_barrier"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_barrier); - nArrHandleCount = 1; - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_barrier); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *st->controlParent()); -} - -void InstrumentOmpFlushDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_flush_event == NULL) sym_dbg_flush_event = new SgSymbol (PROCEDURE_NAME, "dbg_flush_event"); - if (omp_debug == DPERF){ - if (sym_dbg_before_flush == NULL) sym_dbg_before_flush = new SgSymbol (PROCEDURE_NAME, "dbg_before_flush"); - } - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - SgCallStmt *fe = NULL; - if (omp_debug == DPERF){ - fe = new SgCallStmt(*sym_dbg_before_flush); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *st->controlParent()); - } - fe = new SgCallStmt(*sym_dbg_flush_event); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat = st->lexNext (); - if (st->expr(0)!= NULL) { - sprintf(strStaticContext,"%s*name1=%s",strStaticContext,UnparseExpr (st->expr(0))); - } - stat->insertStmtBefore(*fe, *st->controlParent()); -} - -void InstrumentIOStmt (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_before_io == NULL) sym_dbg_before_io = new SgSymbol (PROCEDURE_NAME, "dbg_before_io"); - if (sym_dbg_after_io == NULL) sym_dbg_after_io = new SgSymbol (PROCEDURE_NAME, "dbg_after_io"); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - SgCallStmt *fe = NULL; - fe = new SgCallStmt(*sym_dbg_before_io); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *st->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_io); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat = st->lexNext (); - stat->insertStmtBefore(*fe, *st->controlParent()); -} - -void InstrumentIntervalDir (SgStatement *bst, SgStatement *st, char *strStaticContext){ - SgStatement *stat = bst; - if (sym_dbg_interval_begin == NULL) sym_dbg_interval_begin = new SgSymbol (PROCEDURE_NAME, "dbg_interval_begin"); - if (sym_dbg_interval_end == NULL) sym_dbg_interval_end = new SgSymbol (PROCEDURE_NAME, "dbg_interval_end"); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - SgCallStmt *fe = NULL; - fe = new SgCallStmt(*sym_dbg_interval_begin); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgValueExp (INTERVAL_NUMBER)); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *bst->controlParent()); - stat = st; - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,st->lineNumber()); - fe = new SgCallStmt(*sym_dbg_interval_end); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgValueExp (INTERVAL_NUMBER)); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *st->controlParent()); -} - -void InstrumentOmpThreadPrivateDir (SgStatement *st, SgStatement *before, char *strStaticContext) { - if (sym_dbg_threadprivate == NULL) sym_dbg_threadprivate = new SgSymbol (PROCEDURE_NAME, "dbg_threadprivate"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_threadprivate); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - if (st->expr(0)!= NULL) { - sprintf(strStaticContext,"%s*name1=%s",strStaticContext,UnparseExpr (st->expr(0))); - } - before->insertStmtBefore(*fe, *before->controlParent()); -} - -void InstrumentOmpSectionsDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_before_sections == NULL) sym_dbg_before_sections = new SgSymbol (PROCEDURE_NAME, "dbg_before_sections"); - if (sym_dbg_after_sections == NULL) sym_dbg_after_sections = new SgSymbol (PROCEDURE_NAME, "dbg_after_sections"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_sections); - SgExprListExp *exp = isSgExprListExp (st->expr(0)); - nArrHandleCount = 1; - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - } - } - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_sections); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=st->lastNodeOfStmt (); - /*exp = isSgExprListExp (stat->expr(0)); - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - } - } - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber());*/ - stat=stat->lexNext (); - if (omp_debug == DPERF) { - GenerateNowaitPlusBarrier (stat->lexPrev()); - } - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); -} - -void InstrumentOmpSectionDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st->lexNext (); - if (sym_dbg_section_event == NULL) sym_dbg_section_event = new SgSymbol (PROCEDURE_NAME, "dbg_section_event"); - if (omp_debug == DPERF) { - if (sym_dbg_section_event_end == NULL) sym_dbg_section_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_section_event_end"); - } - SgCallStmt *fe = new SgCallStmt(*sym_dbg_section_event); - nArrHandleCount = 1; - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - stat=st->lastNodeOfStmt (); - if (omp_debug == DPERF) { - fe = new SgCallStmt(*sym_dbg_section_event_end); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - } - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); -} -void InstrumentExitStmt (SgStatement *stat) { - if (sym_dbg_finalize == NULL) sym_dbg_finalize = new SgSymbol(PROCEDURE_NAME, "dbg_finalize"); - SgCallStmt *finalize = new SgCallStmt(*sym_dbg_finalize); - finalize->addAttribute(DEBUG_STAT); - stat->insertStmtBefore (*finalize, *stat->controlParent()); -} - -void InstrumentOmpWorkshareDir (SgStatement *st, char *strStaticContext){ - SgStatement *stat = st; - if (sym_dbg_before_workshare == NULL) sym_dbg_before_workshare = new SgSymbol (PROCEDURE_NAME, "dbg_before_workshare"); - if (sym_dbg_after_workshare == NULL) sym_dbg_after_workshare = new SgSymbol (PROCEDURE_NAME, "dbg_after_workshare"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_workshare); - nArrHandleCount = 1; - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_workshare); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=st->lastNodeOfStmt (); - SgExprListExp *exp = isSgExprListExp (stat->expr(0)); - if (exp != NULL) { - for (int i=0; ilength (); i++) { - SgExpression *ex= exp->elem (i); - GenerateContextStringForClauses (ex, strStaticContext); - } - } - sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); - stat=stat->lexNext (); - fe->addAttribute(DEBUG_STAT); - if (omp_debug == DPERF) { - GenerateNowaitPlusBarrier (stat->lexPrev()); - } - stat->insertStmtBefore(*fe, *stat->controlParent()); -} - -void SearchVarAndArrayInExpression(SgStatement *st, SgExpression *exp, SgArrayRefExp *var) { - if (exp == NULL) return; - switch (exp->variant()) { - case INT_VAL: - case LABEL_REF: - case FLOAT_VAL: - case DOUBLE_VAL: - case STMT_STR: - case STRING_VAL: - case COMPLEX_VAL: - case KEYWORD_VAL: - case KEYWORD_ARG: - case BOOL_VAL: - case CHAR_VAL: - case CONST_REF: - case ENUM_REF: - case TYPE_REF: - case INTERFACE_REF: - case DEFAULT: - case DEF_CHOICE : - case SEQ: - case SPEC_PAIR: - case ACCESS: - case IOACCESS: - case OVERLOADED_CALL: - case ORDERED_OP: - case EXTEND_OP: - case PARAMETER_OP: - case PUBLIC_OP: - case PRIVATE_OP: - case ALLOCATABLE_OP: - case EXTERNAL_OP: - case OPTIONAL_OP: - case IN_OP: - case OUT_OP: - case INOUT_OP: - case INTRINSIC_OP: - case POINTER_OP: - case SAVE_OP: - case TARGET_OP: - case STAR_RANGE: - case VARIABLE_NAME: - break; - case VAR_REF: - InstrumentReadVar (st, exp, var); - break; - case ARRAY_REF: - if (exp->symbol ()->type()->variant () == T_ARRAY) { - InstrumentReadArray (st, exp, var); - } else { - InstrumentReadVar (st, exp, var); /* character**/ - } - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case ARRAY_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - case RECORD_REF: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - case STRUCTURE_CONSTRUCTOR: - case CONSTRUCTOR_REF: - case ACCESS_REF: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case CONS: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - case PROC_CALL: - case FUNC_CALL: - InstrumentFuncCall(st,exp); - //SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case EXPR_LIST: - case EQUI_LIST: - case COMM_LIST: - case NAMELIST_LIST: - case VAR_LIST: - case RANGE_LIST: - case CONTROL_LIST: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - case DDOT: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - case EQ_OP: - case LT_OP: - case GT_OP: - case NOTEQL_OP: - case LTEQL_OP: - case GTEQL_OP: - case ADD_OP: - case SUBT_OP: - case OR_OP: - case MULT_OP: - case DIV_OP: - case MOD_OP: - case AND_OP: - case EXP_OP: - case EQV_OP: - case NEQV_OP: - case XOR_OP: - case CONCAT_OP: { - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - } - case MINUS_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case UNARY_ADD_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case NOT_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case PAREN_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case ASSGN_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case IMPL_TYPE: - if (exp->lhs () != NULL) - { - SearchVarAndArrayInExpression(st,exp->lhs (),var); - } - break; - case MAXPARALLEL_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case DIMENSION_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case LEN_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case TYPE_OP: - break; - case ONLY_NODE: - if (exp->lhs ()) SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case DEREF_OP: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - break; - case RENAME_NODE: - SearchVarAndArrayInExpression(st,exp->lhs (),var); - SearchVarAndArrayInExpression(st,exp->rhs (),var); - break; - default: - fprintf(stderr,"SearchVarAndArrayInExpression -- bad llnd ptr %d!\n",exp->variant()); - break; - } -} - -void InstrumentAssignStat (SgStatement *st, char *strStaticContext) { - SgExpression *exp = st->expr (0); - SgStatement *stat=st; - if ((exp->variant () != ARRAY_REF)&&(exp->variant () != VAR_REF)) return; - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)exp->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (StatContext == NULL) return; - if (sym_dbg_write_var_begin == NULL) sym_dbg_write_var_begin = new SgSymbol (PROCEDURE_NAME, "dbg_write_var_begin"); - if (sym_dbg_write_arr_begin == NULL) sym_dbg_write_arr_begin = new SgSymbol (PROCEDURE_NAME, "dbg_write_arr_begin"); - if (sym_dbg_write_arr_end == NULL) sym_dbg_write_arr_end = new SgSymbol (PROCEDURE_NAME, "dbg_write_arr_end"); - if (sym_dbg_write_var_end == NULL) sym_dbg_write_var_end = new SgSymbol (PROCEDURE_NAME, "dbg_write_var_end"); - if (sym_dbg_read_arr == NULL) sym_dbg_read_arr = new SgSymbol (PROCEDURE_NAME, "dbg_read_arr"); - if (sym_dbg_read_var == NULL) sym_dbg_read_var = new SgSymbol (PROCEDURE_NAME, "dbg_read_var"); - int isArray = (exp->variant () == ARRAY_REF) ? (exp->symbol ()->type()->variant () == T_ARRAY) : 0; - SgCallStmt *fe = new SgCallStmt((isArray ? *sym_dbg_write_arr_begin : *sym_dbg_write_var_begin)); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*exp); - fe->addArg(**StatContext); - SgExpression **arrFirstElement = NULL; - if (isArray) { - arrFirstElement = new (SgExpression *); - arrFirstElement = (SgExpression **)exp->symbol ()->attributeValue(0,FIRST_ELEM); - if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); - } - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - fe = new SgCallStmt((isArray ? *sym_dbg_write_arr_end : *sym_dbg_write_var_end)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*exp); - fe->addArg(**StatContext); - if (isArray) { - if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); - } - stat=st->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - GenerateCallGetHandle (strStaticContext); - if (st->expr(0)->lhs ()) { - SearchVarAndArrayInExpression (st, st->expr(0)->lhs(),arrStaticRef); - } - if (st->expr(1)) { - SearchVarAndArrayInExpression (st, st->expr(1),arrStaticRef); - } -} - -void InstrumentIfStat (SgStatement *st, char *strStaticContext) { - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - if (sym_dbg_read_arr == NULL) sym_dbg_read_arr = new SgSymbol (PROCEDURE_NAME, "dbg_read_arr"); - if (sym_dbg_read_var == NULL) sym_dbg_read_var = new SgSymbol (PROCEDURE_NAME, "dbg_read_var"); - SearchVarAndArrayInExpression (st, st->expr(0),arrStaticRef); -} - -void InstrumentProcStat (SgStatement *st, char *strStaticContext) { - //SgExpression *exp = st->expr (0); - SgStatement *stat=st; - SgCallStmt *f = isSgCallStmt (st); - if (f == NULL) return; - if (sym_dbg_before_funcall == NULL) sym_dbg_before_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_before_funcall"); - if (sym_dbg_after_funcall == NULL) sym_dbg_after_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_after_funcall"); - if (sym_dbg_funcparvar == NULL) sym_dbg_funcparvar = new SgSymbol (PROCEDURE_NAME, "dbg_funcparvar"); - if (sym_dbg_funcpararr == NULL) sym_dbg_funcpararr = new SgSymbol (PROCEDURE_NAME, "dbg_funcpararr"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_funcall); - sprintf(strStaticContext,"%s*name1=%s*rank=%d",strStaticContext,stat->symbol ()->identifier (),f->numberOfArgs()); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_funcall); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=st->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - stat = fe; - for (int i=0; inumberOfArgs(); i++) { - SgExpression *par = f->arg(i); - if ((par->variant () != ARRAY_REF)&&(par->variant () != VAR_REF)) continue; - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)par->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (StatContext == NULL) continue; - int isArray = (par->variant () == ARRAY_REF) ? (par->symbol ()->type()->variant () == T_ARRAY) : 0; - fe = new SgCallStmt((isArray ? *sym_dbg_funcpararr : *sym_dbg_funcparvar)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgValueExp(i+1)); - fe->addArg(*par); - fe->addArg(**StatContext); - if (isArray) { - SgExpression **arrFirstElement = new (SgExpression *); - arrFirstElement = (SgExpression **)par->symbol ()->attributeValue(0,FIRST_ELEM); - if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); - } - fe->addArg(*C1); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - SgStatement *after = fe->copyPtr (); - after->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*after, *stat->controlParent()); - } -} - -void InstrumentFuncCall (SgStatement *st, SgExpression *exp) { - SgStatement *stat=st; - SgFunctionCallExp *f = isSgFunctionCallExp (exp); - if (omp_debugfunName()->identifier (),f->numberOfArgs()); - GenerateCallGetHandle (strStaticContext); - if (sym_dbg_before_funcall == NULL) sym_dbg_before_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_before_funcall"); - if (sym_dbg_after_funcall == NULL) sym_dbg_after_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_after_funcall"); - if (sym_dbg_funcparvar == NULL) sym_dbg_funcparvar = new SgSymbol (PROCEDURE_NAME, "dbg_funcparvar"); - if (sym_dbg_funcpararr == NULL) sym_dbg_funcpararr = new SgSymbol (PROCEDURE_NAME, "dbg_funcpararr"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_funcall); - SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount-1)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - fe = new SgCallStmt(*sym_dbg_after_funcall); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - stat=st->lexNext (); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - stat = fe; - for (int i=0; inumberOfArgs(); i++) { - SgExpression *par = f->arg(i); - if ((par->variant () != ARRAY_REF)&&(par->variant () != VAR_REF)) continue; - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)par->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (StatContext == NULL) continue; - int isArray = (par->variant () == ARRAY_REF) ? (par->symbol ()->type()->variant () == T_ARRAY) : 0; - fe = new SgCallStmt((isArray ? *sym_dbg_funcpararr : *sym_dbg_funcparvar)); - fe->addArg(*arrStaticRef); - fe->addArg(*varThreadID); - fe->addArg(*new SgValueExp(i+1)); - fe->addArg(*par); - fe->addArg(**StatContext); - if (isArray) { - SgExpression **arrFirstElement = new (SgExpression *); - arrFirstElement = (SgExpression **)par->symbol ()->attributeValue(0,FIRST_ELEM); - if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); - } - fe->addArg(*C1); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - SgStatement *after = fe->copyPtr (); - after->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*after, *stat->controlParent()); - } -} - - -void InstrumentFunctionBegin (SgStatement *st, char *strStaticContext, SgStatement *func) { - //SgExpression *exp = st->expr (0); - SgStatement *stat=st->lexNext (); - if (sym_dbg_funcbegin == NULL) sym_dbg_funcbegin = new SgSymbol (PROCEDURE_NAME, "dbg_funcbegin"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_funcbegin); - if ((func->variant () == PROC_HEDR) || (func->variant () == FUNC_HEDR)) { - SgFunctionSymb *funcsym = isSgFunctionSymb (func->symbol ()); - if (funcsym == NULL) return; - if (func->variant () == FUNC_HEDR) - sprintf(strStaticContext,"%s*file=%s*line1=%d*line2=%d*name1=%s*vtype=%d*rank=%d",strStaticContext,func->fileName (),func->lineNumber(),func->lastNodeOfStmt()->lineNumber(),func->symbol ()->identifier (),VarType(funcsym),funcsym->numberOfParameters()); - else - sprintf(strStaticContext,"%s*file=%s*line1=%d*line2=%d*name1=%s*rank=%d",strStaticContext,func->fileName (),func->lineNumber(),func->lastNodeOfStmt()->lineNumber(),func->symbol ()->identifier (),funcsym->numberOfParameters()); - SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); - *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); - func->symbol()->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); - fe->addArg(**arrStaticRef); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - stat->insertStmtBefore(*fe, *stat->controlParent()); - } -} - -void InstrumentFunctionEnd (SgStatement *st, SgStatement *func) { - if (sym_dbg_funcend == NULL) sym_dbg_funcend = new SgSymbol (PROCEDURE_NAME, "dbg_funcend"); - SgCallStmt *fe = new SgCallStmt(*sym_dbg_funcend); - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)func->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (StatContext == NULL) return; - fe->addArg(**StatContext); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); -} - - -void InstrumentReadVar (SgStatement *st, SgExpression *exp, SgArrayRefExp *var) { - if (InArrayRefList (exp)) return; - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = ((SgArrayRefExp **)exp->symbol ()->attributeValue(0,STATIC_CONTEXT)); - if (*StatContext != NULL) { - SgCallStmt *fe = new SgCallStmt(*sym_dbg_read_var); - fe->addArg(*var); - fe->addArg(*varThreadID); - fe->addArg(*exp); - fe->addArg(**StatContext); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - IntoArrayRefList (exp); - } -} - -void InstrumentReadArray (SgStatement *st, SgExpression *exp, SgArrayRefExp *var) { - if (InArrayRefList (exp)) return; - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)exp->symbol ()->attributeValue(0,STATIC_CONTEXT); - if (*StatContext != NULL) { - SgExpression **arrFirstElement = new (SgExpression *); - arrFirstElement = (SgExpression **)exp->symbol ()->attributeValue(0,FIRST_ELEM); - if ((arrFirstElement != NULL) && (*arrFirstElement != NULL)) { - SgCallStmt *fe = new SgCallStmt(*sym_dbg_read_arr); - fe->addArg(*var); - fe->addArg(*varThreadID); - fe->addArg(*exp); - fe->addArg(**StatContext); - fe->addArg(**arrFirstElement); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - IntoArrayRefList (exp); - } - } -} - -void FindExternalProcedures (SgStatement *stat) { - if (stat->variant () == EXTERN_STAT) { - SgExprListExp *list = isSgExprListExp(stat->expr(0)); - for (int i=0; i< list->length ();i++) { - SgSymbol *sym=list->elem (i)->symbol (); - char *str=sym->identifier (); - if (!strcmp (str,"dbg_finalize")) { - sym_dbg_finalize = sym; - sym_dbg_finalize->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_init")) { - sym_dbg_init = sym; - sym_dbg_init->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_get_handle")) { - sym_dbg_get_handle = sym; - sym_dbg_get_handle->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_regarr")) { - sym_dbg_regarr = sym; - sym_dbg_regarr->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_unregarr")) { - sym_dbg_unregarr = sym; - sym_dbg_unregarr->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_regvar")) { - sym_dbg_regvar = sym; - sym_dbg_regvar->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_parallel")) { - sym_dbg_before_parallel = sym; - sym_dbg_before_parallel->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_parallel")) { - sym_dbg_after_parallel = sym; - sym_dbg_after_parallel->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_parallel_event")) { - sym_dbg_parallel_event = sym; - sym_dbg_parallel_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_parallel_event_end")) { - sym_dbg_parallel_event_end = sym; - sym_dbg_parallel_event_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_omp_loop")) { - sym_dbg_before_omp_loop = sym; - sym_dbg_before_omp_loop->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_omp_loop")) { - sym_dbg_after_omp_loop = sym; - sym_dbg_after_omp_loop->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_omp_loop_event")) { - sym_dbg_omp_loop_event = sym; - sym_dbg_omp_loop_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_loop")) { - sym_dbg_before_loop = sym; - sym_dbg_before_loop->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_loop")) { - sym_dbg_after_loop = sym; - sym_dbg_after_loop->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_loop_event")) { - sym_dbg_loop_event = sym; - sym_dbg_loop_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_write_var_begin")) { - sym_dbg_write_var_begin = sym; - sym_dbg_write_var_begin->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_write_arr_begin")) { - sym_dbg_write_arr_begin = sym; - sym_dbg_write_arr_begin->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_write_var_end")) { - sym_dbg_write_var_end = sym; - sym_dbg_write_var_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_write_arr_end")) { - sym_dbg_write_arr_end = sym; - sym_dbg_write_arr_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_read_arr")) { - sym_dbg_read_arr = sym; - sym_dbg_read_arr->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_read_var")) { - sym_dbg_read_var = sym; - sym_dbg_read_var->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_regpararr")) { - sym_dbg_regpararr = sym; - sym_dbg_regpararr->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_regparvar")) { - sym_dbg_regparvar = sym; - sym_dbg_regparvar->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_regcommon")) { - sym_dbg_regcommon = sym; - sym_dbg_regcommon->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_sections")) { - sym_dbg_before_sections = sym; - sym_dbg_before_sections->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_sections")) { - sym_dbg_after_sections = sym; - sym_dbg_after_sections->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_section_event")) { - sym_dbg_section_event = sym; - sym_dbg_section_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_section_event_end")) { - sym_dbg_section_event_end = sym; - sym_dbg_section_event_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_single")) { - sym_dbg_before_single = sym; - sym_dbg_before_single->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_single_event")) { - sym_dbg_single_event = sym; - sym_dbg_single_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_single_event_end")) { - sym_dbg_single_event_end = sym; - sym_dbg_single_event_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_single")) { - sym_dbg_after_single = sym; - sym_dbg_after_single->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_workshare")) { - sym_dbg_before_workshare = sym; - sym_dbg_before_workshare->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_workshare")) { - sym_dbg_after_workshare = sym; - sym_dbg_after_workshare->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_master_begin")) { - sym_dbg_master_begin = sym; - sym_dbg_master_begin->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_master_end")) { - sym_dbg_master_end = sym; - sym_dbg_master_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_critical")) { - sym_dbg_before_critical = sym; - sym_dbg_before_critical->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_critical_event")) { - sym_dbg_critical_event = sym; - sym_dbg_critical_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_critical_event_end")) { - sym_dbg_critical_event_end = sym; - sym_dbg_critical_event_end->addAttribute (DECLARED_FUNC); - continue; - } - - if (!strcmp (str,"dbg_after_critical")) { - sym_dbg_after_critical = sym; - sym_dbg_after_critical->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_barrier")) { - sym_dbg_before_barrier = sym; - sym_dbg_before_barrier->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_barrier")) { - sym_dbg_after_barrier = sym; - sym_dbg_after_barrier->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_flush_event")) { - sym_dbg_flush_event = sym; - sym_dbg_flush_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_flush")) { - sym_dbg_before_flush = sym; - sym_dbg_before_flush->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_ordered")) { - sym_dbg_before_ordered = sym; - sym_dbg_before_ordered->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_ordered_event")) { - sym_dbg_ordered_event = sym; - sym_dbg_ordered_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_ordered")) { - sym_dbg_after_ordered = sym; - sym_dbg_after_ordered->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_threadprivate")) { - sym_dbg_threadprivate = sym; - sym_dbg_threadprivate->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_funcall")) { - sym_dbg_before_funcall = sym; - sym_dbg_before_funcall->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_funcparvar")) { - sym_dbg_funcparvar = sym; - sym_dbg_funcparvar->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_funcpararr")) { - sym_dbg_funcpararr = sym; - sym_dbg_funcpararr->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_funcall")) { - sym_dbg_after_funcall = sym; - sym_dbg_after_funcall->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_funcbegin")) { - sym_dbg_funcbegin = sym; - sym_dbg_funcbegin->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_funcend")) { - sym_dbg_funcend = sym; - sym_dbg_funcend->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_if_loop_event")) { - sym_dbg_if_loop_event = sym; - sym_dbg_if_loop_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_omp_if_loop_event")) { - sym_dbg_omp_if_loop_event = sym; - sym_dbg_omp_if_loop_event->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_interval_begin")) { - sym_dbg_interval_begin = sym; - sym_dbg_interval_begin->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_interval_end")) { - sym_dbg_interval_end = sym; - sym_dbg_interval_end->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_before_io")) { - sym_dbg_before_io = sym; - sym_dbg_before_io->addAttribute (DECLARED_FUNC); - continue; - } - if (!strcmp (str,"dbg_after_io")) { - sym_dbg_after_io = sym; - sym_dbg_after_io->addAttribute (DECLARED_FUNC); - continue; - } - } - } -} - -void DeclareExternalProcedures (SgStatement *debug) { - SgStatement *decl = new SgStatement(EXTERN_STAT); - //SgExprListExp *list = new SgExprListExp(*new SgVarRefExp(*sym_dbg_init)); - SgExprListExp *list = new SgExprListExp(); - if ((sym_dbg_init != NULL) && (sym_dbg_init->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_init)); - if ((sym_dbg_finalize != NULL) && (sym_dbg_finalize->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_finalize)); - if ((sym_dbg_get_handle != NULL) && (sym_dbg_get_handle->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_get_handle)); - if ((sym_dbg_regarr != NULL) && (sym_dbg_regarr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regarr)); - if ((sym_dbg_unregarr != NULL) && (sym_dbg_unregarr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_unregarr)); - if ((sym_dbg_regvar != NULL) && (sym_dbg_regvar->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regvar)); - if ((sym_dbg_before_parallel != NULL) && (sym_dbg_before_parallel->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_parallel)); - if ((sym_dbg_after_parallel != NULL) && (sym_dbg_after_parallel->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_parallel)); - if ((sym_dbg_parallel_event != NULL) && (sym_dbg_parallel_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_parallel_event)); - if ((sym_dbg_parallel_event_end != NULL) && (sym_dbg_parallel_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_parallel_event_end)); - if ((sym_dbg_before_omp_loop != NULL) && (sym_dbg_before_omp_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_omp_loop)); - if ((sym_dbg_after_omp_loop != NULL) && (sym_dbg_after_omp_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_omp_loop)); - if ((sym_dbg_omp_loop_event != NULL) && (sym_dbg_omp_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_omp_loop_event)); - if ((sym_dbg_before_loop != NULL) && (sym_dbg_before_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_loop)); - if ((sym_dbg_after_loop != NULL) && (sym_dbg_after_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_loop)); - if ((sym_dbg_loop_event != NULL) && (sym_dbg_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_loop_event)); - if ((sym_dbg_write_var_begin != NULL) && (sym_dbg_write_var_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_var_begin)); - if ((sym_dbg_write_arr_begin != NULL) && (sym_dbg_write_arr_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_arr_begin)); - if ((sym_dbg_write_var_end != NULL) && (sym_dbg_write_var_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_var_end)); - if ((sym_dbg_write_arr_end != NULL) && (sym_dbg_write_arr_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_arr_end)); - if ((sym_dbg_read_var != NULL) && (sym_dbg_read_var->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_read_var)); - if ((sym_dbg_read_arr != NULL) && (sym_dbg_read_arr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_read_arr)); - if ((sym_dbg_regpararr != NULL) && (sym_dbg_regpararr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regpararr)); - if ((sym_dbg_regparvar != NULL) && (sym_dbg_regparvar->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regparvar)); - if ((sym_dbg_regcommon != NULL) && (sym_dbg_regcommon->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regcommon)); - if ((sym_dbg_before_sections != NULL) && (sym_dbg_before_sections->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_sections)); - if ((sym_dbg_after_sections != NULL) && (sym_dbg_after_sections->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_sections)); - if ((sym_dbg_section_event != NULL) && (sym_dbg_section_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_section_event)); - if ((sym_dbg_section_event_end != NULL) && (sym_dbg_section_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_section_event_end)); - if ((sym_dbg_before_single != NULL) && (sym_dbg_before_single->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_single)); - if ((sym_dbg_single_event != NULL) && (sym_dbg_single_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_single_event)); - if ((sym_dbg_single_event_end != NULL) && (sym_dbg_single_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_single_event_end)); - if ((sym_dbg_after_single != NULL) && (sym_dbg_after_single->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_single)); - if ((sym_dbg_before_workshare != NULL) && (sym_dbg_before_workshare->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_workshare)); - if ((sym_dbg_after_workshare != NULL) && (sym_dbg_after_workshare->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_workshare)); - if ((sym_dbg_master_begin != NULL) && (sym_dbg_master_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_master_begin)); - if ((sym_dbg_master_end != NULL) && (sym_dbg_master_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_master_end)); - if ((sym_dbg_before_critical != NULL) && (sym_dbg_before_critical->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_critical)); - if ((sym_dbg_critical_event != NULL) && (sym_dbg_critical_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_critical_event)); - if ((sym_dbg_critical_event_end != NULL) && (sym_dbg_critical_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_critical_event_end)); - if ((sym_dbg_after_critical != NULL) && (sym_dbg_after_critical->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_critical)); - if ((sym_dbg_before_barrier != NULL) && (sym_dbg_before_barrier->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_barrier)); - if ((sym_dbg_after_barrier != NULL) && (sym_dbg_after_barrier->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_barrier)); - if ((sym_dbg_flush_event != NULL) && (sym_dbg_flush_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_flush_event)); - if ((sym_dbg_before_flush != NULL) && (sym_dbg_before_flush->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_flush)); - if ((sym_dbg_before_ordered != NULL) && (sym_dbg_before_ordered->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_ordered)); - if ((sym_dbg_ordered_event != NULL) && (sym_dbg_ordered_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_ordered_event)); - if ((sym_dbg_after_ordered != NULL) && (sym_dbg_after_ordered->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_ordered)); - if ((sym_dbg_threadprivate != NULL) && (sym_dbg_threadprivate->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_threadprivate)); - if ((sym_dbg_before_funcall != NULL) && (sym_dbg_before_funcall->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_funcall)); - if ((sym_dbg_after_funcall != NULL) && (sym_dbg_after_funcall->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_funcall)); - if ((sym_dbg_funcparvar != NULL) && (sym_dbg_funcparvar->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcparvar)); - if ((sym_dbg_funcpararr != NULL) && (sym_dbg_funcpararr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcpararr)); - if ((sym_dbg_funcbegin != NULL) && (sym_dbg_funcbegin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcbegin)); - if ((sym_dbg_funcend != NULL) && (sym_dbg_funcend->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcend)); - if ((sym_dbg_if_loop_event != NULL) && (sym_dbg_if_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_if_loop_event)); - if ((sym_dbg_omp_if_loop_event != NULL) && (sym_dbg_omp_if_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_omp_if_loop_event)); - if ((sym_dbg_before_io != NULL) && (sym_dbg_before_io->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_io)); - if ((sym_dbg_after_io != NULL) && (sym_dbg_after_io->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_io)); - if ((sym_dbg_interval_begin != NULL) && (sym_dbg_interval_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_interval_begin)); - if ((sym_dbg_interval_end != NULL) && (sym_dbg_interval_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_interval_end)); - - if (list->length ()>1) { - decl -> setExpression(0,*list->rhs()); - debug-> insertStmtBefore(*decl, *debug->controlParent()); - } -} - -void UpdateIncludeVarsFile(SgStatement *st, const char *input_file) { - freopen (input_file,"w",stdout); - SgStatement *last = st->lastNodeOfStmt (); - for (SgStatement *stat=st->lexNext (); stat && (stat != last); stat=stat->lexNext()) { - if (stat->variant () != PROC_STAT) { - stat->unparsestdout (); - } - } - fclose (stdout); -} - -void UpdateIncludeInitFile(SgStatement *st, const char *input_file) { - freopen (input_file,"w",stdout); - SgStatement *last = st->lastNodeOfStmt (); - SgStatement *prev = st; - for (SgStatement *stat=st->lexNext (); stat && (stat != last); stat=prev->lexNext()) { - if (stat->variant () != PROC_STAT) { - prev->setLexNext (*stat->lexNext()); - stat->extractStmt (); - } else prev = stat; - } - char *data_str = new char[20]; - sprintf(data_str,"include 'dbg_vars.h'"); - SgStatement *decl = new SgStatement(DATA_DECL);// creates DATA statement - SgExpression *es = new SgExpression(STMT_STR); - NODE_STR(es->thellnd) = data_str; - decl -> setExpression(0,*es); - st->insertStmtAfter (*decl); - st->unparsestdout (); - if (isMainProgram == 1) { - char *data_str = new char[20]; - sprintf(data_str,"include 'dbg_init.h'"); - SgStatement *decl = new SgStatement(DATA_DECL); - SgExpression *es = new SgExpression(STMT_STR); - NODE_STR(es->thellnd) = data_str; - decl -> setExpression(0,*es); - last->insertStmtAfter (*decl); - data_str = new char[20]; - sprintf(data_str,"data ithreadid /-1/"); - decl = new SgStatement(DATA_DECL); - es = new SgExpression(STMT_STR); - NODE_STR(es->thellnd) = data_str; - decl -> setExpression(0,*es); - SgExpression *common = new SgExpression (COMM_LIST); - SgSymbol *dbg_thread=new SgSymbol (VARIABLE_NAME,"dbg_thread"); - common->setSymbol (*dbg_thread); - SgVarRefExp *ithreadid = new SgVarRefExp (*new SgSymbol (VARIABLE_NAME,"ithreadid")); - common->setLhs (*ithreadid); - SgStatement *common_stat= new SgStatement(COMM_STAT); - common_stat->setExpression (0, *common); - SgStatement *thread = new SgStatement (OMP_THREADPRIVATE_DIR); - SgExpression *th = new SgExpression (OMP_THREADPRIVATE); - th->setLhs (*new SgExprListExp (*new SgVarRefExp (*dbg_thread))); - thread->setExpression (0, *th); - SgStatement *BlockData = new SgStatement(BLOCK_DATA); - BlockData->setSymbol (*new SgSymbol (VARIABLE_NAME,"dbgthread")); - last->insertStmtAfter(*BlockData); - last->insertStmtAfter(*new SgStatement(CONTROL_END), *BlockData); - last->insertStmtAfter(*decl, *BlockData); - last->insertStmtAfter(*thread, *BlockData); - last->insertStmtAfter(*common_stat, *BlockData); - - } - st->extractStmtBody (); - st->extractStmt (); - fclose (stdout); -} -SgExpression *GetOmpAddresMem (SgExpression *exp) { - SgFunctionCallExp *fe; - if (sym_dbg_get_addr == NULL) { - sym_dbg_get_addr = new SgSymbol(PROCEDURE_NAME, "dbg_get_addr"); - } - fe = new SgFunctionCallExp(*sym_dbg_get_addr); - fe->addArg(exp->copy()); - return(fe); -} -SgStatement * FindOuterLoop(SgStatement *st) { - SgStatement *tmp=NULL; - SgStatement *res=NULL; - for (tmp=st; tmp && (tmp->variant () != GLOBAL); tmp = tmp->controlParent ()) { - if (isSgForStmt (tmp)) { - res = tmp; - } - } - return res; -} - -int FindLabelInLoop(SgStatement *st, SgLabel *lbl) { - SgStatement *tmp=NULL; - SgStatement *last=GetLastStatementOfLoop (st); - int res=0; - if (isSgForStmt(st)) { - if (last->hasLabel ()) - if (LABEL_STMTNO(last->label()->thelabel) == LABEL_STMTNO (lbl->thelabel)) return 1; - for (tmp=st; tmp && (tmp != last); tmp = tmp->lexNext ()) { - if (tmp->hasLabel ()) - if (LABEL_STMTNO(tmp->label()->thelabel) == LABEL_STMTNO (lbl->thelabel)) return 1; - } - } - return res; -} - -void InstrumentGotoStmt (SgStatement *st) { - SgGotoStmt *gotost = isSgGotoStmt (st); - if (!gotost) return; - SgLabel *lbl = gotost->branchLabel(); - if (!lbl) return; - SgStatement *tmp=NULL; - for (tmp=st; tmp && (tmp->variant () != GLOBAL); tmp = tmp->controlParent ()) { - if (isSgForStmt (tmp)) { - int inparloop = tmp->lexPrev () && (tmp->lexPrev ()->variant () == OMP_DO_DIR); - if (!FindLabelInLoop(tmp, lbl)) { - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)tmp->attributeValue(0,STATIC_CONTEXT); - if (StatContext != NULL) { - SgCallStmt *fe = NULL; - if (inparloop) { - if (sym_dbg_after_omp_loop == NULL) sym_dbg_after_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_omp_loop"); - fe = new SgCallStmt(*sym_dbg_after_omp_loop); - } else { - if (sym_dbg_after_loop == NULL) sym_dbg_after_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_loop"); - fe = new SgCallStmt(*sym_dbg_after_loop); - } - fe->addArg(**StatContext); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - } - } - } - } -} - -void InstrumentExitFromLoops (SgStatement *st) { - SgStatement *tmp=NULL; - for (tmp=st; tmp && (tmp->variant () != GLOBAL); tmp = tmp->controlParent ()) { - if (isSgForStmt (tmp)) { - int inparloop = tmp->lexPrev () && (tmp->lexPrev ()->variant () == OMP_DO_DIR); - SgArrayRefExp **StatContext = new (SgArrayRefExp *); - StatContext = (SgArrayRefExp **)tmp->attributeValue(0,STATIC_CONTEXT); - if (StatContext != NULL) { - SgCallStmt *fe = NULL; - if (inparloop) { - if (sym_dbg_after_omp_loop == NULL) sym_dbg_after_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_omp_loop"); - fe = new SgCallStmt(*sym_dbg_after_omp_loop); - } else { - if (sym_dbg_after_loop == NULL) sym_dbg_after_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_loop"); - fe = new SgCallStmt(*sym_dbg_after_loop); - } - fe->addArg(**StatContext); - fe->addArg(*varThreadID); - fe->addAttribute(DEBUG_STAT); - st->insertStmtBefore(*fe, *st->controlParent()); - } - } - } -} -void GenerateNowaitPlusBarrier (SgStatement *st) { - char *strStaticContext = new char [MaxContextBufferLength]; - int wasnowaitclause = 0; - if ((st->variant () == OMP_END_DO_DIR) || - (st->variant () == OMP_END_SINGLE_DIR)|| - (st->variant () == OMP_END_SECTIONS_DIR)|| - (st->variant () == OMP_END_WORKSHARE_DIR)){ - SgExprListExp *exp = isSgExprListExp (st->expr(0)); - if (exp != NULL) { - for (int i=0; ilength (); i++) { - if (exp->elem (i)->variant()== OMP_NOWAIT) { - wasnowaitclause = 1; - break; - } - } - if (wasnowaitclause) { - return; - } - exp->append (*new SgExpression (OMP_NOWAIT)); - } else { - st->setExpression (0, *new SgExprListExp(*new SgExpression(OMP_NOWAIT))); - } - } - SgStatement *next = st->lexNext (); - SgStatement *stat = new SgStatement (OMP_BARRIER_DIR); - stat->addAttribute(DEBUG_STAT); - stat->setlineNumber (st->lineNumber ()); - next->insertStmtBefore(*stat, *next->controlParent()); - memset(strStaticContext, 0, MaxContextBufferLength); - strcat(strStaticContext,"*type=barrier"); - GenerateFileAndLine (stat, strStaticContext); - InstrumentOmpBarrierDir (stat, strStaticContext); - GenerateCallGetHandle (strStaticContext); -} \ No newline at end of file diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/parloop.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/parloop.cpp deleted file mode 100644 index e859f4f..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/parloop.cpp +++ /dev/null @@ -1,2587 +0,0 @@ -/*********************************************************************/ -/* Fortran DVM+OpenMP+ACC */ -/* */ -/* Parallel Loop Processing */ -/*********************************************************************/ - -#include "dvm.h" - -SgStatement *parallel_dir; -SgExpression *spec_accr; -int iacross; -symb_list *newvar_list; -#define IN_ 0 -#define OUT_ 1 - -extern int nloopred; //counter of parallel loops with reduction group -extern int nloopcons; //counter of parallel loops with consistent group -extern int opt_base, opt_loop_range; //set on by compiler options (code optimization options) -extern symb_list *redvar_list; - -int ParallelLoop(SgStatement *stmt) -{ - SgSymbol *do_var[MAX_LOOP_LEVEL]; - SgExpression *step[MAX_LOOP_LEVEL], - *init[MAX_LOOP_LEVEL], - *last[MAX_LOOP_LEVEL], - *vpart[MAX_LOOP_LEVEL]; - SgExpression *dovar; - SgValueExp c1(1); - int i=0, nloop=0, ndo=0, iout; - SgStatement *stl, *st, *first_do; - SgForStmt *stdo; - int ub; /*OMP*/ - SgSymbol *newj = NULL; /*OMP*/ - SgExpression *clause[13] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}; - - // initialize global variables - parallel_dir = stmt; - redgref = NULL; - red_list = NULL; - irg=0; idebrg=0; - iconsg=0; idebcg=0; - consgref = NULL; - iacross = 0; - newvar_list = NULL; - - ub = 0; /*OMP*/ - if (!OMP_program) {/*OMP*/ - first_do = stmt -> lexNext();// first DO statement of the loop nest - } else { - first_do = GetLexNextIgnoreOMP(stmt);// first DO statement of the loop nest /*OMP*/ - newj = ChangeParallelDir (stmt); - } - -//analysis of clauses - CheckClauses(stmt,clause); - - int interface = 0; /*ACC*/ -//interface selection: 0 - RTS1, 1- RTS1+RTS2(by handler), 2 - RTS2(by handler) - if(IN_COMPUTE_REGION || parloop_by_handler) - interface = 1; - if(parloop_by_handler == 2) { - interface = WhatInterface(stmt); - if(interface == 1) - err("Illegal clause",150,stmt ); - } -//initialization vpart[] - for(i=0; iexpr(2)); - for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) - nloop++; - - LINE_NUMBER_AFTER(stmt,stmt); // line number of PARALLEL directive - TransferLabelFromTo(first_do, stmt->lexNext()); -//generating call to 'bploop' function of performance analizer (begin of parallel interval) - if(perf_analysis && perf_analysis != 2) - InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' - - //par_st = cur_st; - -//renewing loop-header's variables (used in start-expr, end-expr, step-expr) - if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ - ACC_RenewParLoopHeaderVars(first_do,nloop); - -//allocating LoopRef and OutInitIndexArray,OutLastIndexArray,OutStepArray - iplp = ndvm++; - iout = ndvm; - if(interface != 2) - ndvm += 3*nloop; - -//looking through the loop nest - for(st=first_do,stl=NULL,i=0; ilexNext(),i++) { - stdo = isSgForStmt(st); - if(!stdo) - break; - else if( stl && !TightlyNestedLoops_Test(stl,st)) - err("Non-tightly-nested loops",339,st); - - stl = st; - //if(opt_loop_range) { - ChangeDistArrayRef(stdo->start()); - ChangeDistArrayRef(stdo->end()); - ChangeDistArrayRef(stdo->step()); - // } - do_var[i] = stdo->symbol(); - step[i] = stdo->step(); - if(!step[i]) - step[i] = & c1.copy(); // by default: step = 1 - init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,do_var); - if( init[i] ) - step[i] = & c1.copy(); - else - init[i] = stdo->start(); - - last[i] = stdo->end(); - - if (OMP_program) {/*OMP*/ - if (newj != NULL) {/*OMP*/ - if (ub == 0) {/*OMP*/ - if (isOmpGetNumThreads(last[i])) ub=1;/*OMP*/ - if (ub == 0) {/*OMP*/ - isOmpGetNumThreads(init[i]);/*OMP*/ - ub=2;/*OMP*/ - }/*OMP*/ - } /*OMP*/ - } /*OMP*/ - } /*OMP*/ - // setting new loop parameters - if(!opt_loop_range) { - if(vpart[i]) - stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form - //step is not replaced - else { - stdo->setStart(*DVM000(iout+i)); - } - stdo->setEnd(*DVM000(iout+i+nloop)); - } - else - stdo->setEnd(*DVM000(iout+i+nloop) - *new SgVarRefExp(*INDEX_SYMBOL(do_var[i]))); - - if(dvm_debug) - SetDoVar(stdo->symbol()); - } - - ndo = i; - -// test whether the PARALLEL directive is correct - if( !TestParallelDirective(stmt, nloop, ndo, first_do) ) - return(0); // directive is ignored - - if(interface == 2) - Interface_2(stmt,clause,init,last,step,nloop,ndo,first_do); //,iout,stl,newj,ub); - else - Interface_1(stmt,clause,do_var,init,last,step,nloop,ndo,first_do,iplp,iout,stl,newj,ub); - - cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest - // cur_st = stl->lexNext(); - - return(1); - -} - -void CopyHeaderElems(SgStatement *st_after) -{symb_list *sl; - SgStatement *stat; - SgExpression *e; - int i,rank; - coeffs *c; - stat=cur_st; - cur_st= st_after; //par_st; - for(sl=dvm_ar;sl;sl=sl->next) { - c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); - - rank=Rank(sl->symb); - for(i=2;i<=rank;i++) - doAssignTo_After(new SgVarRefExp(*(c->sc[i])), header_ref(sl->symb,i)); - e = opt_base ? (&(*header_ref(sl->symb,rank+2) + * new SgVarRefExp(*(c->sc[1])))) : header_ref(sl->symb,rank+2); - doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), e); - //doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), header_ref(sl->symb,rank+2)); - } - cur_st=stat; - //dvm_ar=NULL; -} - -void EndOfParallelLoopNest(SgStatement *stmt, SgStatement *end_stmt, SgStatement *par_do,SgStatement *func) - -{ //stmt is last statement of parallel loop or is body of logical IF , which - // is last statement - SgStatement *go_stmt; - - if(HPF_program) { - //first_hpf_exec = first_dvm_exec; - INDLoopBegin(); - OffDoVarsOfNest(end_stmt); - } else if(!IN_COMPUTE_REGION && !parloop_by_handler) { /*ACC*/ - CopyHeaderElems(parallel_dir->lexNext()); - dvm_ar=NULL; - } - - // replacing the label of DO statements locating above parallel loop in nest, - // which is ended by stmt(or stmt->controlParent()), - // by new label and inserting CONTINUE with this label - ReplaceDoNestLabel_Above(end_stmt, par_do, GetLabel()); - - if(dvm_debug) { - CloseDoInParLoop(end_stmt); //on debug regim end_stmt==stmt - end_stmt = cur_st; - } else if(perf_analysis == 4 && !IN_COMPUTE_REGION && !parloop_by_handler) { // RTS calls can not be inserted into the handler - SeqLoopEndInParLoop(end_stmt,stmt); - end_stmt = cur_st; - } - if(!IN_COMPUTE_REGION && !parloop_by_handler) { - // generating GO TO statement: GO TO begin_lab - // and inserting it after last statement of parallel loop nest - go_stmt = new SgGotoStmt(*begin_lab); - go_stmt->addAttribute (OMP_MARK); /*OMP*/ - cur_st->insertStmtAfter(*go_stmt,*par_do->controlParent()); - cur_st = go_stmt; // GO TO statement - SgStatement *continue_stat = new SgStatement(CONT_STAT); /*OMP*/ - continue_stat->addAttribute (OMP_MARK); /*OMP*/ - InsertNewStatementAfter( continue_stat,cur_st,cur_st->controlParent()); /*OMP*/ - } - if(dvm_debug) { - // generating call statement : call dendl(...) - CloseParLoop(end_stmt->controlParent(),cur_st,end_stmt); - } - if(!dvm_debug && stmt->lineNumber()) - { - LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,par_do->controlParent()); - } - // generating statements for special ACROSS: - if(iacross == -1){ - SendArray(spec_accr); - iacross = 0; - } - if(IN_COMPUTE_REGION) /*ACC*/ - // generating call statement to unregister remote_access buffers: - // call dvmh_destroy_array(...) - ACC_UnregisterDvmBuffers(); - if(parloop_by_handler != 2 || (parloop_by_handler==2 && WhatInterface(parallel_dir) != 2)) - // generating call statement: - // call endpl(LoopRef) - doCallAfter(EndParLoop(iplp)); - - // generating statements for ACROSS: - if(iacross){ - doCallAfter(SendBound(DVM000(iacross))); - doCallAfter(WaitBound(DVM000(iacross))); - doCallAfter(DeleteObject_H (DVM000(iacross))); - } - // actualizing of reduction variables - if(redgref) - ReductionVarsStart(red_list); - - if(irg) {//there is synchronous REDUCTION clause in PARALLEL - // generating call statement: - // call strtrd(RedGroupRef) - doCallAfter(StartRed(redgref)); - - // generating call statement: - // call waitrd(RedGroupRef) - doCallAfter(WaitRed(redgref)); - - if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ - ACC_ReductionVarsAreActual(); - - if(idebrg){ - if(dvm_debug) - doCallAfter( D_CalcRG(DVM000(idebrg))); - doCallAfter( D_DelRG (DVM000(idebrg))); - } - // generating statement: - // call dvmh_delete_object(RedGroupRef) //dvm000(i) = delobj(RedGroupRef) - doCallAfter(DeleteObject_H(redgref)); - } - - // actualizing of consistent arrays - if(consgref) - ConsistentArraysStart(cons_list); - - if(iconsg) {//there is synchronous CONSISTENT clause in PARALLEL - if(IN_COMPUTE_REGION) /*ACC*/ - // generating call statement: - // call dvmh_handle_consistent(ConsistGroupRef) - doCallAfter(HandleConsistent(consgref)); - // generating assign statement: - // dvm000(i) = strtcg(ConsistGroupRef) - doAssignStmtAfter(StartConsGroup(consgref)); - - // generating statement: - // dvm000(i) = waitcg(ConsistGroupRef) - doAssignStmtAfter(WaitConsGroup(consgref)); - - // generating statement: - // call dvmh_delete_object(ConsistGroupRef) //dvm000(i) = delobj(ConsistGroupRef) - doCallAfter(DeleteObject_H(consgref)); - } - - // generating call eloop(...) - end of parallel interval - // (performance analyzer function) - if(perf_analysis && perf_analysis != 2) { - InsertNewStatementAfter(St_Enloop(INTERVAL_NUMBER,INTERVAL_LINE),cur_st,cur_st->controlParent()); - CloseInterval(); - if(perf_analysis != 4) - OverLoopAnalyse(func); - } - if(!IN_COMPUTE_REGION && !parloop_by_handler) { - // setting label of ending parallel loop nest - if(!go_stmt->lexNext()->label()) - (go_stmt->lexNext())->setLabel(*end_lab); - else - go_stmt->insertStmtAfter(*ContinueWithLabel(end_lab), *go_stmt->controlParent()); - } - // implementing parallel loop nest in compute region: - // generating host- and cuda-handlers and cuda kernel for loop body - if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ - { ACC_ParallelLoopEnd(par_do); - if(!IN_COMPUTE_REGION) - DeleteNonDvmArrays(); - } - - //completing REMOTE_ACCESS - if(rma && !rma->rmout) - RemoteAccessEnd(); - - SET_DVM(iplp); - -} - - - -void CheckClauses(SgStatement *stmt, SgExpression *clause[]) -{ - SgExpression *el,*e; -// looking through the specification list - for(el=stmt->expr(1); el; el=el->rhs()) { - e = el->lhs(); // specification - switch (e->variant()) { - case NEW_SPEC_OP: - if(!clause[NEW_]){ - clause[NEW_] = e; - } else - err("Double NEW clause",153,stmt); - break; - case REDUCTION_OP: - if(!clause[REDUCTION_]){ - clause[REDUCTION_] = e; - } else - err("Double REDUCTION clause",154,stmt); - break; - - case SHADOW_RENEW_OP: - if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){ - clause[SHADOW_RENEW_] = e; - } else - err("Double shadow-renew-clause",155,stmt); - break; - - case SHADOW_START_OP: - if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){ - clause[SHADOW_START_] = e; - } else - err("Double shadow-renew-clause",155,stmt); - break; - - case SHADOW_WAIT_OP: - if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){ - clause[SHADOW_WAIT_] = e; - } else - err("Double shadow-renew-clause",155,stmt); - break; - - case SHADOW_COMP_OP: - if(!clause[SHADOW_COMPUTE_]){ - clause[SHADOW_COMPUTE_] = e; - } else - err("Double SHADOW_COMPUTE clause",155,stmt); - break; - - case REMOTE_ACCESS_OP: - if(!clause[REMOTE_ACCESS_]){ - clause[REMOTE_ACCESS_] = e; - } else - err("Double REMOTE_ACCESS clause",156,stmt); - break; - - case CONSISTENT_OP: - if(!clause[CONSISTENT_]){ - clause[CONSISTENT_] = e; - } else - err("Double CONSISTENT clause",296,stmt); - break; - - case STAGE_OP: - if(!clause[STAGE_]){ - clause[STAGE_] = e; - } else - err("Double STAGE clause",298,stmt); - break; - - case ACC_PRIVATE_OP: - if(!clause[PRIVATE_]){ - clause[PRIVATE_] = e; - } else - err("Double PRIVATE clause",607,stmt); - break; - - case ACC_CUDA_BLOCK_OP: - if(!clause[CUDA_BLOCK_]){ - clause[CUDA_BLOCK_] = e; - } else - err("Double CUDA_BLOCK clause",608,stmt); - break; - - case ACC_TIE_OP: - if(!clause[TIE_]){ - clause[TIE_] = e; - } else - err("Double TIE clause",608,stmt); - break; - - case ACROSS_OP: - if(!clause[ACROSS_]){ - clause[ACROSS_] = e; - } else - err("Double ACROSS clause",157,stmt); - break; - } - } - - if(clause[SHADOW_COMPUTE_] && clause[REDUCTION_]) - err("Inconsistent clauses: SHADOW_COMPUTE and REDUCTION",443,stmt); - - if(IN_COMPUTE_REGION && ( clause[SHADOW_START_] || clause[SHADOW_WAIT_] || clause[CONSISTENT_] && clause[CONSISTENT_]->symbol() || clause[REMOTE_ACCESS_] && clause[REMOTE_ACCESS_]->symbol())) - err("Illegal clause of PARALLEL directive in region (SHADOW_START,SHADOW_WAIT,asynchronous CONSISTENT or asynchronous REMOTE_ACCESS)",445,stmt); - -} - -int WhatInterface(SgStatement *stmt) -{ - SgExpression *el,*e; -// undistributed parallel loop - if(!stmt->expr(0)) - return(2); -// is mapped on template? - //if(stmt->expr(0)->symbol()->attributes() & TEMPLATE_BIT) - // return (1); -// looking through the specification list of PARALLEL directive - for(el=stmt->expr(1); el; el=el->rhs()) { - e = el->lhs(); // specification - switch (e->variant()) { - case ACC_PRIVATE_OP: - case ACC_CUDA_BLOCK_OP: - case SHADOW_RENEW_OP: - case SHADOW_COMP_OP: - case ACROSS_OP: - case ACC_TIE_OP: - case CONSISTENT_OP: - case STAGE_OP: - case REMOTE_ACCESS_OP: - if(e->symbol()) // asynchronous REMOTE_ACCESS - return(1); - else - break; - case REDUCTION_OP: - if(TestReductionClause(e)) - break; - else - return(1); - default: - return (1); - } - } - return (2); -} - -int areIllegalClauses(SgStatement *stmt) -{ - SgExpression *el; - for(el=stmt->expr(1); el; el=el->rhs()) - if(el->lhs()->variant() != REDUCTION_OP && el->lhs()->variant() != ACC_PRIVATE_OP && el->lhs()->variant() != ACC_CUDA_BLOCK_OP && el->lhs()->variant() != ACROSS_OP && el->lhs()->variant() != ACC_TIE_OP) - return 1; - return 0; -} - -int TestParallelWithoutOn(SgStatement *stmt, int flag) -{ - if(!stmt->expr(0) && parloop_by_handler != 2) //undistributed parallel loop - { - if(flag) - warn("PARALLEL directive is ignored, -Opl2 option should be specified",621,stmt); - return(0); - } else - return (1); -} - -int TestParallelDirective(SgStatement *stmt, int nloop, int ndo, SgStatement *first_do) -{ // stmt - PARALLEL directive; nloop - number of items in the do-variable list of directive; - // ndo - number of loops (do-statements) in the nest - SgExpression *dovar; - SgStatement *st; - int flag_err=1; //flag of an error message - - if(!nloop) // not determined yet (AnalyzeRegion()) - { flag_err = 0; - // first DO statement of the loop nest - first_do = OMP_program ? GetLexNextIgnoreOMP(stmt) : stmt->lexNext(); - //looking through the do_variable list of directive - for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) - nloop++; - - //looking through the loop nest - for(st=first_do,ndo=0; ndolexNext(),ndo++) - { - if(!isSgForStmt(st)) - break; - } - } - - if(ndo == 0) { - if(flag_err) - err("Directive PARALLEL must be followed by DO statement", 97, stmt); - return(0); - } - - if(nloop > ndo) { - if(flag_err) - err("Length of do-variable list in PARALLEL directive is greater than the number of nested DO statements", 158,stmt); - return(0); - } - - for(st=first_do,dovar=stmt->expr(2); dovar; st=st->lexNext(),dovar=dovar->rhs()) - { - if(dovar->lhs()->symbol() != st->symbol()) { - if(flag_err) - err("Illegal do-variable list in PARALLEL directive",159,stmt); - return(0); - } - } - - if(!stmt->expr(0) && areIllegalClauses(stmt)) //undistributed parallel loop - { - if(flag_err) - err("Illegal clause",150,stmt ); - return(0); - - } - - if(!only_debug && stmt->expr(0) && !HEADER(stmt->expr(0)->symbol())) { - if(flag_err) - Error("'%s' isn't distributed array", stmt->expr(0)->symbol()->identifier(), 72,stmt); - return(0); - } - - return(1); -} - -int doParallelLoopByHandler(int iplp, SgStatement *first, SgExpression *clause[], SgExpression *oldGroup, SgExpression *newGroup,SgExpression *oldGroup2, SgExpression *newGroup2) -{ /*ACC*/ - int ilh = ndvm; - LINE_NUMBER_AFTER(first,cur_st); - cur_st->addComment(ParallelLoopComment(first->lineNumber())); - doAssignStmtAfter(LoopCreate_H(cur_region ? cur_region->No : 0, iplp)); - if (clause[REDUCTION_]) //there is REDUCTION clause in parallel loop - InsertReductions_H(clause[REDUCTION_]->lhs(), ilh); - - if (clause[CUDA_BLOCK_]) //there is CUDA_BLOCK clause - { - int ib; - ib = ndvm; - CudaBlockSize(clause[CUDA_BLOCK_]->lhs()); - InsertNewStatementAfter(SetCudaBlock_H(ilh, ib), cur_st, cur_st->controlParent()); - } - - if (clause[TIE_]) //there is TIE clause - { - SgExpression *el; - for (el=clause[TIE_]->lhs(); el; el=el->rhs()) - InsertNewStatementAfter(Correspondence_H(ilh, HeaderForArrayInParallelDir(el->lhs()->symbol(),parallel_dir,1), AxisList(parallel_dir,el->lhs())), cur_st, cur_st->controlParent()); - } - - if (oldGroup) // loop with ACROSS clause - InsertNewStatementAfter(LoopAcross_H(ilh, oldGroup, newGroup), cur_st, cur_st->controlParent()); - - if (oldGroup2) // loop with ACROSS clause - InsertNewStatementAfter(LoopAcross_H(ilh, oldGroup2, newGroup2), cur_st, cur_st->controlParent()); - - return(ilh); -} - -void Interface_1(SgStatement *stmt,SgExpression *clause[],SgSymbol *do_var[],SgExpression *init[],SgExpression *last[],SgExpression *step[],int nloop,int ndo,SgStatement *first_do,int iplp,int iout,SgStatement *stl,SgSymbol *newj,int ub) -{ - SgStatement *stc,*if_stmt=NULL,*st2=NULL,*st3=NULL; - SgStatement *stdeb = NULL,*stat = NULL,*stg = NULL,*stcg = NULL; - SgValueExp c0(0),c1(1); - SgExpression *stage=NULL,*dopl=NULL,*dovar,*head; - SgExpression *oldGroup = NULL, *newGroup=NULL; /*ACC*/ - SgExpression *oldGroup2 = NULL, *newGroup2=NULL; /*ACC*/ - SgSymbol *spat; - int all_positive_step=-1; - int iacrg=-1,iinp; - int iaxis,i, isg = 0; - int nr; //number of aligning rules i.e. length of align-loop-index-list - int ag[3] = {0, 0, 0}; - int step_mask[MAX_LOOP_LEVEL], - loop_num[MAX_DIMS]; - - - stc = cur_st; // saving - // generating assign statement: - // dvm000(iplp) = crtpl(Rank); - //iplp = CreateParLoop( nloop); - doAssignTo_After(DVM000(iplp),CreateParLoop(nloop)); - - if(dvm_debug && dbg_if_regim>1) { //copy loop nest - SgStatement *last_st,*lst; - last_st= LastStatementOfDoNest(first_do); - if(last_st != (lst=first_do->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) - { last_st=ReplaceLabelOfDoStmt(first_do,last_st, GetLabel()); - ReplaceDoNestLabel_Above(last_st,first_do,GetLabel()); - } - stdeb=first_do->copyPtr(); - } - //--------------------------------------------------------------------------- - // processing specifications/clauses - - if(clause[NEW_]) - NewVarList(clause[NEW_]->lhs(),stmt); - - if(clause[REDUCTION_]) - { - red_list = clause[REDUCTION_]->lhs(); - stat = cur_st; //store current statement - cur_st = stc; //insert statements for creating reduction group - //before CrtPL i.e. before creating parallel loop - if( clause[REDUCTION_]->symbol()) { - redgref = new SgVarRefExp(clause[REDUCTION_]->symbol()); - doIfForReduction(redgref,1); - nloopred++; - stg = doIfForCreateReduction( clause[REDUCTION_]->symbol(),nloopred,0); - } else { - irg = ndvm; - redgref = DVM000(irg); - doAssignStmtAfter(CreateReductionGroup()); - if(debug_regim){ - idebrg = ndvm; - doAssignStmtAfter( D_CreateDebRedGroup()); - } - stg = cur_st;//store current statement - } - cur_st = stat; // restore cur_st - - } - if(clause[SHADOW_RENEW_]) - { - isg = ndvm++;// index for BoundGroupRef - CreateBoundGroup(DVM000(isg)); - //looking through the array_with_shadow_list - ShadowList(clause[SHADOW_RENEW_]->lhs(), stmt, DVM000(isg)); - if(ACC_program) /*ACC*/ - {// generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - - doCallAfter(ShadowRenew_H(DVM000(isg))); //(GPU000(ish_gpu),StartShadow_GPU(cur_region->No,DVM000(isg))); - } - // generating assign statement: - // dvm000(i) = strtsh(BoundGroupRef) - doCallAfter(StartBound(DVM000(isg))); - } - - if(clause[SHADOW_START_]) //sh_start - { - SgExpression *sh_start = new SgVarRefExp(clause[SHADOW_START_]->symbol()); - if(ACC_program) /*ACC*/ - {// generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - doCallAfter(ShadowRenew_H(sh_start)); - } - // generating assign statement: - // dvm000(i) = exfrst(LoopRef,BounGroupRef) - doCallAfter(BoundFirst(iplp,sh_start)); - } - - if(clause[SHADOW_WAIT_]) //sh_wait - // generating assign statement: - // dvm000(i) = imlast(LoopRef,BounGroupRef) - doCallAfter(BoundLast(iplp,new SgVarRefExp(clause[SHADOW_WAIT_]->symbol()))); - - if(clause[SHADOW_COMPUTE_]) - { - if( (clause[SHADOW_COMPUTE_]->lhs())) - ShadowComp(clause[SHADOW_COMPUTE_]->lhs(),stmt,0); - else - doCallAfter(AddBound()); - } - if(clause[REMOTE_ACCESS_]) - { - //adding new element to remote_access directive/clause list - AddRemoteAccess(clause[REMOTE_ACCESS_]->lhs(),NULL); - } - if(clause[CONSISTENT_]) - { - SgExpression *e = clause[CONSISTENT_]; - cons_list = e->lhs(); - stat = cur_st; //store current statement - cur_st = stc; //insert statements for creating reduction group - //before CrtPL i.e. before creating parallel loop - if( e->symbol()){ - consgref = new SgVarRefExp(e->symbol()); - doIfForConsistent(consgref); - nloopcons++; - stcg = doIfForCreateReduction( e->symbol(),nloopcons,0); - } else { - iconsg = ndvm; - consgref = DVM000(iconsg); - doAssignStmtAfter(CreateConsGroup(1,1)); - //!!!??? if(debug_regim){ - // idebcg = ndvm; - // doAssignStmtAfter( D_CreateDebRedGroup()); - //} - stcg = cur_st;//store current statement - } - cur_st = stat; // restore cur_st - } - - if(clause[STAGE_]) - { - if( clause[STAGE_]->lhs()->variant()==MINUS_OP && INTEGER_VALUE(clause[STAGE_]->lhs()->lhs(),1) ) //STAGE(-1) - stage = IN_COMPUTE_REGION ? GetStage(first_do,iplp) : &c0.copy(); - else - stage = ReplaceFuncCall(clause[STAGE_]->lhs()); - } - - if (clause[TIE_]) - for (SgExpression *el=clause[TIE_]->lhs(); el; el=el->rhs()) //list of tied arrays - AxisList(stmt, el->lhs()); //for testing - - if(clause[ACROSS_]) - { - int not_in=0; - SgExpression *e_spec[2]; - SgExpression *e = clause[ACROSS_]; - int all_steps = Analyze_DO_steps(step,step_mask,ndo); - InOutAcross(e,e_spec,stmt); - SgExpression *in_spec =e_spec[IN_]; - SgExpression *out_spec=e_spec[OUT_]; - if(not_in && in_spec && !out_spec) { // old implementation - stat = cur_st;//store current statement - cur_st = stc; //insert statements for creating shadow group - //before CrtPL i.e. before creating parallel loop - iacross = ndvm++;// index for ShadowGroupRef - //looking through the dependent_array_list - if(DepList(e->lhs(), stmt, DVM000(iacross),ANTIDEP)){ - doCallAfter(StartBound(DVM000(iacross))); - doCallAfter(WaitBound(DVM000(iacross))); - doAssignStmtAfter(DeleteObject(DVM000(iacross))); - SET_DVM(iacross+1); - } - if(DepList(e->lhs(), stmt, DVM000(iacross),FLOWDEP)){ - doCallAfter(ReceiveBound(DVM000(iacross))); - doCallAfter(WaitBound(DVM000(iacross))); - SET_DVM(iacross+1); - } else { - if (iacross == -1) - spec_accr = e->lhs(); - else - iacross = 0; - } - cur_st = stat; // restore cur_st - } else {// new implementation - iacrg=ndvm; ndvm+=3; - if(IN_COMPUTE_REGION || parloop_by_handler) - ndvm+=3; - CreateShadowGroupsForAccross(in_spec,out_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+1),ACC_GroupRef(iacrg+2),ag,all_steps,step_mask,(clause[TIE_] ? clause[TIE_]->lhs() : NULL) ); - /* - if(all_positive_step) //(PositiveDoStep(step,ndo)) - CreateShadowGroupsForAccross(in_spec,out_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+1),ACC_GroupRef(iacrg+2),ag,all_positive_step,loop_num); - else { - //ag[1] = -1; - if(out_spec || in_spec->rhs() ) - //if(in_spec->rhs()) in_spec->rhs()->unparsestdout(); - err("Illegal ACROSS clause",444,stmt); - else if (stmt->expr(0)->symbol() != (in_spec->lhs()->variant() == ARRAY_OP ? in_spec->lhs()->lhs()->symbol() : in_spec->lhs()->symbol())) - Error("The base array '%s' should be specified in ACROSS clause", stmt->expr(0)->symbol()->identifier(), 256, stmt); - DefineLoopNumberForNegStep(step_mask,DefineLoopNumberForDimension(stmt,loop_num),loop_num); - CreateShadowGroupsForAccrossNeg(in_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+2),ag,all_positive_step,loop_num); - //k=ag[2]; ag[2] = ag[0]; ag[0] = k; - - } */ - } - } - -//------------------------------------------------------------------------------ - - iinp = ndvm; - if(dvm_debug) - OpenParLoop_Inter(stl,iinp,iinp+nloop,do_var,nloop); -// creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray -// and InpStepArray - for(i=0,dovar=stmt->expr(2); irhs()) - doAssignStmtAfter(GetAddres(do_var[i])); - - for(i=0; iexpr(0))->symbol(); // target array symbol - head = HeaderRef(spat); - iaxis = ndvm; - nr = doAlignIteration(stmt,NULL); - - if(isg) { - // generating assign statement: - // dvm000(i) = waitsh(BoundGroupRef) - doCallAfter(WaitBound(DVM000(isg))); - } - -// generating assign statement: -// dvm000(i) = -// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[], -// LoopVarAdrArray[], InpInitIndexArray[], InpLastIndexArray[], -// InpStepArray[], -// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[]) - - doCallAfter( BeginParLoop (iplp, head, nloop, iaxis, nr, iinp, iout)); - - if(redgref) { - if(!irg) { - st2 = doIfForCreateReduction( redgref->symbol(),nloopred,1); - st3 = cur_st; - ReductionList(red_list,redgref,stmt,stg,st2,0); - cur_st = st3; - InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); - } else - ReductionList(red_list,redgref,stmt,stg,cur_st,0); - } - - if(consgref) { - if(!iconsg) { - st2 = doIfForCreateReduction( consgref->symbol(),nloopcons,1); - st3 = cur_st; - ConsistentArrayList(cons_list,consgref,stmt,stcg,st2); - cur_st = st3; - InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); - } else - ConsistentArrayList(cons_list,consgref,stmt,stcg,cur_st); - } - - if(clause[REMOTE_ACCESS_]) //rvle - RemoteVariableList(clause[REMOTE_ACCESS_]->symbol(), clause[REMOTE_ACCESS_]->lhs(), stmt); - - if(iacross == -1) - ReceiveArray(spec_accr,stmt); - - if(clause[ACROSS_] && !clause[STAGE_]) // there is ACROSS clause and is not STAGE clause - stage = &c0.copy(); //IN_COMPUTE_REGION ? GetStage(first_do,iplp) : &c0.copy(); - - if(all_positive_step) { - if(ag[0]) { - pipeline=1; - doAssignTo_After(new SgVarRefExp(Pipe), stage); - - if(ACC_program && ag[2]) /*ACC*/ - // generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); - doCallAfter(InitAcross(0,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),DVM000(iacrg))); - if(IN_COMPUTE_REGION || parloop_by_handler) - { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/ - newGroup = DVM000(iacrg+3); /*ACC*/ - } - if(ag[1]) { - doCallAfter(InitAcross(1, ConstRef(0), DVM000(iacrg+1))); - if(IN_COMPUTE_REGION || parloop_by_handler) - { oldGroup2 = ConstRef(0); /*ACC*/ - newGroup2 = DVM000(iacrg+4); /*ACC*/ - } - } - } - else { - if(ag[1]){ - pipeline=1; - doAssignTo_After(new SgVarRefExp(Pipe), stage); - - if(ACC_program && ag[2]) /*ACC*/ - // generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); - - doCallAfter(InitAcross(1,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),DVM000(iacrg+1))); - if(IN_COMPUTE_REGION || parloop_by_handler) - { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/ - newGroup = DVM000(iacrg+4); /*ACC*/ - } - } - else if(ag[2]){ - //err("SHADOW_RENEW clause is required",...,stmt); - pipeline=1; - doAssignTo_After(new SgVarRefExp(Pipe), stage); - if(ACC_program) /*ACC*/ - // generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); - //doCallAfter(StartBound(DVM000(iacrg+2))); /*09.12.19*/ - //doCallAfter(WaitBound (DVM000(iacrg+2))); /*09.12.19*/ - doCallAfter(InitAcross(1,DVM000(iacrg+2), ConstRef(0))); /*09.12.19*/ - if(IN_COMPUTE_REGION || parloop_by_handler) - { oldGroup = DVM000(iacrg+5); /*ACC*/ - newGroup = ConstRef(0); /*ACC*/ - } - } - } - } else{ //there is negative loop step - if(ag[0] || ag[2]) { - pipeline=1; - doAssignTo_After(new SgVarRefExp(Pipe), stage); - - if(ACC_program && ag[2]) /*ACC*/ - // generating call statement ( in and out compute region): - // call dvmh_shadow_renew( BoundGroupRef) - doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); - doCallAfter(InitAcross(0,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),(ag[0] ? DVM000(iacrg) : ConstRef(0)))); - if(IN_COMPUTE_REGION || parloop_by_handler) - { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/ - newGroup = ag[0] ? DVM000(iacrg+3) : ConstRef(0); /*ACC*/ - } - } - } - if(dvm_debug) { - pardo_line = first_do->lineNumber(); - DebugParLoop(cur_st,nloop,iinp+2*nloop); - } - - StoreLoopPar(init,nloop,iout,NULL); - StoreLoopPar(last,nloop,iout+nloop,NULL); - - if(opt_loop_range) ChangeLoopInitPar(first_do,nloop,init,stmt->lexNext());//must be after StoreLoopPar - - if (OMP_program == 1) { /*OMP*/ - if (clause[ACROSS_]) { /*OMP*/ - ChangeAccrossOpenMPParam (first_do,newj,ub); /*OMP*/ - } /*OMP*/ - } /*OMP*/ - - - if(!IN_COMPUTE_REGION && !parloop_by_handler) - { - // generating Logical IF statement: - // begin_lab IF (DoPL(LoopRef) .EQ. 0) GO TO end_lab - // and inserting it before loop nest - SgStatement *stn = cur_st; - SgStatement *continue_stat = new SgStatement(CONT_STAT); /*OMP*/ - continue_stat->addAttribute (OMP_MARK); - InsertNewStatementAfter(continue_stat,cur_st,cur_st->controlParent()); /*OMP*/ - LINE_NUMBER_AFTER(first_do,cur_st); - begin_lab = GetLabel(); - stn->lexNext()-> setLabel(*begin_lab); - end_lab = GetLabel(); - if(dvm_debug && dbg_if_regim) - { - int ino; - ino = ndvm; - doAssignStmtAfter(new SgValueExp(pardo_No)); - dopl = doPLmb(iplp,ino); - } else - dopl = doLoop(iplp); - //if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); - //if_stmt -> setLabel(*begin_lab); /*29.06.01*/ - // BIF_LABEL(stmt->thebif) = NULL; - doAssignStmtAfter(dopl); // podd 17.05.11 (doLoop(iplp));/*OMP*/ - SgGotoStmt *go=new SgGotoStmt(*end_lab);/*OMP*/ - go->addAttribute (OMP_MARK);/*OMP*/ - if_stmt = new SgLogIfStmt(SgEqOp(*DVM000(ndvm-1), c0), *go);/*OMP*/ - if_stmt->addAttribute (OMP_MARK);/*OMP*/ - //if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); - //cur_st->insertStmtAfter(*if_stmt); - InsertNewStatementAfter (if_stmt, cur_st, cur_st->controlParent ());/*OMP*/ - if(opt_loop_range) - { - cur_st=if_stmt->lexNext()->lexNext(); - doAssignIndexVar(stmt->expr(2),iout,init); - } - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF - // (error Sage) - } - - if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ - { int ilh = doParallelLoopByHandler(iplp, first_do, clause, oldGroup, newGroup,oldGroup2, newGroup2); - ACC_CreateParallelLoop(ilh,first_do,nloop,stmt,clause,1); - } - - if(dvm_debug && dbg_if_regim>1) - { - SgStatement *ifst = new SgIfStmt(*DebugIfNotCondition(), *stdeb); //*new SgStatement(CONT_STAT));// *stdeb); //, *new SgStatement(CONT_STAT)); - - (if_stmt->lexNext())->insertStmtAfter(*ifst,*if_stmt->controlParent()); - - // generating GO TO statement: GO TO begin_lab - // and inserting it after last statement of parallel loop nest copy - // InsertNewStatementBefore(new SgGotoStmt(*begin_lab),ifst->lastNodeOfStmt()); - //(ifst->lastNodeOfStmt())->insertStmtBefore(*new SgGotoStmt(*begin_lab),*ifst); - //InsertNewStatementAfter(new SgGotoStmt(*begin_lab),stdeb->lastNodeOfStmt(),ifst); - (stdeb->lastNodeOfStmt())->insertStmtAfter(*new SgGotoStmt(*begin_lab),*ifst); - TranslateBlock(stdeb); - } - -} - -void ChangeLoopInitPar(SgStatement*first_do,int nloop,SgExpression *do_init[],SgStatement *after) -{ SgStatement *stat, *st; - SgForStmt *stdo; - SgSymbol *s,*do_var, *s_start; - SgExpression *init; - int i; - stat=cur_st; - cur_st=after; - - for(st=first_do,i=0; ilexNext(),i++) { - stdo = isSgForStmt(st); - if(!stdo) break; - do_var = stdo->symbol(); - init = stdo->start(); -// for(i=0; isymbol(); - if(s && isInSymbList(newvar_list,s)){ - s_start = CreateInitLoopVar(do_var,s); - doAssignTo_After(new SgVarRefExp(s_start),&(init->copy())); - stdo->setStart(*new SgVarRefExp(s_start)); - do_init[i] = stdo->start(); - } - } - } - cur_st=stat; -} - -int PositiveDoStep(SgExpression *step[], int i) -{int s; - SgExpression *es; - if(step[i]->isInteger()) - s=step[i]->valueInteger(); - else if((es=Calculate(step[i]))->isInteger()) - s= es->valueInteger(); - else - { err("Non constant step in parallel loop nest with ACROSS clause",613,par_do); - s =0; - } - if(s >= 0) - return(1); - else - return(0); - -} - -int Analyze_DO_steps(SgExpression *step[], int step_mask[],int ndo) -{ int s,i; - s=1; - for(i=0; i 0) - return (0); - return (-1); -} - -void InOutAcross(SgExpression *e, SgExpression* e_spec[], SgStatement *stmt) -{ - e_spec[IN_] = NULL; - e_spec[OUT_]= NULL; - InOutSpecification(e->lhs(), e_spec); - InOutSpecification(e->rhs(), e_spec); - if(e->lhs() && e->rhs() && (e_spec[IN_] == NULL || e_spec[OUT_] == NULL)) - err("Double IN/OUT specification in ACROSS clause",257 ,stmt); -} - -void InOutSpecification(SgExpression *ea,SgExpression* e_spec[]) -{ - SgKeywordValExp *kwe; - - if(!ea) return; - if(ea->variant() != DDOT) { - e_spec[IN_] = ea; - } else { - if((kwe=isSgKeywordValExp(ea->lhs())) && (!strcmp(kwe->value(),"in"))) - e_spec[IN_] = ea->rhs(); - else - e_spec[OUT_] = ea->rhs(); - } -} - -void CreateShadowGroupsForAccross(SgExpression *in_spec,SgExpression *out_spec,SgStatement * stmt,SgExpression *gleft,SgExpression *g,SgExpression *gright,int ag[],int all_steps,int step_mask[],SgExpression *tie_list) -{ - RecurList(in_spec, stmt,gleft, ag,0,all_steps,step_mask,tie_list); - RecurList(out_spec,stmt,gleft, ag,0,all_steps,step_mask,tie_list); - RecurList(in_spec, stmt,gright,ag,2,all_steps,step_mask,tie_list); - RecurList(out_spec,stmt,gright,ag,2,all_steps,step_mask,tie_list); - if(ag[1] == -1) - ag[1] = 0; - else - RecurList(out_spec,stmt,g,ag,1,all_steps,step_mask,tie_list); -} - -void DefineLoopNumberForNegStep(int step_mask[], int n,int loop_num[]) -{int i; - for(i=0;i 0) - if(step_mask[loop_num[i]-1] > 0) - loop_num[i] = 0; -} - -void DefineStepSignForDimension( int step_mask[], int n, int loop_num[], int sign[] ) -{int i; - for(i=0; i 0) - sign[i] = step_mask[loop_num[i]-1] > 0 ? 1 : -1; -} - -/* -void CreateShadowGroupsForAccrossNeg(SgExpression *in_spec, SgStatement * stmt, SgExpression *gleft,SgExpression *gright,int ag[],int all_positive_step,int loop_num[]) -{ - RecurList(in_spec, stmt,gleft, ag,0,all_positive_step,loop_num); - // RecurList(out_spec,stmt,gleft, ag,0); - RecurList(in_spec, stmt,gright,ag,2,all_positive_step,loop_num); - // RecurList(out_spec,stmt,gright,ag,2); - if(ag[1] == -1) - ag[1] = 0; - // else - // RecurList(out_spec,stmt,g,ag,1); -} -*/ - -SgExpression *FindArrayRefWithLoopIndexes(SgSymbol *ar, SgStatement *st, SgExpression *tie_list) -{ - SgExpression *arr_ref = NULL; - if( ar == st->expr(0)->symbol()) - arr_ref = st->expr(0); - else - arr_ref = tie_list ? isInTieList(ar, tie_list) : NULL; - if(!arr_ref) - Error("Array from ACROSS clause should be specified in TIE clause: %s", ar->identifier(), 648, st); - return arr_ref; -} - -int RecurList (SgExpression *el, SgStatement *st, SgExpression *gref, int *ag, int gnum,int all_steps,int step_mask[],SgExpression *tie_list) -{ SgValueExp c1(1); - int rank,ndep; - int ileft,idv[6]; - SgExpression *es, *ear, *head, *esec, *esc, *lrec[MAX_DIMS], *rrec[MAX_DIMS], *gref_acc = NULL; - SgSymbol *ar; - int loop_num[MAX_DIMS], sign[MAX_DIMS]; - //int nel = 0; - - // looking through the dependent_array_list - for(es = el; es; es = es->rhs()) { - if( es->lhs()->variant() == ARRAY_OP){ - ear = es->lhs()->lhs(); - esec= es->lhs()->rhs(); - //corner = 1; - } else { - ear = es->lhs(); // dependent_array - esec = NULL; - //corner = 0; - if(!ear->lhs()){ //whole array - iacross = -1; - return(0); - } - } - ar = ear->symbol(); - if(HEADER(ar)) - head = HeaderRef(ar); - else - { - Error("'%s' isn't distributed array", ar->identifier(), 72,st); - return(0); - } - rank = Rank(ar); - ileft = ndvm; - if(!all_steps) - DefineStepSignForDimension(step_mask, DefineLoopNumberForDimension(st, FindArrayRefWithLoopIndexes(ar,st,tie_list), loop_num), loop_num, sign); - ndep = doRecurLengthArrays(ear->lhs(), ear->symbol(), st, gnum, all_steps, sign); - if(!ndep) continue; - if(GROUP_INDEX(gref)) - gref_acc=DVM000(*GROUP_INDEX(gref)); - ag[gnum]++; - if(ag[gnum] == 1) - { CreateBoundGroup(gref); - if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) ) /*ACC*/ - CreateBoundGroup(gref_acc); - } - - if(!esec) - { doCallAfter(InsertArrayBoundDep(gref, head, ileft, ileft+rank, 1, ileft+2*rank)); - if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) ) /*ACC*/ - doCallAfter(InsertArrayBoundDep(gref_acc, head, ileft, ileft+rank, 1, ileft+2*rank)); - } - else { - if(!Recurrences(ear->lhs(),lrec,rrec,MAX_DIMS)) - err("Recurrence list is not specified", 261, st); - for(esc=esec; esc; esc=esc->rhs()) { - doSectionIndex(esc->lhs(), ear->symbol(), st, idv, ileft, lrec, rrec); - doCallAfter(InsertArrayBoundSec(gref, head, idv[0],idv[1],idv[2], idv[3],idv[4], idv[5], 1, ileft+2*rank)); - if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) ) /*ACC*/ - doCallAfter(InsertArrayBoundSec(gref_acc, head, idv[0],idv[1],idv[2], idv[3],idv[4], idv[5], 1, ileft+2*rank)); - } - - } - } - return(ag[gnum]); -} - -int doRecurLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int rtype, int all_steps,int sign[]) -{SgValueExp c0(0),c1(1),cM1(-1),c3(3), c5(5); - int rank,nw,nnl,positive=0; - int i=0; - nnl = 0; - SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS],*eneg; - rank = Rank(ar); - if(!shl) //without dependence-list , - // by default dependence length is equal to the maximal size of shadow edge - for(i=rank-1,nnl=1; i>=0; i--) { - bound[i] = &cM1; - null[i] = &c0; - shsign[i] = &c3; - } - if(!TestMaxDims(shl,ar,st)) - return(0); - for(wl = shl; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - positive = (all_steps == 1 || all_steps == 0 && sign[i] >= 0) ? 1 : 0; - if(rtype > 0) { - if(positive) - bound[i] = &(ew->rhs())->copy();//right bound - else - bound[i] = &(ew->lhs())->copy();//left bound - - } - else { - if(positive) - bound[i] = &(ew->lhs())->copy();//left bound - else - bound[i] = &(ew->rhs())->copy();//right bound - } - null[i] = &c0; - if(bound[i]->variant() != INT_VAL) { - Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); - shsign[i] = &c1; - } - else if(bound[i]->valueInteger() != 0) { - nnl++; - if(positive) - shsign[i] = (rtype > 0) ? &c5 : &c3; - else { - shsign[i] = (rtype > 0) ? &c3 : &c5; - eneg = null[i] ; - null[i] = bound[i]; - bound[i] = eneg; - } - } else - shsign[i] = &c1; - } - nw = i; - - if (rank && (nw != rank) ) {// wrong dependence length list length - if(rtype == 0) - Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); - return(0); - } - if(!nnl) return(0); - if(rtype > 0){ - TestShadowWidths(ar, null, bound, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(shsign[i]); - } - else { - TestShadowWidths(ar, bound, null, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(shsign[i]); - } - return(nnl); -} - -/* according Language Description (by dependence length) -int doRecurLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int rtype,int all_positive_step,int loop_num[]) -{SgValueExp c0(0),c1(1),cM1(-1),c3(3), c5(5); - int rank,nw,nnl,flag; - int i=0; - nnl = 0; - SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS],*eneg; - rank = Rank(ar); - if(!shl) //without dependence-list , - // by default dependence length is equal to the maximal size of shadow edge - for(i=rank-1,nnl=1; i>=0; i--){ - bound[i] = &cM1; - null[i] = &c0; - shsign[i] = &c3; - } - if(!TestMaxDims(shl,ar,st)) - return(0); - for(wl = shl; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - flag = all_positive_step ? 0 : loop_num[i]; - if(rtype > 0) { - //if(!flag) - bound[i] = &(ew->rhs())->copy();//right bound - //else - // bound[i] = &(ew->lhs())->copy();//left bound - - } - else { - //if(!flag) - bound[i] = &(ew->lhs())->copy();//left bound - //else - // bound[i] = &(ew->rhs())->copy();//right bound - } - null[i] = &c0; - if(bound[i]->variant() != INT_VAL) { - Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); - shsign[i] = &c1; - } - else if(bound[i]->valueInteger() != 0) { - nnl++; - if(!flag) - shsign[i] = (rtype > 0) ? &c5 : &c3; - else { - shsign[i] = (rtype > 0) ? &c3 : &c5; - eneg = null[i] ; - null[i] = bound[i]; - bound[i] = eneg; - } - } else - shsign[i] = &c1; - } - nw = i; - - if (rank && (nw != rank) ) {// wrong dependence length list length - if(rtype == 0) - Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); - return(0); - } - if(!nnl) return(0); - if(rtype > 0){ - TestShadowWidths(ar, null, bound, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(shsign[i]); - } - else { - TestShadowWidths(ar, bound, null, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(shsign[i]); - } - return(nnl); -} -*/ - -int Recurrences(SgExpression *shl, SgExpression *lrec[], SgExpression *rrec[],int n) -{SgValueExp c0(0),c1(1); - int i; - SgExpression *wl,*ew; - if(!shl) //without recurrence list - return(0); - for(i=n; i;i--){ - rrec[i-1] = &c0.copy(); - lrec[i-1] = &c0.copy(); - } - for(wl = shl,i=0; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - rrec[i] = &(ew->rhs())->copy();//right bound - lrec[i] = &(ew->lhs())->copy();//left bound -} - return(i); -} - -int DepList (SgExpression *el, SgStatement *st, SgExpression *gref, int dep) -{ SgValueExp c1(1); - int corner,rank,ndep; - int ileft; - SgExpression *es, *ear, *head; - SgSymbol *ar; - int nel = 0; - // looking through the dependent_array_list - for(es = el; es; es = es->rhs()) { - if( es->lhs()->variant() == ARRAY_OP){ - ear = es->lhs()->lhs(); - corner = 1; - } else { - ear = es->lhs(); // dependent_array - corner = 0; - if(!ear->lhs()){ //whole array - iacross = -1; - return(0); - } - } - ar = ear->symbol(); - if(HEADER(ar)) - head = HeaderRef(ar); - else { - Error("'%s' isn't distributed array", ar->identifier(), 72,st); - return(0); - } - rank = Rank(ar); - ileft = ndvm; - ndep = doDepLengthArrays(ear->lhs(), ear->symbol(), st,dep); - if(!ndep) continue; - nel++; - if(nel == 1) - CreateBoundGroup(gref); - if(dep == ANTIDEP) - doCallAfter(InsertArrayBound(gref, head, ileft, ileft+rank, corner)); - else - doCallAfter(InsertArrayBoundDep(gref, head, ileft, ileft+rank,(corner ? rank : 1), ileft+2*rank)); - } - return(nel); -} -/* -int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep) -{SgValueExp c0(0); - int rank,iright,nw,nnl; - int i=0; - SgExpression *wl,*ew, *lbound[7], *ubound[7]; - rank = Rank(ar); - nnl = 0; - for(wl = shl; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(dep == ANTIDEP){ - lbound[i] = &c0; //left bound - ubound[i] = &(ew->rhs())->copy();//right bound - if(ubound[i]->variant() != INT_VAL) - Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); - else if(ubound[i]->valueInteger() != 0) - nnl++; - } else { - lbound[i] = &(ew->lhs())->copy();//left bound - ubound[i] = &c0; //right bound - if(lbound[i]->variant() != INT_VAL) - Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); - else if(lbound[i]->valueInteger() != 0) - nnl++; - } - } - nw = i; - TestShadowWidths(ar, lbound, ubound, nw, st); - if (rank && (nw != rank)) {// wrong shadow width list length - Error("Length of shadow-edge-list is not equal to the rank of array '%s'",ar->identifier(),88,st); - return(0); - } - if(dep == ANTIDEP) - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(lbound[i]); - iright = 0; - if(nnl) - iright = ndvm; - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(ubound[i]); - return(iright); - -} -*/ - -int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep) -{SgValueExp c0(0),c1(1),cM1(-1),c3(3); - int rank,nw,nnl; - int i=0; - nnl = 0; - SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS]; - rank = Rank(ar); - if(!shl) //without dependence-list , - // by default dependence length is equal to the maximal size of shadow edge - for(i=rank-1,nnl=1; i>=0; i--){ - bound[i] = &cM1; - null[i] = &c0; - shsign[i] = &c3; - } - if(!TestMaxDims(shl,ar,st)) - return(0); - for(wl = shl; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(dep == ANTIDEP) - bound[i] = &(ew->rhs())->copy();//right bound - else - bound[i] = &(ew->lhs())->copy();//left bound - null[i] = &c0; - if(bound[i]->variant() != INT_VAL) { - Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); - shsign[i] = &c1; - } - else if(bound[i]->valueInteger() != 0) { - nnl++; - shsign[i] = &c3; - } else - shsign[i] = &c1; - } - nw = i; - - if (rank && (nw != rank)) {// wrong dependence length list length - if(dep == ANTIDEP) - Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); - return(0); - } - if(!nnl) return(0); - if(dep == ANTIDEP){ - TestShadowWidths(ar, null, bound, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - } - else { - TestShadowWidths(ar, bound, null, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(shsign[i]); - } - return(nnl); -} - -/* -int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep, int *maxn) -{SgValueExp c0(0),c1(1),cM1(-1); - int rank,nw,nnl,nsh; - int i=0; - nnl = 0; - nsh = 0; - SgExpression *wl,*ew, *bound[7],*null[7],*shsign[7]; - rank = Rank(ar); - if(!shl) //without dependence-list , - // by default dependence length is equal to the maximal size of shadow edge - for(i=rank-1,nnl=1; i>=0; i--){ - bound[i] = &cM1; - null[i] = &c0; - shsign[i] = new SgValueExp(7); - } - - for(wl = shl; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - if(dep == ANTIDEP){ - bound[i] = &(ew->rhs())->copy();//right bound - null[i] = &c0; - } - else { - bound[i] = &(ew->lhs())->copy();//left bound - null[i] = &(ew->rhs())->copy();//right bound - } - if(bound[i]->variant() != INT_VAL) - Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); - else if(bound[i]->valueInteger() != 0) { - nnl++; nsh++; - shsign[i] = new SgValueExp(7); - } else if(null[i]->valueInteger() != 0){ - shsign[i] = new SgValueExp(5); - nsh++; - } else - shsign[i] = &c1; - null[i] = &c0; - } - nw = i; - *maxn = nsh; - if (rank && (nw != rank) && (dep == ANTIDEP)) {// wrong dependence length list length - Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); - return(0); - } - if(!nnl) return(0); - if(dep == ANTIDEP){ - TestShadowWidths(ar, null, bound, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - } - else { - TestShadowWidths(ar, bound, null, nw, st); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(bound[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(null[i]); - for(i=rank-1;i>=0; i--) - doAssignStmtAfter(shsign[i]); - } - return(nnl); -} -*/ - -SgExpression *doLowHighList(SgExpression *shl, SgSymbol *ar, SgStatement *st) -{ - SgValueExp c1(1); - int nw, i; - SgExpression *wl, *ew, *lbound[MAX_DIMS], *hbound[MAX_DIMS]; - int rank = Rank(ar); - if(!TestMaxDims(shl,ar,st)) - return(NULL); - for(wl = shl,i=0; wl; wl = wl->rhs(),i++) { - ew = wl->lhs(); - lbound[i] = &(ew->lhs())->copy(); - hbound[i] = &(ew->rhs())->copy(); - - if(lbound[i]->variant() != INT_VAL || hbound[i]->variant() != INT_VAL) { - Error("Wrong dependence length of distributed array '%s'",ar->identifier(), 179, st); - lbound[i] = hbound[i] = &c1; - } - } - - nw = i; - - if (rank && (nw != rank) ) - Error("Wrong dependence length list of distributed array '%s'", ar->identifier(), 180, st); - - TestShadowWidths(ar, lbound, hbound, nw, st); - - SgExpression *shlist = NULL; - for(i=0; irhs()) - { - if(el->lhs()->symbol() && el->lhs()->symbol() == ar) - return (el->lhs()); - else - continue; - } - return NULL; -} - -void AcrossList(int ilh, int isOut, SgExpression *el, SgStatement *st, SgExpression *tie_clause) -{ - SgExpression *es, *ear, *head=NULL; - - // looking through the dependent_array_list - for(es = el; es; es = es->rhs()) { - - if( es->lhs()->variant() == ARRAY_OP){ - ear = es->lhs()->lhs(); - err("SECTION specification is not permitted", 643, st); - } else { - ear = es->lhs(); - if(!ear->lhs()) { //whole array - Error("Dependence list is not specified for %s", ear->symbol()->identifier(), 644, st); - continue; - } - } - SgSymbol *ar = ear->symbol(); - - if(!st->expr(0) && (!tie_clause || !isInTieList(ar,tie_clause->lhs()))) - Error("Array from ACROSS clause should be specified in TIE clause: %s", ar->identifier(), 648, st); - - SgExpression *head = HeaderForArrayInParallelDir(ar, st, 1); - doCallAfter(LoopAcross_H2(ilh, isOut, head, Rank(ar), doLowHighList(ear->lhs(), ar, st))); - } -} - -void StoreLoopPar(SgExpression *par[], int n, int ind, SgStatement*stl) -{ SgStatement *stat = NULL; - SgSymbol*s; - int i; - if(!newvar_list) return; - if(stl) { - stat=cur_st; - cur_st=stl; - } - for(i=0; isymbol(); - if(s && isInSymbList(newvar_list,s)) - doAssignTo_After(&(par[i]->copy()),DVM000(ind+i)); - } - if(stl) - cur_st=stat; -} - -void TestReductionList (SgExpression *el, SgStatement *st) -{ - SgExpression *er, *ev, *ered, *loc_var; - symb_list *rv_list=NULL; - for(er = el; er; er=er->rhs()) { - ered = er->lhs(); // reduction - ev = ered->rhs(); // reduction variable reference - loc_var=NULL; - if(isSgExprListExp(ev)) { // MAXLOC,MINLOC - ev = ev->lhs(); - loc_var = ered->rhs()->rhs()->lhs(); - } - if(!ev->symbol()) continue; - if(isInSymbList(rv_list,ev->symbol()) ) - Error("Reuse of '%s' in REDUCTION clause", ev->symbol()->identifier(), 663, st ); - else - rv_list = AddToSymbList(rv_list,ev->symbol()); - if(!loc_var || !loc_var->symbol()) continue; - if(isInSymbList(rv_list,loc_var->symbol()) ) - Error("Reuse of '%s' in REDUCTION clause", loc_var->symbol()->identifier(), 663, st ); - else - rv_list = AddToSymbList(rv_list,loc_var->symbol()); - } -} - -void ReductionList (SgExpression *el,SgExpression *gref, SgStatement *st, SgStatement *stmt1, SgStatement *stmt2, int ilh2) -{ SgStatement *last,*last1; - SgExpression *er, *ev, *ered, *loc_var,*len, *loclen, *debgref; - int irv, irf, num_red, ia, ntype,sign, num, locindtype; - int itsk = 0, ilen = 0; - SgSymbol *var; - SgValueExp c0(0),c1(1); - - TestReductionList (el, st); // double use check - last = stmt2; last1 = stmt1; - - //looking through the reduction list - for(er = el; er; er=er->rhs()) { - ered = er->lhs(); // reduction - ev = ered->rhs(); // reduction variable reference - if(!isSgVarRefExp(ev) && !isSgArrayRefExp(ev) && !isSgExprListExp(ev)) - { err("Wrong reduction variable",151,st); - continue; - } - loc_var = ConstRef(0); - loclen = &c0; - locindtype = 0; - len =&c1; - num=num_red=RedFuncNumber(ered->lhs()); - if( !num_red) - err("Wrong reduction operation name", 70,st); - /* - if(num_red == 8) //EQV - err("Reduction function EQV is not supported now",st); - */ - if(num_red > 8) { // MAXLOC => 9,MINLOC =>10 - num_red -= 6; // MAX => 3,MIN =>4 - // change loc_array - ev = ered->rhs()->lhs(); // reduction variable reference - if( !ered->rhs()->rhs() || !ered->rhs()->rhs()->rhs() || ered->rhs()->rhs()->rhs()->rhs()){ - //the number of operands is not equal to 3 - err("Illegal operand list of MAXLOC/MINLOC",147,st); - continue; - } - loc_var = ered->rhs()->rhs()->lhs(); //location variable reference - loclen = ered->rhs()->rhs()->rhs()->lhs(); //the number of coordinates - if(isSgVarRefExp(loc_var)) - loclen = TypeLengthExpr(loc_var->type()); //14.03.03 new SgValueExp(TypeSize(loc_var->type())); - else if( isSgArrayRefExp(loc_var)) { - ia = loc_var->symbol()->attributes(); - if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT) || (ia & INHERIT_BIT)) - Error("'%s' is distributed array", loc_var->symbol()->identifier(), 148,st); - /* - if(!loc_var->lhs()){ //whole array - if(Rank(loc_var->symbol())>1) - Error("Wrong operand of MAXLOC/MINLOC: %s",loc_var->symbol()->identifier(), 149,st); - loclen = ArrayDimSize(loc_var->symbol(),1); // size of vector in elements - if(!loclen || loclen->variant()==STAR_RANGE){ - Error("Wrong operand of MAXLOC/MINLOC: %s",loc_var->symbol()->identifier(), st); - loclen = &c0; - } - else - loclen = &((*ArrayDimSize(loc_var->symbol(),1)) * (*new SgValueExp(TypeSize(loc_var->symbol()->type()->baseType())))) ; // size of vector in bytes - } - */ - loclen = &(*loclen * (*TypeLengthExpr(loc_var->symbol()->type()->baseType()))) ; // size of vector in bytes - //loclen = &(*loclen * (*new SgValueExp(TypeSize(loc_var->symbol()->type()->baseType())))) ; 14.03.03 - } - else - err("Wrong operand of MAXLOC/MINLOC",149,st); - } - var = ev->symbol(); - ia = var->attributes(); - if(isSgVarRefExp(ev)) - redvar_list= AddNewToSymbList(redvar_list,var); - else if( isSgArrayRefExp(ev)) { - - //if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT)) - // Error("'%s' is distributed array", var->identifier(), 148,st); - - if(!ev->lhs()){ //whole array - len = ArrayLengthInElems(var,st,1); //size of array - ev = FirstArrayElement(var); - if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT)) - { if(!only_debug) - ev = HeaderRefInd(var,1); - } - } - } - else - err("Wrong reduction variable",151,st); - ntype = VarType_RTS(var); //RedVarType - if(!ntype) - Error("Wrong type of reduction variable '%s'", var->identifier(), 152,st); - - sign = 1; - if(stmt1 != stmt2) - cur_st = last1; - if(gref) // interface of RTS1 - { ilen = ndvm; // index for RedArrayLength - doAssignStmtAfter(len); - doAssignStmtAfter(loclen); - } - if(num > 8 && loc_var->symbol()) //MAXLOC,MINLOC - locindtype = LocVarType(loc_var->symbol(),st); - - irv = ndvm; // index for RedVarRef - if(!only_debug) { - if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) /*ACC*/ - { - if(ilh2) // interface of RTS2 - { - doCallAfter(LoopReduction(ilh2,RedFuncNumber_2(num),ev,ntype,len,loc_var,loclen)); - continue; - } - int *index = new int; - *index = irv; - // adding the attribute (REDVAR_INDEX) to expression for reduction operation - ered->addAttribute(REDVAR_INDEX, (void *) index, sizeof(int)); - - doCallAfter (GetActualScalar(var)); - if(num > 8 && loc_var->symbol()) - doCallAfter (GetActualScalar(loc_var->symbol())); - } - doAssignStmtAfter(ReductionVar(num_red,ev,ntype,ilen, loc_var, ilen+1,sign)); - if(num > 8 && loc_var->symbol()) {//MAXLOC,MINLOC - doAssignStmtAfter(LocIndType(irv, locindtype)); //LocVarType(loc_var->symbol(),st))); - } - } - if(debug_regim && st->variant()!=DVM_TASK_REGION_DIR) { - debgref = idebrg ? DVM000(idebrg) : DebReductionGroup(gref->symbol()); - doCallAfter(D_InsRedVar(debgref,num_red,ev,ntype,ilen, loc_var, ilen+1,locindtype)); - } - last1 = cur_st; - if(stmt1 != stmt2) - cur_st = last; - if(!only_debug){ - if(!itsk && st->variant()==DVM_TASK_REGION_DIR){ - itsk = ndvm; - doAssignStmtAfter(new SgVarRefExp(TASK_SYMBOL(st->symbol()))); - } - irf = (st->variant()==DVM_TASK_REGION_DIR) ? itsk : iplp; - doCallAfter(InsertRedVar(gref,irv,irf)); - } - last = cur_st; - } - /* if(! only_debug) - * doAssignStmtAfter(SaveRedVars(gref)); - */ - return; -} - -void ReductionVarsStart (SgExpression *el) -{ - SgExpression *er, *ev, *ered; - int num_red; - - //looking through the reduction list - for(er = el; er; er=er->rhs()) { - ered = er->lhs(); // reduction - num_red=RedFuncNumber(ered->lhs()); - if(num_red <= 8) { - ev = ered->rhs(); // reduction variable reference - if(isSgVarRefExp(ev)){ - doAssignStmtAfter(GetAddresMem(ev)) ; - FREE_DVM(1); - } - if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) { - if(!ev->lhs()) {//whole array - doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ; - FREE_DVM(1); - } - else { - doAssignStmtAfter(GetAddresMem(ev)) ; - FREE_DVM(1); - } - } - } else { // MAXLOC => 9,MINLOC =>10 - ev = ered->rhs()->lhs(); // reduction variable reference - if(isSgVarRefExp(ev)){ - doAssignStmtAfter(GetAddresMem(ev)) ; - FREE_DVM(1); - } - if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) { - if(!ev->lhs()) {//whole array - doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ; - FREE_DVM(1); - } - else { - doAssignStmtAfter(GetAddresMem(ev)) ; - FREE_DVM(1); - } - } - /* - if( ered->rhs()->rhs()->rhs()){ //there are >1 location variables - ind = *((int*)(ered)->attributeValue(0,LOC_ARR)); - for ( ind_var_list = ered->rhs()->rhs(),ind_num=0; ind_var_list; ind_var_list=ind_var_list->rhs(), ind_num++) - doAssignTo_After(DVM000(ind+ind_num),ind_var_list->lhs()) ; - } else - */ - if(ered->rhs()->rhs() && isSgVarRefExp( ered->rhs()->rhs()->lhs())){ - //location variable - doAssignStmtAfter(GetAddresMem( ered->rhs()->rhs()->lhs())) ; - FREE_DVM(1); - } - if(ered->rhs()->rhs() && isSgArrayRefExp( ered->rhs()->rhs()->lhs()) && !IS_DVM_ARRAY(ered->rhs()->rhs()->lhs()->symbol())){ //location array - - if(!( ered->rhs()->rhs()->lhs())->lhs()) {//whole array - doAssignStmtAfter(GetAddresMem(FirstArrayElement((ered->rhs()->rhs()->lhs())->symbol()))) ; - FREE_DVM(1); - } else { - doAssignStmtAfter(GetAddresMem( ered->rhs()->rhs()->lhs())) ; - FREE_DVM(1); - } - } - - } - } - if(redl) {// for HPF_program - reduction_list *erl; - for(erl = redl; erl; erl=erl->next) { - num_red=erl->red_op; - ev = erl->red_var; // reduction variable reference - if(isSgVarRefExp(ev)){ - doAssignStmtAfter(GetAddresMem(ev)) ; - FREE_DVM(1); - } - } - } -} -/* -void ReductionVarsWait (SgExpression *el) -{ int ind; - SgExpression *er, *ered, *ind_var_list; - int num_red, ind_num; - //looking through the reduction list - for(er = el; er; er=er->rhs()) { - ered = er->lhs(); // reduction - num_red=RedFuncNumber(ered->lhs()); - if((num_red > 8) && ( ered->rhs()->rhs()->rhs())){ // MAXLOC => 9,MINLOC =>10 and - //there are >1 location variables - ind = *((int*)(ered)->attributeValue(0,LOC_ARR)); - for ( ind_var_list = ered->rhs()->rhs(),ind_num=0; ind_var_list; ind_var_list=ind_var_list->rhs(), ind_num++) - doAssignTo_After(ind_var_list->lhs(),DVM000(ind+ind_num)) ; - } - - } - -} -*/ - -int LocElemNumber(SgExpression *en) -{ - SgExpression *ec; - int n; - n = 0; - ec = Calculate(en); - if (ec->isInteger()) - n = ec->valueInteger(); - else - err("Can not calculate number of elements in location array", 595, parallel_dir); - return(n); -} - -void InsertReductions_H(SgExpression *red_op_list, int ilh) -{ - SgStatement *last; - SgExpression *er, *ev, *ered, *loc_var, *en; - int irv, num_red, num; - SgType *type, *loc_type; - - last = NULL; - if (!irg && IN_COMPUTE_REGION) - err("Asynchronous reduction is not implemented yet for GPU", 596, parallel_dir); - //looking through the reduction_op_list - for (er = red_op_list; er; er = er->rhs()) - { - ered = er->lhs(); // reduction (variant==ARRAY_OP) - irv = IND_REDVAR(ered); - ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC - num = num_red = RedFuncNumber(ered->lhs()); - if (num > 8) // MAXLOC => 9,MINLOC =>10 - { - num_red -= 6; // MAX => 3,MIN =>4 - ev = ered->rhs()->lhs(); // reduction variable reference - loc_var = ered->rhs()->rhs()->lhs(); //location array reference - if (loc_var->lhs()) // array element reference, it must be array name - Error("Wrong operand of MAXLOC/MINLOC: %s", loc_var->symbol()->identifier(), 149, parallel_dir); - en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array - loc_el_num = LocElemNumber(en); - loc_type = loc_var->symbol()->type(); - } - - type = ev->symbol()->type(); - if (isSgArrayType(type)) - { - if (isSgArrayRefExp(ev) && !ev->lhs() && !HEADER(ev->symbol())) // whole one-dimensional array - ; - else - Error("Reduction variable %s is array (array element), not implemented yet", ev->symbol()->identifier(), 597, parallel_dir); - type = type->baseType(); - } - - //if((nr =TestType(type)) == 5 || nr == 6) // COMPLEX or DCOMPLEX - // Error("Illegal type of reduction variable %s, not implemented yet for GPU",ev->symbol()->identifier(),592,parallel_dir); - - InsertNewStatementAfter(LoopInsertReduction_H(ilh, irv), cur_st, cur_st->controlParent()); - - } -} - -void NewVarList(SgExpression *nl,SgStatement *stmt) -{SgExpression *el,*e; - for(el=nl; el;el=el->rhs()){ - e=el->lhs(); - if(e->symbol()){ - newvar_list=AddToSymbList(newvar_list,e->symbol()); - //testing - if(IS_DUMMY(e->symbol()) || IS_SAVE(e->symbol()) || IN_COMMON(e->symbol())) - Error("Illegal variable in new-clause: %s",e->symbol()->identifier(),168,stmt); // variable in NEW clause may not be dummy argument, have the SAVE attribute,occur in a COMMON block - } - } -} - -void ReceiveArray(SgExpression *spec_accr,SgStatement *parst) -{SgExpression *es,*el; - SgSymbol *ar; - int is,tp; - // looking through the array_list - for(es = spec_accr; es; es = es->rhs()) { - ar = es->lhs()->symbol(); - switch(ar->type()->baseType()->variant()) { - case T_INT: tp = 1; break; - case T_FLOAT: tp = 3; break; - case T_DOUBLE: tp = 4; break; - case T_BOOL: tp = 1; break; - case T_COMPLEX: tp = 6; break; - case T_DCOMPLEX: tp = 8; break; - default: tp = 0; break; - } - is = ndvm; - if(tp == 6 || tp == 8){ - doAssignStmtAfter(&(*ArrayLengthInElems(ar,parst,1)*(*new SgValueExp(2)))); - tp = tp/2; - } else - doAssignStmtAfter(ArrayLengthInElems(ar,parst,1)); - el = FirstArrayElement(ar); - if(HEADER(ar)) - DistArrayRef(el,0,parst); - doAssignStmtAfter(DVM_Receive(iplp,GetAddresMem(el),tp,is)); - - } -} - -void SendArray(SgExpression *spec_accr) -{SgExpression *es,*el; - SgSymbol *ar; - int is,tp; - // looking through the array_list - for(es = spec_accr; es; es = es->rhs()) { - ar = es->lhs()->symbol(); - switch(ar->type()->baseType()->variant()) { - case T_INT: tp = 1; break; - case T_FLOAT: tp = 3; break; - case T_DOUBLE: tp = 4; break; - case T_BOOL: tp = 1; break; - case T_COMPLEX: tp = 6; break; - case T_DCOMPLEX: tp = 8; break; - default: tp = 0; break; - } - is = ndvm; - if(tp == 6 || tp == 8){ - doAssignStmtAfter(&(*ArrayLengthInElems(ar,cur_st,0)*(*new SgValueExp(2)))); - tp = tp/2; - } else - doAssignStmtAfter(ArrayLengthInElems(ar,cur_st,0)); - el = FirstArrayElement(ar); - if(HEADER(ar)) - DistArrayRef(el,0,cur_st); - doAssignStmtAfter(DVM_Send(iplp,GetAddresMem(el),tp,is)); - - } -} - -void CudaBlockSize(SgExpression *cuda_block_list) -{ - SgExpression *el; - el = cuda_block_list; - if (!el) return; - doAssignStmtAfter(el->lhs()); - el = el->rhs(); - if (el) - doAssignStmtAfter(el->lhs()); - else - { - doAssignStmtAfter(new SgValueExp(1)); //by default sizeY = 1 - doAssignStmtAfter(new SgValueExp(1)); //by default sizeZ = 1 - return; - } - el = el->rhs(); - if (el) - doAssignStmtAfter(el->lhs()); - else - doAssignStmtAfter(new SgValueExp(1)); //by default sizeZ = 1 -} - -void CudaBlockSize(SgExpression *cuda_block_list,SgExpression *esize[]) -{ - SgExpression *el; - el = cuda_block_list; - esize[0] = el->lhs(); - el = el->rhs(); - if (el) - esize[1] = el->lhs(); - else - { - esize[1] = new SgValueExp(1); //by default sizeY = 1 - esize[2] = new SgValueExp(1); //by default sizeZ = 1 - return; - } - el = el->rhs(); - if (el) - esize[2] = el->lhs(); - else - esize[2] = new SgValueExp(1); //by default sizeZ = 1 -} - -//*********************************************************************************************** -// Interface of RTS2 -//*********************************************************************************************** -int TestReductionClause(SgExpression *e) -{ - if( e->symbol()) // asynchronous reduction - return 0; - SgExpression *er, *ev; - for(er = e->lhs(); er; er=er->rhs()) - { - ev = er->lhs()->rhs(); // reduction variable reference - if(isSgArrayRefExp(ev) && HEADER(ev->symbol()) ) - return 0; - if(isSgExprListExp(ev) && HEADER(ev->lhs()->symbol()) ) //MAXLOC,MINLOC - return 0; - } - return 1; -} - -int CreateParallelLoopByHandler_H2(SgExpression *init[], SgExpression *last[], SgExpression *step[], int nloop) -{ SgExpression *e=NULL,*el,*arglist=NULL; - // generate call dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...) - for(int i=nloop-1; i>=0; i--) - { - e = len_DvmType ? TypeFunction(SgTypeInt(),step[i],new SgValueExp(len_DvmType) ) : step[i]; - (el = new SgExprListExp(*e))->setRhs(arglist); - arglist = el; - e = len_DvmType ? TypeFunction(SgTypeInt(),last[i],new SgValueExp(len_DvmType) ) : last[i]; - (el = new SgExprListExp(*e))->setRhs(arglist); - arglist = el; - e = len_DvmType ? TypeFunction(SgTypeInt(),init[i],new SgValueExp(len_DvmType) ) : init[i]; - (el = new SgExprListExp(*e))->setRhs(arglist); - arglist = el; - } - int ilh = ndvm; - doAssignStmtAfter(LoopCreate_H2(nloop,arglist)); - return(ilh); -} - -SgExpression *AxisList(SgStatement *stmt, SgExpression *tied_array_ref) -{ - SgExpression *axis[MAX_LOOP_LEVEL], - *coef[MAX_LOOP_LEVEL], - *cons[MAX_LOOP_LEVEL]; - SgExpression *arglist=NULL, *el, *e, *c; - - int nt = Alignment(stmt,tied_array_ref,axis,coef,cons,2); // 2 - interface of RTS2 - for(int i=0; iisInteger() && (c->valueInteger() < 0)) - e = & SgUMinusOp(*DvmType_Ref(axis[i])); - else - e = DvmType_Ref(axis[i]); - (el = new SgExprListExp(*e))->setRhs(arglist); - arglist = el; - } - (el = new SgExprListExp(*ConstRef(nt)))->setRhs(arglist); // add rank to axis list - arglist = el; - return arglist; -} - -SgExpression *ArrayRefAddition(SgExpression *aref) -{ - if(!aref->lhs()) // without subscript list - { - // A => A(:,:,...,:) - SgExpression *arlist = NULL; - int n = Rank(aref->symbol()); - while(n--) - arlist = AddListToList(arlist, new SgExprListExp(*new SgExpression(DDOT))); - - aref->setLhs(arlist); - } - return aref; -} - -SgExpression *MappingList(SgStatement *stmt, SgExpression *aref) -{ - SgExpression *axis[MAX_LOOP_LEVEL], - *coef[MAX_LOOP_LEVEL], - *cons[MAX_LOOP_LEVEL]; - SgExpression *arglist=NULL, *el, *e; - - int nt = Alignment(stmt,aref,axis,coef,cons,2); // 2 - interface of RTS2 - for(int i=0; isetRhs(arglist); - arglist = el; - } - (el = new SgExprListExp(*ConstRef(nt)))->setRhs(arglist); // add rank to axis list - arglist = el; - return arglist; -} - - -void MappingParallelLoop(SgStatement *stmt, int ilh ) -{ - SgExpression *axis[MAX_LOOP_LEVEL], - *coef[MAX_LOOP_LEVEL], - *cons[MAX_LOOP_LEVEL]; - SgExpression *arglist=NULL, *el, *e; - - if(!stmt->expr(0)) // undistributed parallel loop - return; - int nt = Alignment(stmt,NULL,axis,coef,cons,2); // 2 - interface of RTS2 - for(int i=0; isetRhs(arglist); - arglist = el; - } - SgExpression *desc = HeaderRef(stmt->expr(0)->symbol()); //Register_Array_H2(HeaderRef(stmt->expr(0)->symbol())); //!!! temporary - doCallAfter(LoopMap(ilh,desc,nt,arglist)); -} - -void Interface_2(SgStatement *stmt,SgExpression *clause[],SgExpression *init[],SgExpression *last[],SgExpression *step[],int nloop,int ndo,SgStatement *first_do) //int iout,SgStatement *stl,SgSymbol *newj,int ub)) -{ - if (clause[SHADOW_RENEW_]) //there is SHADOW_RENEW clause - ShadowList(clause[SHADOW_RENEW_]->lhs(), stmt, NULL); - - // create loop - int ilh = CreateParallelLoopByHandler_H2(init, last, step, nloop); - MappingParallelLoop(stmt, ilh); - //--------------------------------------------------------------------------- - // processing specifications/clauses - // - if (clause[CUDA_BLOCK_]) //there is CUDA_BLOCK clause - { - SgExpression *eSize[3]; - CudaBlockSize(clause[CUDA_BLOCK_]->lhs(), eSize); - doCallAfter(SetCudaBlock_H2(ilh, eSize[0], eSize[1], eSize[2])); - } - if (clause[TIE_]) //there is TIE clause - for (SgExpression *el=clause[TIE_]->lhs(); el; el=el->rhs()) //list of tied arrays - { - SgExpression *head = HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 1); - doCallAfter(Correspondence_H(ilh, head, AxisList(stmt, el->lhs()))); - } - if (clause[CONSISTENT_]) //there is CONSISTENT clause - for (SgExpression *el = clause[CONSISTENT_]->lhs(); el; el=el->rhs()) - { - SgExpression *head = HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 0); - InsertNewStatementAfter(Consistent_H(ilh, head, MappingList(stmt, el->lhs())), cur_st, cur_st->controlParent()); - } - if (clause[REMOTE_ACCESS_]) //there is REMOTE_ACCESS clause - { int nbuf=1; - //adding new element to remote_access directive/clause list - AddRemoteAccess(clause[REMOTE_ACCESS_]->lhs(),NULL); - RemoteVariableList(clause[REMOTE_ACCESS_]->symbol(), clause[REMOTE_ACCESS_]->lhs(), stmt); - - for (SgExpression *el=clause[REMOTE_ACCESS_]->lhs(); el; el=el->rhs(),nbuf++) - { - SgExpression *head = HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 0); - InsertNewStatementAfter(LoopRemoteAccess_H(ilh, head, el->lhs()->symbol(), MappingList(stmt, ArrayRefAddition(el->lhs()))), cur_st, cur_st->controlParent()); - } - } - - if (clause[SHADOW_COMPUTE_]) //there is SHADOW_COMPUTE clause - { - if ( (clause[SHADOW_COMPUTE_]->lhs())) - ShadowComp(clause[SHADOW_COMPUTE_]->lhs(),stmt,ilh); - else - doCallAfter(ShadowCompute(ilh,HeaderRef(stmt->expr(0)->symbol()),0,NULL)); - //doCallAfter(ShadowCompute(ilh,Register_Array_H2(HeaderRef(stmt->expr(0)->symbol())),0,NULL)); - } - if (clause[REDUCTION_]) //there is REDUCTION clause - { - red_list = clause[REDUCTION_]->lhs(); - ReductionList(red_list,NULL,stmt,cur_st,cur_st,ilh); - } - if (clause[ACROSS_]) //there is ACROSS clause - { - SgExpression *e_spec[2]; - InOutAcross(clause[ACROSS_],e_spec,stmt); - if (e_spec[IN_]) - AcrossList(ilh,IN_, e_spec[IN_], stmt, clause[TIE_]); - if (e_spec[OUT_]) - AcrossList(ilh,OUT_,e_spec[OUT_],stmt, clause[TIE_]); - } - if (clause[STAGE_] && !(clause[STAGE_]->lhs()->variant()==MINUS_OP && INTEGER_VALUE(clause[STAGE_]->lhs()->lhs(),1))) //there is STAGE clause and is not STAGE(-1) - - doCallAfter(SetStage(ilh, clause[STAGE_]->lhs())); - - //--------------------------------------------------------------------------- - LINE_NUMBER_AFTER(first_do,cur_st); - cur_st->addComment(ParallelLoopComment(first_do->lineNumber())); - - ACC_CreateParallelLoop(ilh,first_do,nloop,stmt,clause,2); //oldGroup,newGroup,oldGroup2,newGroup2 -} -//************************************************************************************************ - -int ParallelLoop_Debug(SgStatement *stmt) -{ - SgStatement *st,*stl = NULL,*stg, *st3; - SgStatement *first_do, *stdeb = NULL; - SgValueExp c0(0); - int i,nloop,ndo, iinp,iout,ind, mred; - - SgForStmt *stdo; - SgValueExp c1(1); - - SgExpression *step[MAX_LOOP_LEVEL], - *init[MAX_LOOP_LEVEL], - *last[MAX_LOOP_LEVEL], - *vpart[MAX_LOOP_LEVEL]; - SgSymbol *do_var[MAX_LOOP_LEVEL]; - - SgExpression *vl, *dovar, *e, *el; - - if (!OMP_program) {/*OMP*/ - first_do = stmt -> lexNext();// first DO statement of the loop nest - } else { - first_do = GetLexNextIgnoreOMP(stmt);// first DO statement of the loop nest /*OMP*/ - } - newvar_list = NULL; - redgref = NULL; red_list = NULL; irg = 0; idebrg = 0; mred =0; - LINE_NUMBER_AFTER(stmt,stmt); - TransferLabelFromTo(first_do, stmt->lexNext()); - - //generating call to 'bploop' function of performance analizer (begin of parallel interval) - if(perf_analysis && perf_analysis != 2) - InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' - - iplp = 0; - ndo = i = nloop = 0; - // looking through the do_variables list - vl = stmt->expr(2); // do_variables list - for(dovar=vl; dovar; dovar=dovar->rhs()) - nloop++; - - // looking through the specification list - for(el=stmt->expr(1); el; el=el->rhs()) { - e = el->lhs(); // specification - switch (e->variant()) { - case REDUCTION_OP: - if(mred !=0) break; - mred = 1; - red_list = e->lhs(); - if( e->symbol()){ - redgref = new SgVarRefExp(e->symbol()); - doIfForReduction(redgref,1); - nloopred++; - stg = doIfForCreateReduction( e->symbol(),nloopred,1); - //cur_st->setControlParent(stmt->controlParent()); //to insert correctly next statements - st3 = cur_st; - cur_st = stg; - //looking through the reduction list - ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); - cur_st = st3; - InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); - - } else { - irg = ndvm; - redgref = DVM000(irg); - doAssignStmtAfter(CreateReductionGroup()); - idebrg = ndvm; - doAssignStmtAfter( D_CreateDebRedGroup()); - //looking through the reduction list - ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); - } - break; - - case CONSISTENT_OP: - case NEW_SPEC_OP: - case SHADOW_RENEW_OP: - case SHADOW_COMP_OP: - case SHADOW_START_OP: - case SHADOW_WAIT_OP: - case REMOTE_ACCESS_OP: - case INDIRECT_ACCESS_OP: - case STAGE_OP: - case ACROSS_OP: - break; - } - } - - iout = ndvm; - //initialization vpart[] - for(i=0; ilexNext(),i++) { - stdo = isSgForStmt(st); - if(!stdo) - break; - stl = st; - step[i] = stdo->step(); - if(!step[i]) - step[i] = & c1.copy(); // by default: step = 1 - init[i]=isSpecialFormExp(&stdo->start()->copy(),i,iout+i,vpart,do_var); - if(init[i]) - step[i] = & c1.copy(); - else - init[i] = stdo->start(); - - - last[i] = stdo->end(); - - if(dbg_if_regim) {// setting new loop parameters - if(vpart[i]) - stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form - //step is not replaced - else - stdo->setStart(*DVM000(iout+i)); - - stdo->setEnd(*DVM000(iout+i+nloop)); - } - - do_var[i] = stdo->symbol(); - SetDoVar(stdo->symbol()); - - } - ndo = i; - - // test whether the directive is correct - if( !TestParallelDirective(stmt, nloop, ndo, first_do)) - return(0); // directive is ignored - - if(dbg_if_regim>1) { //copy loop nest - SgStatement *last_st,*lst; - last_st= LastStatementOfDoNest(first_do); - if(last_st != (lst=first_do->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) - { last_st=ReplaceLabelOfDoStmt(first_do,last_st, GetLabel()); - ReplaceDoNestLabel_Above(last_st,first_do,GetLabel()); - } - stdeb=first_do->copyPtr(); - } - - - for(i=0; ilineNumber(); - DebugParLoop(cur_st,nloop,iout); //DebugParLoop(cur_st,nloop,iinp+2*nloop); - - - if(dbg_if_regim){ // generating Logical IF statement: - // begin_lab IF (doplmbseq(...) .EQ. 0) GO TO end_lab - // and inserting it before loop nest - int ino; - SgExpression *dopl; - SgStatement *stn, *if_stmt; - stn = cur_st; - LINE_NUMBER_AFTER(first_do,cur_st); - begin_lab = GetLabel(); - stn->lexNext()-> setLabel(*begin_lab); - end_lab = GetLabel(); - - ino = ndvm; - doAssignStmtAfter(new SgValueExp(pardo_No)); - dopl = doPLmbSEQ(ino, nloop, iout); - - if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); - cur_st->insertStmtAfter(*if_stmt); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF - // (error Sage) - - - if(dbg_if_regim>1) { - SgStatement *ifst; - ifst = new SgIfStmt(*DebugIfNotCondition(), *stdeb); - - (if_stmt->lexNext())->insertStmtAfter(*ifst,*if_stmt->controlParent()); - - // generating GO TO statement: GO TO begin_lab - // and inserting it after last statement of parallel loop nest copy - (stdeb->lastNodeOfStmt())->insertStmtAfter(*new SgGotoStmt(*begin_lab),*ifst); - TranslateBlock(stdeb); - } - } - - cur_st = stl->lexNext(); - //cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest - return(1); -} - -int Reduction_Debug(SgStatement *stmt) -{ - int mred; - SgExpression *e, *el; - SgStatement *stg,*st3; - redgref = NULL; irg = 0; idebrg = 0; mred =0; - LINE_NUMBER_BEFORE(stmt,stmt); - cur_st = stmt->lexPrev(); - // looking through the specification list - for(el=stmt->expr(1); el; el=el->rhs()) { - e = el->lhs(); // specification - if (e->variant() == REDUCTION_OP) { - if(mred !=0) break; - mred = 1; - red_list = e->lhs(); - if( e->symbol()){ - redgref = new SgVarRefExp(e->symbol()); - doIfForReduction(redgref,1); - nloopred++; - stg = doIfForCreateReduction( e->symbol(),nloopred,1); - st3 = cur_st; - cur_st = stg; - //looking through the reduction list - ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); - cur_st = st3; - } else { - irg = ndvm; - redgref = DVM000(irg); - doAssignStmtAfter(CreateReductionGroup()); - idebrg = ndvm; - doAssignStmtAfter( D_CreateDebRedGroup()); - //looking through the reduction list - ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); - } - - } - } - return(0); -} diff --git a/projects/dvm_svn/fdvm/trunk/fdvm/stmt.cpp b/projects/dvm_svn/fdvm/trunk/fdvm/stmt.cpp deleted file mode 100644 index 59cb720..0000000 --- a/projects/dvm_svn/fdvm/trunk/fdvm/stmt.cpp +++ /dev/null @@ -1,1583 +0,0 @@ -/**************************************************************\ -* Fortran DVM * -* * -* Creating and Inserting New Statement in the Program * -* Restructuring Program * -\**************************************************************/ - -#include "dvm.h" - -void doAssignStmt (SgExpression *re) { - SgExpression *le; - SgValueExp * index; - SgStatement *ass; -// creating assign statement with right part "re" and inserting it -// before first executable statement (after last generated statement) - index = new SgValueExp (ndvm++); - le = new SgArrayRefExp(*dvmbuf,*index); - ass = new SgAssignStmt (*le,*re); -// for debug -// ass->unparsestdout(); -// - where->insertStmtBefore(*ass,*where->controlParent()); - //inserting 'ass' statement before 'where' statement - cur_st = ass; - } - -SgExpression * LeftPart_AssignStmt (SgExpression *re) { -// creating assign statement with right part "re" and inserting it -// before first executable statement (after last generated statement); -// returns left part of this statement - SgExpression *le; - SgValueExp * index; - SgStatement *ass; - index = new SgValueExp (ndvm++); - le = new SgArrayRefExp(*dvmbuf,*index); - ass = new SgAssignStmt (*le,*re); -// for debug -// ass->unparsestdout(); -// - where->insertStmtBefore(*ass,*where->controlParent()); - //inserting 'ass' statement before 'where' statement - cur_st = ass; - return(le); - } - - -void doAssignTo (SgExpression *le, SgExpression *re) { - SgStatement *ass; -// creating assign statement with right part "re" and -// left part "le" and inserting it -// before first executable statement (after last generated statement) - ass = new SgAssignStmt (*le,*re); -// for debug -// ass->unparsestdout(); -// - where->insertStmtBefore(*ass,*where->controlParent()); - //inserting 'ass' statement before 'where' statement - cur_st = ass; - } - -void doAssignTo_After (SgExpression *le, SgExpression *re) { - SgStatement *ass; -// creating assign statement with right part "re" and -// left part "le" and inserting it -// after last generated statement - ass = new SgAssignStmt (*le,*re); - - cur_st->insertStmtAfter(*ass);//inserting after - //current statement - cur_st = ass; - } - -void doAssignStmtAfter (SgExpression *re) { - SgExpression *le; - SgValueExp * index; - SgStatement *ass; -// creating assign statement with right part "re" and inserting it -// after current statement (after last generated statement) - index = new SgValueExp (ndvm++); - le = new SgArrayRefExp(*dvmbuf,*index); - ass = new SgAssignStmt (*le,*re); -// for debug -// ass->unparsestdout(); -// - cur_st->insertStmtAfter(*ass);//inserting after current statement - cur_st = ass; - - } -void doAssignStmtBefore (SgExpression *re, SgStatement *current) { - SgExpression *le; - SgValueExp * index; - SgStatement *ass,*st; -// creating assign statement with right part "re" and inserting it -// before current statement - index = new SgValueExp (ndvm++); - le = new SgArrayRefExp(*dvmbuf,*index); - ass = new SgAssignStmt (*le,*re); -// for debug -// ass->unparsestdout(); -// - st = current->controlParent(); - if(st->variant() == LOGIF_NODE) { // Logical IF - // change by construction IF () THEN ENDIF and - // then insert assign statement before current statement - st->setVariant(IF_NODE); - current->insertStmtAfter(* new SgStatement(CONTROL_END)); - //printVariantName( (current->lexNext())->variant()); - st-> insertStmtAfter(*ass); - return; - } - - if (current-> hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label - //insert assign statement before current and set on it the label of current - SgLabel *lab; - lab = current->label(); - BIF_LABEL(current->thebif) = NULL; - current->insertStmtBefore(*ass,*current->controlParent());//inserting before current statement - ass-> setLabel(*lab); - return; - } - current->insertStmtBefore(*ass,*current->controlParent());//inserting before current statement - } - -void doCallAfter(SgStatement *call) -{ - cur_st->insertStmtAfter(*call);//inserting call statement after current statement - cur_st = call; -} - -void doCallStmt(SgStatement *call) -{ - where->insertStmtBefore(*call,*where->controlParent());//inserting call statement before 'where' statement - cur_st = call; -} - - -void Extract_Stmt(SgStatement *st) -{ char *st1_comment,*st2_comment, *pt; - if(!st) return; -// save comment (add to next statement) - st1_comment = st->comments(); - if(st1_comment && st->lexNext()) - { st2_comment = st->lexNext()->comments(); - if(!st2_comment) - st->lexNext()->addComment(st1_comment); - - - else - { - //st->addComment(st2_comment); - //st->lexNext()->setComments(st->comments()); - pt = (char *) malloc(strlen(st1_comment) + strlen(st2_comment) +1); - sprintf(pt,"%s%s",st1_comment,st2_comment); - CMNT_STRING(BIF_CMNT(st->lexNext()->thebif)) = pt; - } - } - -// extract - st-> extractStmt(); - -} - -void InsertNewStatementAfter (SgStatement *stat, SgStatement *current, SgStatement *cp) -{SgStatement *st; - st = current; - if(current->variant() == LOGIF_NODE) // Logical IF - st = current->lexNext(); - if(cp->variant() == LOGIF_NODE) - LogIf_to_IfThen(cp); - st->insertStmtAfter(*stat,*cp); - cur_st = stat; -} - -void InsertNewStatementBefore (SgStatement *stat, SgStatement *current) { - //SgExpression *le; - //SgValueExp * index; - SgStatement *st; - - st = current->controlParent(); - if(st->variant() == LOGIF_NODE) { // Logical IF - // change by construction IF () THEN ENDIF and - // then insert statement before current statement - st->setVariant(IF_NODE); - SgStatement *control = new SgStatement(CONTROL_END);/*OMP*/ - if (current->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ - control->addAttribute (OMP_MARK);/*OMP*/ - }/*OMP*/ - current->insertStmtAfter(*control); - st-> insertStmtAfter(*stat); - return; - } - - if (current-> hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label - //insert statement before current and set on it the label of current - SgLabel *lab; - lab = current->label(); - BIF_LABEL(current->thebif) = NULL; - current->insertStmtBefore(*stat,*current->controlParent());//inserting before current statement - stat-> setLabel(*lab); - return; - } - current->insertStmtBefore(*stat,*current->controlParent());//inserting before current statement - } - -void ReplaceByIfStmt(SgStatement *stmt) -{ SgStatement *if_stmt, *cp; - SgLabel *lab = NULL; - char * cmnt=NULL; - - ChangeDistArrayRef(stmt->expr(0)); /*24.06.14 podd*/ - ChangeDistArrayRef(stmt->expr(1)); /*24.06.14 podd*/ - - // testing: is control parent Logical IF statement - if_stmt = stmt->controlParent(); - if((if_stmt->variant() == LOGIF_NODE)) { - if_stmt->setExpression(0, - (*(if_stmt->expr(0))) && SgNeqOp(*TestIOProcessor(), *new SgValueExp(0) )); - // adding condition: TstIO() - return; - } - - if (stmt-> hasLabel()) { // PRINT statement has label - // set on new if-statement the label of current statement - lab = stmt->label(); - BIF_LABEL(stmt->thebif) = NULL; - } - cmnt=stmt-> comments(); - if (cmnt) // PRINT has preceeding comments - BIF_CMNT(stmt->thebif) = NULL; - - cur_st = stmt->lexNext(); - //cur_st = stmt->lexPrev(); - cp = stmt->controlParent(); - stmt->extractStmt(); - if_stmt = new SgLogIfStmt(SgNeqOp(*TestIOProcessor(), *new SgValueExp(0) ), *stmt); - cur_st->insertStmtBefore(*if_stmt, *cp); - cur_st = if_stmt->lexNext(); // PRINT statement - if (cur_st->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ - DelAttributeFromStmt (OMP_MARK, cur_st);/*OMP*/ - //if_stmt->addAttribute (OMP_MARK);/*OMP*/ - }/*OMP*/ - (cur_st->lexNext())-> extractStmt(); //extract ENDIF (error Sage - if(lab) - if_stmt -> setLabel(*lab); - if(cmnt) - if_stmt -> setComments(cmnt); - return; -} - -SgStatement *ReplaceStmt_By_IfThenConstr(SgStatement *stmt,SgExpression *econd) -{ SgStatement *ifst, *cp, *curst; - SgLabel *lab = NULL; -// replace -// by construction: IF ( ) THEN -// -// ENDIF - - if (stmt-> hasLabel()) { // statement has label - // set on new if-statement the label of current statement - lab = stmt->label(); - BIF_LABEL(stmt->thebif) = NULL; - } - - curst = stmt->lexNext(); - - cp = stmt->controlParent(); - stmt->extractStmt(); - - ifst = new SgIfStmt( *econd, *stmt); - curst->insertStmtBefore(*ifst, *cp); - - if (curst->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ - ifst->addAttribute (OMP_MARK);/*OMP*/ - ifst->lexNext()->lexNext()->addAttribute (OMP_MARK);/*OMP*/ - }/*OMP*/ - if(lab) - ifst -> setLabel(*lab); - - return(ifst->lexNext()->lexNext());// ENDIF -} - -SgStatement *CreateIfThenConstr(SgExpression *cond, SgStatement *st) -{SgStatement *ifst; - -// creating -// IF ( cond ) THEN -// -// ENDIF - st = st ? st : new SgStatement(CONT_STAT); - ifst = new SgIfStmt( *cond, *st); - return(ifst); -} - -void ReplaceAssignByIf(SgStatement *stmt) -{ SgStatement *if_stmt, *cp; - SgLabel *lab = NULL; - char * cmnt=NULL; - SgSymbol *ar = NULL; - SgExpression *el = NULL,*ei[MAX_DIMS]; - SgExpression *condition=NULL, *index_list=NULL; - int iind,i,j,k; - if(isSgArrayRefExp(stmt->expr(0))) { - ar = stmt->expr(0)->symbol(); - el = stmt->expr(0)->lhs(); //index list - } - if(stmt->expr(0)->variant() == ARRAY_OP){ - ar = stmt->expr(0)->lhs()->symbol(); - el = stmt->expr(0)->lhs()->lhs(); //index list - } - if (!el || !TestMaxDims(el,ar,stmt)) //error situation: no subscripts or the number of subscripts > MAX_DIMS - return; - - if (stmt-> hasLabel()) { // assign statement has label - // set on new if-statement the label of current statement - lab = stmt->label(); - BIF_LABEL(stmt->thebif) = NULL; - } - cmnt=stmt-> comments(); - if (cmnt) // statement has preceeding comments - BIF_CMNT(stmt->thebif) = NULL; - - for(i=0;el;el=el->rhs(),i++) - { ei[i] = &(el->lhs()->copy()); - ChangeDistArrayRef(ei[i]); - if(!IN_COMPUTE_REGION && !INTERFACE_RTS2) - ei[i] = &(*ei[i]- *Exprn(LowerBound(ar,i))); - } - iind = ndvm; - - where = stmt; - - if(for_kernel) /*ACC*/ - cur_st = stmt->lexPrev(); /*ACC*/ - else if(INTERFACE_RTS2) - { - cur_st = stmt->lexPrev(); - for(j=i; j; j--) - index_list= AddListToList(index_list,new SgExprListExp(*DvmType_Ref(ei[j-1]))); - } - else - { -// if(IN_COMPUTE_REGION ) /*ACC*/ -// doAssignTo(VECTOR_REF(indexArraySymbol(ar),1),ei[i-1]); /*ACC*/ -// else -// doAssignStmt(ei[i-1]); -// cur_st->addAttribute (OMP_CRITICAL); /*OMP*/ -// if(lab) -// cur_st -> setLabel(*lab); - - for(j=i,k=1; j; j--) - { if(IN_COMPUTE_REGION) /*ACC*/ - doAssignTo(VECTOR_REF(indexArraySymbol(ar),k++),ei[j-1]);/*ACC*/ - else - doAssignStmtAfter(ei[j-1]); - if(lab && k==1) - cur_st -> setLabel(*lab); - cur_st->addAttribute (OMP_CRITICAL); /*OMP*/ - } - - } - cp = stmt->controlParent(); /*ACC*/ - stmt->extractStmt(); - if(IN_COMPUTE_REGION && !for_kernel) /*ACC*/ - condition = & SgNeqOp(INTERFACE_RTS2 ? *HasLocalElement_H2(NULL,ar,i,index_list) : *HasLocalElement(NULL,ar,indexArraySymbol(ar)), *new SgValueExp(0) ); - else if(for_kernel) /*ACC*/ - condition = LocalityConditionInKernel(ar,ei); /*ACC*/ - else - condition = & SgNeqOp(INTERFACE_RTS2 ? *HasElement(HeaderRef(ar),i,index_list) : *TestElement(HeaderRef(ar),iind), *new SgValueExp(0) ); - if_stmt = new SgLogIfStmt(*condition,*stmt); - stmt->addAttribute (OMP_CRITICAL); /*OMP*/ - if_stmt->addAttribute (OMP_CRITICAL); /*OMP*/ - if((for_kernel || INTERFACE_RTS2) && lab) /*ACC*/ - if_stmt -> setLabel(*lab); - - cur_st->insertStmtAfter(*if_stmt,*cp); - cur_st = if_stmt->lexNext(); // assign statement - (cur_st->lexNext())-> extractStmt(); //extract ENDIF (error Sage - - if(cmnt) - if_stmt -> setComments(cmnt); - - SET_DVM(iind); - return; -} - -void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab) -//replaces the label of DO statement nest, which is ended by last_st, -// by new_lab -// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 -// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 -// . . . . . . -// DO 1 IK = 1,NK DO 99999 IK = 1,NK -// . . . . . . -// 1 statement 1 statement -// 99999 CONTINUE -{SgStatement *parent,*st; - SgLabel *lab; - - parent = last_st->controlParent(); - lab = last_st->label(); - //change 04.03.08 - //while((do_st=isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { - while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif)) { - if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; - parent = parent->controlParent(); - } - else - break; - } - - //inserts CONTINUE statement with new_lab as label - st = new SgStatement(CONT_STAT); - st->setLabel(*new_lab); - // for debug regim - LABEL_BODY(new_lab->thelabel) = st->thebif; - BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if(last_st->variant() != LOGIF_NODE) - //last_st->insertStmtAfter(*st); - last_st->insertStmtAfter(*st,*last_st->controlParent()); - else - (last_st->lexNext())->insertStmtAfter(*st,*last_st->controlParent()); - // st->setControlParent(*last_st->controlParent()); - //printVariantName(last_st->controlParent()->variant()); - - /* -//renew global variable 'end_loop_lab' (for parallel loop) - if(end_loop_lab) - if(LABEL_STMTNO(end_loop_lab->thelabel) == LABEL_STMTNO(lab->thelabel)) - end_loop_lab = new_lab; - */ -} - -SgLabel * LabelOfDoStmt(SgStatement *stmt) -{ if(BIF_LABEL_USE(stmt->thebif)) - return (LabelMapping(BIF_LABEL_USE(stmt->thebif))); - else - return(NULL); -} - -void ReplaceDoNestLabel_Above(SgStatement *last_st, SgStatement *from_st,SgLabel *new_lab) -//replaces the label of DO statements locating above 'from_st' in nest, -// which is ended by 'last_st', by 'new_lab' -// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 -// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 -// . . . . . . -// DO 1 IK = 1,NK DO 99999 IK = 1,NK -// CDVM$ PARALLEL (J1,...,JL) ON A(...) ==> CDVM$ PARALLEL (J1,...,JL) ON A(...) -// DO 1 J1 = 1,N1 DO 1 J1 = 1,N1 -// DO 1 J2 = 1,N2 DO 1 J2 = 1,N2 -// . . . . . . -// DO 1 JL = 1,NL DO 1 JL = 1,NL -// . . . . . . -// 1 CONTINUE 1 CONTINUE -// 99999 CONTINUE -{SgStatement *parent,*st,*par; - SgLabel *lab; - int is_above; - par = parent = from_st->controlParent(); - lab = LabelOfDoStmt(from_st); //((SgForStmt *)from_st)->endOfLoop(); - if(!lab) //DO statement 'from_st' has no label - return; - is_above = 0; - - while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif)) { - if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; - is_above = 1; - parent = parent->controlParent(); - } - else - break; - } -/* - while((do_st=isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { - if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel; - is_above = 1; - parent = parent->controlParent(); - } - else - break; - } - */ - - //inserts CONTINUE statement with new_lab as label - if(is_above) { - st = new SgStatement(CONT_STAT); - st->setLabel(*new_lab); - //for debug regim - LABEL_BODY(new_lab->thelabel) = st->thebif; - BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if(last_st->variant() != LOGIF_NODE) - last_st->insertStmtAfter(*st,*par); - else - (last_st->lexNext())->insertStmtAfter(*st,*par); - } -} - -void ReplaceParDoNestLabel(SgStatement *last_st, SgStatement *from_st,SgLabel *new_lab) -//replaces the label of DO statements locating above 'from_st' in nest, -// which is ended by 'last_st', by 'new_lab' -// CDVM$ PARALLEL (I1,...,IL) ON A(...) ==> CDVM$ PARALLEL (I1,...,IL) ON A(...) -// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 -// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 -// . . . . . . -// DO 1 IK = 1,NK DO 99999 IK = 1,NK -// . . . . . . -// 1 CONTINUE 99999 CONTINUE -// -{SgStatement *parent,*st,*par; - SgLabel *lab; - int is_above; - par = parent = from_st->controlParent(); - lab = LabelOfDoStmt(parent); //((SgForStmt *)parent)->endOfLoop(); - if(!lab) //DO statement has no label - return; - is_above = 0; - -while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif)) { - if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; - is_above = 1; - parent = parent->controlParent(); - } - else - break; - } - -/* - while((do_st=isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { - if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel; - is_above = 1; - parent = parent->controlParent(); - } - else - break; - } -*/ - - //inserts CONTINUE statement with new_lab as label - if(is_above) { - st = new SgStatement(CONT_STAT); - st->setLabel(*new_lab); - //for debug regim - LABEL_BODY(new_lab->thelabel) = st->thebif; - BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if(last_st->variant() != LOGIF_NODE) - last_st->insertStmtAfter(*st,*par); - else - (last_st->lexNext())->insertStmtAfter(*st,*par); - } -} - -SgStatement *ReplaceDoLabel(SgStatement *last_st, SgLabel *new_lab) -//replaces the label of DO statement, which is ended by last_st, -// by new_lab -// DO 1 I = 1,N DO 99999 I = 1,N -// . . . . . . -// 1 statement 1 statement -// 99999 CONTINUE - -{SgStatement *parent, *st; - SgLabel *lab; - parent = last_st->controlParent(); - if((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && (lab=LabelOfDoStmt(parent))){ - //if((do_st=isSgForStmt(parent)) != NULL && (lab=do_st->endOfLoop())){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; - } - else - return(NULL); - - //inserts CONTINUE statement with new_lab as label - st = new SgStatement(CONT_STAT); - st->setLabel(*new_lab); - //for debug regim - LABEL_BODY(new_lab->thelabel) = st->thebif; - BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if(last_st->variant() != LOGIF_NODE) - last_st->insertStmtAfter(*st,*parent); - else - (last_st->lexNext())->insertStmtAfter(*st,*parent); - return(st); -} - -SgStatement *ReplaceLabelOfDoStmt(SgStatement *first,SgStatement *last_st, SgLabel *new_lab) -//replaces the label of first DO statement of DO nest, which is ended by last_st, -// by new_lab -// DO 1 I = 1,N DO 99999 I = 1,N -// DO 1 J = 1,N DO 1 J = 1,N -// . . . . . . -// 1 statement 1 statement -// 99999 CONTINUE - -{SgStatement *parent, *st; - SgLabel *lab; - parent = last_st->controlParent(); - if((first->variant()==FOR_NODE || first->variant()==WHILE_NODE) && (lab=LabelOfDoStmt(first))){ - //if((do_st=isSgForStmt(first)) != NULL && (lab=do_st->endOfLoop())){ - if(!new_lab) - new_lab = GetLabel(); - BIF_LABEL_USE(first->thebif) = new_lab->thelabel; - } - else - return(NULL); - - //inserts CONTINUE statement with new_lab as label - st = new SgStatement(CONT_STAT); - st->setLabel(*new_lab); - //for debug regim - LABEL_BODY(new_lab->thelabel) = st->thebif; - BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if(last_st->variant() != LOGIF_NODE) - last_st->insertStmtAfter(*st,*first); - else - (last_st->lexNext())->insertStmtAfter(*st,*first); - return(st); -} - -SgStatement *ReplaceBy_DO_ENDDO(SgStatement *first,SgStatement *last_st) -//replaces first DO statement of DO nest with label, which is ended by last_st, -// by DO-ENDDO construct -// DO 1 I = 1,N DO I = 1,N -// DO 1 J = 1,N DO 1 J = 1,N -// . . . . . . -// 1 statement 1 statement -// ENDDO - -{SgStatement *parent, *st; - SgLabel *lab; - parent = last_st->controlParent(); - if((first->variant()==FOR_NODE || first->variant()==WHILE_NODE) && (lab=LabelOfDoStmt(first))){ - BIF_LABEL_USE(first->thebif) = NULL; - } - else - return(NULL); - - //inserts ENDDO statement - st = new SgControlEndStmt(); //new SgStatement(CONTROL_END); - - //for debug regim - BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); - if(last_st->variant() != LOGIF_NODE) - last_st->insertStmtAfter(*st,*first); - else - (last_st->lexNext())->insertStmtAfter(*st,*first); - return(st); -} - -void ReplaceContext(SgStatement *stmt) -{ - if(isDoEndStmt_f90(stmt)) - ReplaceDoNestLabel(stmt, GetLabel()); - else if(isSgLogIfStmt(stmt->controlParent())) { - if(isDoEndStmt_f90(stmt->controlParent())) - ReplaceDoNestLabel(stmt->controlParent(),GetLabel()); - LogIf_to_IfThen(stmt->controlParent()); - } -} - -void LogIf_to_IfThen(SgStatement *stmt) -{ -//replace Logical IF statement: IF ( ) -// by construction: IF ( ) THEN -// -// ENDIF - SgControlEndStmt *control = new SgControlEndStmt(); - stmt->setVariant(IF_NODE); -(stmt->lexNext())->insertStmtAfter(* control,*stmt); - if (stmt->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ - control->addAttribute (OMP_MARK);/*OMP*/ - }/*OMP*/ -} - - -SgStatement *doIfThenConstr(SgSymbol *ar) -{SgStatement *ifst; - SgExpression *ea; -// creating -// IF ( ar(1) .EQ. 0) THEN -// ENDIF - ea = new SgArrayRefExp(*ar, *new SgValueExp(1)); ///IS_TEMPLATE(ar) && !INTERFACE_RTS2 ? new SgArrayRefExp(*ar) : new SgArrayRefExp(*ar, *new SgValueExp(1)); - ifst = new SgIfStmt( SgEqOp(*ea, *new SgValueExp(0)), *new SgStatement(CONT_STAT)); - where->insertStmtBefore(*ifst,*where->controlParent()); - ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(ifst); -} - -SgStatement *doIfThenConstrWithArElem(SgSymbol *ar, int ind) -{SgStatement *ifst; -// creating -// IF ( ar(ind) .EQ. 0) THEN -// ar(ind) = 1; -// ENDIF - ifst = new SgIfStmt( SgEqOp(*ARRAY_ELEMENT(ar,ind), *new SgValueExp(0)), *new SgAssignStmt(*ARRAY_ELEMENT(ar,ind), *new SgValueExp(1))); - where->insertStmtBefore(*ifst,*where->controlParent()); -// ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(ifst); -} - -SgStatement *doIfForFileVariables(SgSymbol *s) -{SgStatement *ifst; -// creating -// IF ( s .EQ. 0) THEN -// ENDIF - ifst = new SgIfStmt( SgEqOp(*new SgVarRefExp(*s), *new SgValueExp(0)), *new SgStatement(CONT_STAT)); - cur_st->insertStmtAfter(*ifst,*cur_st->controlParent()); - ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(ifst); -} - -SgStatement *doIfThenConstrForRedis(SgExpression *headref, SgStatement *stmt, int index) -{SgStatement *ifst; - SgExpression *e; -// creating -// IF ( headref .EQ. 0) THEN /*08.05.17*/ //IF ( getamv(HeaderRef) .EQ. 0) THEN - -// ELSE - -// ENDIF - - e = headref; /*08.05.17*/ //e = (index>1) ? headref : GetAMView( headref); //TEMPLATE or not - ifst = new SgIfStmt( SgEqOp(*e, *new SgValueExp(0)), *new SgStatement(CONT_STAT),*new SgStatement(CONT_STAT)); - stmt->insertStmtBefore(*ifst,*stmt->controlParent()); //10.12.12 after=>before - ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - ifst->lexNext()->lexNext()->extractStmt(); // extracting second CONTINUE statement - return(ifst); -} - -SgStatement *doIfThenConstrForRealign(int iamv, SgStatement *stmt, int cond) -{SgStatement *ifst; - SgExpression *econd; -// creating -// IF ( dvm000(iamv) .EQ. 0) THEN or .NE. - -// ENDIF - econd = cond ? &SgEqOp(*DVM000(iamv), *new SgValueExp(0)) : &SgNeqOp(*DVM000(iamv), *new SgValueExp(0)); - ifst = new SgIfStmt( *econd, *new SgStatement(CONT_STAT)); - stmt->insertStmtAfter(*ifst,*stmt->controlParent()); - ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(ifst); -} - -SgStatement *doIfThenConstrForRealign(SgExpression *headref, SgStatement *stmt, int cond) -{SgStatement *ifst; - SgExpression *econd; -// creating -// IF ( headref .EQ. 0) THEN or .NE. - -// ENDIF - - econd = cond ? &SgEqOp(*headref, *new SgValueExp(0)) : &SgNeqOp(*headref, *new SgValueExp(0)); - ifst = new SgIfStmt( *econd, *new SgStatement(CONT_STAT)); - stmt->insertStmtAfter(*ifst,*stmt->controlParent()); - ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - return(ifst); -} - -SgStatement *doIfThenConstrForPrefetch(SgStatement *stmt) -{SgStatement *ifst; -// creating -// IF ( GROUP(1) .EQ. 0) THEN -// GROUP(2) = 0 -// ELSE -// GROUP(2) = 1 -// ENDIF - - ifst = new SgIfStmt( SgEqOp(*GROUP_REF(stmt->symbol(),1), *new SgValueExp(0)), *new SgAssignStmt(*GROUP_REF(stmt->symbol(),2),*new SgValueExp(0)),*new SgAssignStmt(*GROUP_REF(stmt->symbol(),2),*new SgValueExp(1))); - stmt->insertStmtAfter(*ifst,*stmt->controlParent()); - //cur_st = ifst->lexNext()->lexNext()->lexNext()->lexNext();//END IF - return(ifst); -} - -SgStatement *doIfThenConstrForRemAcc(SgSymbol *group, SgStatement *stmt) -{SgStatement *ifst, *st; -// creating -// IF ( GROUP(2) .EQ. 0) THEN -// -// ELSE -// IF ( GROUP(3) .EQ. 1) THEN -// GROUP(3) = 0 -// ENDIF -// ENDIF -// CONTINUE - - ifst = new SgIfStmt( SgEqOp(*GROUP_REF(group,2), *new SgValueExp(0)), *new SgStatement(CONT_STAT),*new SgIfStmt( SgEqOp(*GROUP_REF(group,3), *new SgValueExp(1)),*new SgAssignStmt(*GROUP_REF(group,3),*new SgValueExp(0)))); - st=new SgStatement(CONT_STAT); //generating and - stmt->insertStmtAfter(*st,*stmt->controlParent()); //inserting CONTINUE statement - stmt->insertStmtAfter(*ifst,*stmt->controlParent()); - ifst->lexNext()->extractStmt(); // extracting CONTINUE statement - //cur_st = ifst->lexNext()->lexNext();//internal IF THEN - //doAssignStmtAfter(WaitBG(group)); - //FREE_DVM(1); - //cur_st = cur_st->lexNext()->lexNext()->lexNext();//END IF - - cur_st = st; - return(ifst); -} - -void doIfForReduction(SgExpression *redgref, int deb) -{SgStatement *if_stmt; -// creating -// IF ( GROUP .EQ. 0) THEN -// GROUP = crtrdf(...) -// ENDIF - if_stmt = new SgIfStmt(SgEqOp(*redgref, *new SgValueExp(0) ),*new SgAssignStmt(*redgref,*CreateReductionGroup())); - cur_st->insertStmtAfter(*if_stmt, *cur_st->controlParent()); - cur_st = if_stmt->lexNext(); - if(debug_regim && deb){ - doAssignTo_After( DebReductionGroup( redgref->symbol()), D_CreateDebRedGroup()); - } - - cur_st = cur_st->lexNext(); //END IF -} - -SgStatement *doIfForCreateReduction(SgSymbol *gs, int i, int flag) -{SgStatement *if_stmt, *st; - SgSymbol *rgv, *go; - SgExpression *rgvref; -// creating -// IF ( (i) .EQ. 0) THEN -// [ (i) = 1 ] // if flag == 1 -// ENDIF -// CONTINUE - go = ORIGINAL_SYMBOL(gs); - rgv = * ((SgSymbol **) go -> attributeValue(0,RED_GROUP_VAR)); - rgvref = new SgArrayRefExp(*rgv,*new SgValueExp(i)); - st = flag ? new SgAssignStmt(*rgvref,*new SgValueExp(1)) : new SgStatement(CONT_STAT); - if_stmt = new SgIfStmt(SgEqOp(*rgvref, *new SgValueExp(0) ), *st); - cur_st->insertStmtAfter(*if_stmt); - //cur_st = if_stmt->lexNext()->lexNext(); //END IF - st=new SgStatement(CONT_STAT); - if_stmt->lexNext()->lexNext()->insertStmtAfter(*st); - cur_st = st; - if(!flag) - if_stmt->lexNext()->extractStmt(); // extracting CONTINUE statement - - return(if_stmt); -} - - -void doIfForConsistent(SgExpression *gref) -{SgStatement *if_stmt; -// creating -// IF ( GROUP .EQ. 0) THEN -// GROUP = crtcg(...) -// ENDIF - if_stmt = new SgIfStmt(SgEqOp(*gref,*new SgValueExp(0) ),*new SgAssignStmt(*gref,*CreateConsGroup(1,1))); - cur_st->insertStmtAfter(*if_stmt, *cur_st->controlParent()); - cur_st = if_stmt->lexNext(); - //if(debug_regim){ - //doAssignTo_After( DebReductionGroup( gref->symbol()), D_CreateDebRedGroup()); - //} - - cur_st = cur_st->lexNext(); //END IF -} - -void doLogIfForHeap(SgSymbol *heap, int size) -{SgStatement *if_stmt,*stop; - stop = new SgStatement(STOP_STAT); - stop ->setExpression(0,*new SgValueExp("Error 166: HEAP limit is exceeded")); - if_stmt = new SgLogIfStmt(*ARRAY_ELEMENT(heap,1) > *new SgValueExp(size+1),*stop); - cur_st->insertStmtAfter(*if_stmt); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF -} - -void doLogIfForIOstat(SgSymbol *s, SgExpression *espec, SgStatement *stmt) -{ - SgExpression *cond; - SgKeywordValExp *kwe = isSgKeywordValExp(espec->lhs()); - if (!strcmp(kwe->value(),"err")) - cond = &operator > (*new SgVarRefExp(s), *new SgValueExp(0)); - else - cond = &operator < (*new SgVarRefExp(s), *new SgValueExp(0)); - - SgStatement *goto_stmt = new SgGotoStmt(*((SgLabelRefExp *) espec->rhs())->label()); - SgStatement *if_stmt = new SgLogIfStmt(*cond,*goto_stmt); - stmt->insertStmtAfter(*if_stmt, *stmt->controlParent()); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF - BIF_LINE(if_stmt->thebif) = stmt->lineNumber(); - BIF_LINE(goto_stmt->thebif) = stmt->lineNumber(); - -} - -void doIfForDelete(SgSymbol *sg, SgStatement *stmt) -{SgStatement *if_stmt,*delst; - //delst = new SgAssignStmt(*DVM000(ndvm++),*DeleteObject(new SgVarRefExp(*sg))); - //FREE_DVM(1); - delst = DeleteObject_H(new SgVarRefExp(*sg)); - if_stmt = new SgLogIfStmt(SgNeqOp(*new SgVarRefExp(sg), *new SgValueExp(0)),*delst); - InsertNewStatementBefore(if_stmt,stmt); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF -} - -void doLogIfForAllocated(SgExpression *objref, SgStatement *stmt) -{SgStatement *if_stmt,*call; - call = DataExit(objref,0); - if_stmt = new SgLogIfStmt(*AllocatedFunction(objref),*call); - InsertNewStatementBefore(if_stmt,stmt); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF -} - -SgStatement *doIfThenForDataRegion(SgSymbol *symb, SgStatement *stmt, SgStatement *call) -{ - SgStatement *ifst = new SgIfStmt( SgEqOp(*new SgVarRefExp(symb), *new SgValueExp(0)), *call); - stmt->insertStmtAfter(*ifst, *stmt->controlParent()); - call->insertStmtAfter(*new SgAssignStmt(*new SgVarRefExp(symb),*new SgValueExp(1)), *ifst); - return (ifst); -} - -void doIfIOSTAT(SgExpression *eiostat, SgStatement *stmt, SgStatement *go_stmt) -{ - SgExpression *cond = &operator != (eiostat->copy(), *new SgValueExp(0)); - SgStatement *if_stmt = new SgLogIfStmt(*cond,*go_stmt); - stmt->insertStmtAfter(*if_stmt,*stmt->controlParent()); - (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF -} - -int isDoEndStmt(SgStatement *stmt) -{ - SgLabel *lab, *do_lab; - SgForStmt *parent; - if(!(lab=stmt->label()) && stmt->variant() != CONTROL_END) //the statement has no label and - return(0); //is not ENDDO - parent = isSgForStmt(stmt->controlParent()); - if(!parent) //parent isn't DO statement - return(0); - do_lab = parent->endOfLoop(); // label of loop end or NULL - if(do_lab) // DO statement with label - if(lab && LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_lab->thelabel)) - // the statement label is the label of loop end - return(1); - else - return(0); - else // DO statement without label - if(stmt->variant() == CONTROL_END) - return(1); - else - return(0); -} - -int isDoEndStmt_f90(SgStatement *stmt) -{// loop header may be - // DO