1 //===-- tools/f18/f18-parse-demo.cpp --------------------------------------===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 // F18 parsing demonstration. 10 // f18-parse-demo [ -E | -fdump-parse-tree | -funparse-only ] 11 // foo.{f,F,f77,F77,f90,F90,&c.} 12 // 13 // By default, runs the supplied source files through the F18 preprocessing and 14 // parsing phases, reconstitutes a Fortran program from the parse tree, and 15 // passes that Fortran program to a Fortran compiler identified by the $F18_FC 16 // environment variable (defaulting to gfortran). The Fortran preprocessor is 17 // always run, whatever the case of the source file extension. Unrecognized 18 // options are passed through to the underlying Fortran compiler. 19 // 20 // This program is actually a stripped-down variant of f18.cpp, a temporary 21 // scaffolding compiler driver that can test some semantic passes of the 22 // F18 compiler under development. 23 24 #include "flang/Common/Fortran-features.h" 25 #include "flang/Common/default-kinds.h" 26 #include "flang/Parser/characters.h" 27 #include "flang/Parser/dump-parse-tree.h" 28 #include "flang/Parser/message.h" 29 #include "flang/Parser/parse-tree-visitor.h" 30 #include "flang/Parser/parse-tree.h" 31 #include "flang/Parser/parsing.h" 32 #include "flang/Parser/provenance.h" 33 #include "flang/Parser/unparse.h" 34 #include "llvm/Support/Errno.h" 35 #include "llvm/Support/FileSystem.h" 36 #include "llvm/Support/Program.h" 37 #include "llvm/Support/raw_ostream.h" 38 #include <cstdio> 39 #include <cstring> 40 #include <fstream> 41 #include <list> 42 #include <memory> 43 #include <optional> 44 #include <stdlib.h> 45 #include <string> 46 #include <time.h> 47 #include <vector> 48 49 static std::list<std::string> argList(int argc, char *const argv[]) { 50 std::list<std::string> result; 51 for (int j = 0; j < argc; ++j) { 52 result.emplace_back(argv[j]); 53 } 54 return result; 55 } 56 57 std::vector<std::string> filesToDelete; 58 59 void CleanUpAtExit() { 60 for (const auto &path : filesToDelete) { 61 if (!path.empty()) { 62 llvm::sys::fs::remove(path); 63 } 64 } 65 } 66 67 #if _POSIX_C_SOURCE >= 199309L && _POSIX_TIMERS > 0 && _POSIX_CPUTIME && \ 68 defined CLOCK_PROCESS_CPUTIME_ID 69 static constexpr bool canTime{true}; 70 double CPUseconds() { 71 struct timespec tspec; 72 clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tspec); 73 return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec; 74 } 75 #else 76 static constexpr bool canTime{false}; 77 double CPUseconds() { return 0; } 78 #endif 79 80 struct DriverOptions { 81 DriverOptions() {} 82 bool verbose{false}; // -v 83 bool compileOnly{false}; // -c 84 std::string outputPath; // -o path 85 std::vector<std::string> searchDirectories{"."s}; // -I dir 86 bool forcedForm{false}; // -Mfixed or -Mfree appeared 87 bool warnOnNonstandardUsage{false}; // -Mstandard 88 bool warningsAreErrors{false}; // -Werror 89 Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1}; 90 bool lineDirectives{true}; // -P disables 91 bool syntaxOnly{false}; 92 bool dumpProvenance{false}; 93 bool noReformat{false}; // -E -fno-reformat 94 bool dumpUnparse{false}; 95 bool dumpParseTree{false}; 96 bool timeParse{false}; 97 std::vector<std::string> fcArgs; 98 const char *prefix{nullptr}; 99 }; 100 101 void Exec(std::vector<llvm::StringRef> &argv, bool verbose = false) { 102 if (verbose) { 103 for (size_t j{0}; j < argv.size(); ++j) { 104 llvm::errs() << (j > 0 ? " " : "") << argv[j]; 105 } 106 llvm::errs() << '\n'; 107 } 108 std::string ErrMsg; 109 llvm::ErrorOr<std::string> Program = llvm::sys::findProgramByName(argv[0]); 110 if (!Program) 111 ErrMsg = Program.getError().message(); 112 if (!Program || 113 llvm::sys::ExecuteAndWait( 114 Program.get(), argv, llvm::None, {}, 0, 0, &ErrMsg)) { 115 llvm::errs() << "execvp(" << argv[0] << ") failed: " << ErrMsg << '\n'; 116 exit(EXIT_FAILURE); 117 } 118 } 119 120 void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) { 121 std::vector<llvm::StringRef> argv; 122 for (size_t j{0}; j < driver.fcArgs.size(); ++j) { 123 argv.push_back(driver.fcArgs[j]); 124 } 125 char dashC[3] = "-c", dashO[3] = "-o"; 126 argv.push_back(dashC); 127 argv.push_back(dashO); 128 argv.push_back(relo); 129 argv.push_back(source); 130 Exec(argv, driver.verbose); 131 } 132 133 std::string RelocatableName(const DriverOptions &driver, std::string path) { 134 if (driver.compileOnly && !driver.outputPath.empty()) { 135 return driver.outputPath; 136 } 137 std::string base{path}; 138 auto slash{base.rfind("/")}; 139 if (slash != std::string::npos) { 140 base = base.substr(slash + 1); 141 } 142 std::string relo{base}; 143 auto dot{base.rfind(".")}; 144 if (dot != std::string::npos) { 145 relo = base.substr(0, dot); 146 } 147 relo += ".o"; 148 return relo; 149 } 150 151 int exitStatus{EXIT_SUCCESS}; 152 153 std::string CompileFortran( 154 std::string path, Fortran::parser::Options options, DriverOptions &driver) { 155 if (!driver.forcedForm) { 156 auto dot{path.rfind(".")}; 157 if (dot != std::string::npos) { 158 std::string suffix{path.substr(dot + 1)}; 159 options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; 160 } 161 } 162 options.searchDirectories = driver.searchDirectories; 163 Fortran::parser::AllSources allSources; 164 Fortran::parser::AllCookedSources allCookedSources{allSources}; 165 Fortran::parser::Parsing parsing{allCookedSources}; 166 167 auto start{CPUseconds()}; 168 parsing.Prescan(path, options); 169 if (!parsing.messages().empty() && 170 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) { 171 llvm::errs() << driver.prefix << "could not scan " << path << '\n'; 172 parsing.messages().Emit(llvm::errs(), parsing.allCooked()); 173 exitStatus = EXIT_FAILURE; 174 return {}; 175 } 176 if (driver.dumpProvenance) { 177 parsing.DumpProvenance(llvm::outs()); 178 return {}; 179 } 180 if (options.prescanAndReformat) { 181 parsing.messages().Emit(llvm::errs(), allCookedSources); 182 if (driver.noReformat) { 183 parsing.DumpCookedChars(llvm::outs()); 184 } else { 185 parsing.EmitPreprocessedSource(llvm::outs(), driver.lineDirectives); 186 } 187 return {}; 188 } 189 parsing.Parse(llvm::outs()); 190 auto stop{CPUseconds()}; 191 if (driver.timeParse) { 192 if (canTime) { 193 llvm::outs() << "parse time for " << path << ": " << (stop - start) 194 << " CPU seconds\n"; 195 } else { 196 llvm::outs() << "no timing information due to lack of clock_gettime()\n"; 197 } 198 } 199 200 parsing.ClearLog(); 201 parsing.messages().Emit(llvm::errs(), parsing.allCooked()); 202 if (!parsing.consumedWholeFile()) { 203 parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), 204 "parser FAIL (final position)"); 205 exitStatus = EXIT_FAILURE; 206 return {}; 207 } 208 if ((!parsing.messages().empty() && 209 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) || 210 !parsing.parseTree()) { 211 llvm::errs() << driver.prefix << "could not parse " << path << '\n'; 212 exitStatus = EXIT_FAILURE; 213 return {}; 214 } 215 auto &parseTree{*parsing.parseTree()}; 216 if (driver.dumpParseTree) { 217 Fortran::parser::DumpTree(llvm::outs(), parseTree); 218 return {}; 219 } 220 if (driver.dumpUnparse) { 221 Unparse(llvm::outs(), parseTree, driver.encoding, true /*capitalize*/, 222 options.features.IsEnabled( 223 Fortran::common::LanguageFeature::BackslashEscapes)); 224 return {}; 225 } 226 if (driver.syntaxOnly) { 227 return {}; 228 } 229 230 std::string relo{RelocatableName(driver, path)}; 231 232 llvm::SmallString<32> tmpSourcePath; 233 { 234 int fd; 235 std::error_code EC = 236 llvm::sys::fs::createUniqueFile("f18-%%%%.f90", fd, tmpSourcePath); 237 if (EC) { 238 llvm::errs() << EC.message() << "\n"; 239 std::exit(EXIT_FAILURE); 240 } 241 llvm::raw_fd_ostream tmpSource(fd, /*shouldClose*/ true); 242 Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/, 243 options.features.IsEnabled( 244 Fortran::common::LanguageFeature::BackslashEscapes)); 245 } 246 247 RunOtherCompiler(driver, tmpSourcePath.data(), relo.data()); 248 filesToDelete.emplace_back(tmpSourcePath); 249 if (!driver.compileOnly && driver.outputPath.empty()) { 250 filesToDelete.push_back(relo); 251 } 252 return relo; 253 } 254 255 std::string CompileOtherLanguage(std::string path, DriverOptions &driver) { 256 std::string relo{RelocatableName(driver, path)}; 257 RunOtherCompiler(driver, path.data(), relo.data()); 258 if (!driver.compileOnly && driver.outputPath.empty()) { 259 filesToDelete.push_back(relo); 260 } 261 return relo; 262 } 263 264 void Link(std::vector<std::string> &relocatables, DriverOptions &driver) { 265 std::vector<llvm::StringRef> argv; 266 for (size_t j{0}; j < driver.fcArgs.size(); ++j) { 267 argv.push_back(driver.fcArgs[j].data()); 268 } 269 for (auto &relo : relocatables) { 270 argv.push_back(relo.data()); 271 } 272 if (!driver.outputPath.empty()) { 273 char dashO[3] = "-o"; 274 argv.push_back(dashO); 275 argv.push_back(driver.outputPath.data()); 276 } 277 Exec(argv, driver.verbose); 278 } 279 280 int main(int argc, char *const argv[]) { 281 282 atexit(CleanUpAtExit); 283 284 DriverOptions driver; 285 const char *fc{getenv("F18_FC")}; 286 driver.fcArgs.push_back(fc ? fc : "gfortran"); 287 288 std::list<std::string> args{argList(argc, argv)}; 289 std::string prefix{args.front()}; 290 args.pop_front(); 291 prefix += ": "; 292 driver.prefix = prefix.data(); 293 294 Fortran::parser::Options options; 295 options.predefinitions.emplace_back("__F18", "1"); 296 options.predefinitions.emplace_back("__F18_MAJOR__", "1"); 297 options.predefinitions.emplace_back("__F18_MINOR__", "1"); 298 options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1"); 299 300 options.features.Enable( 301 Fortran::common::LanguageFeature::BackslashEscapes, true); 302 303 Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; 304 305 std::vector<std::string> fortranSources, otherSources, relocatables; 306 bool anyFiles{false}; 307 308 while (!args.empty()) { 309 std::string arg{std::move(args.front())}; 310 args.pop_front(); 311 if (arg.empty() || arg == "-Xflang") { 312 } else if (arg.at(0) != '-') { 313 anyFiles = true; 314 auto dot{arg.rfind(".")}; 315 if (dot == std::string::npos) { 316 driver.fcArgs.push_back(arg); 317 } else { 318 std::string suffix{arg.substr(dot + 1)}; 319 if (suffix == "f" || suffix == "F" || suffix == "ff" || 320 suffix == "f90" || suffix == "F90" || suffix == "ff90" || 321 suffix == "f95" || suffix == "F95" || suffix == "ff95" || 322 suffix == "cuf" || suffix == "CUF" || suffix == "f18" || 323 suffix == "F18" || suffix == "ff18") { 324 fortranSources.push_back(arg); 325 } else if (suffix == "o" || suffix == "a") { 326 relocatables.push_back(arg); 327 } else { 328 otherSources.push_back(arg); 329 } 330 } 331 } else if (arg == "-") { 332 fortranSources.push_back("-"); 333 } else if (arg == "--") { 334 while (!args.empty()) { 335 fortranSources.emplace_back(std::move(args.front())); 336 args.pop_front(); 337 } 338 break; 339 } else if (arg == "-Mfixed") { 340 driver.forcedForm = true; 341 options.isFixedForm = true; 342 } else if (arg == "-Mfree") { 343 driver.forcedForm = true; 344 options.isFixedForm = false; 345 } else if (arg == "-Mextend") { 346 options.fixedFormColumns = 132; 347 } else if (arg == "-Mbackslash") { 348 options.features.Enable( 349 Fortran::common::LanguageFeature::BackslashEscapes, false); 350 } else if (arg == "-Mnobackslash") { 351 options.features.Enable( 352 Fortran::common::LanguageFeature::BackslashEscapes); 353 } else if (arg == "-Mstandard") { 354 driver.warnOnNonstandardUsage = true; 355 } else if (arg == "-fopenmp") { 356 options.features.Enable(Fortran::common::LanguageFeature::OpenMP); 357 options.predefinitions.emplace_back("_OPENMP", "201511"); 358 } else if (arg == "-Werror") { 359 driver.warningsAreErrors = true; 360 } else if (arg == "-ed") { 361 options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines); 362 } else if (arg == "-E") { 363 options.prescanAndReformat = true; 364 } else if (arg == "-P") { 365 driver.lineDirectives = false; 366 } else if (arg == "-fno-reformat") { 367 driver.noReformat = true; 368 } else if (arg == "-fbackslash") { 369 options.features.Enable( 370 Fortran::common::LanguageFeature::BackslashEscapes); 371 } else if (arg == "-fno-backslash") { 372 options.features.Enable( 373 Fortran::common::LanguageFeature::BackslashEscapes, false); 374 } else if (arg == "-fdump-provenance") { 375 driver.dumpProvenance = true; 376 } else if (arg == "-fdump-parse-tree") { 377 driver.dumpParseTree = true; 378 } else if (arg == "-funparse") { 379 driver.dumpUnparse = true; 380 } else if (arg == "-ftime-parse") { 381 driver.timeParse = true; 382 } else if (arg == "-fparse-only" || arg == "-fsyntax-only") { 383 driver.syntaxOnly = true; 384 } else if (arg == "-c") { 385 driver.compileOnly = true; 386 } else if (arg == "-o") { 387 driver.outputPath = args.front(); 388 args.pop_front(); 389 } else if (arg.substr(0, 2) == "-D") { 390 auto eq{arg.find('=')}; 391 if (eq == std::string::npos) { 392 options.predefinitions.emplace_back(arg.substr(2), "1"); 393 } else { 394 options.predefinitions.emplace_back( 395 arg.substr(2, eq - 2), arg.substr(eq + 1)); 396 } 397 } else if (arg.substr(0, 2) == "-U") { 398 options.predefinitions.emplace_back( 399 arg.substr(2), std::optional<std::string>{}); 400 } else if (arg == "-r8" || arg == "-fdefault-real-8") { 401 defaultKinds.set_defaultRealKind(8); 402 } else if (arg == "-i8" || arg == "-fdefault-integer-8") { 403 defaultKinds.set_defaultIntegerKind(8); 404 } else if (arg == "-help" || arg == "--help" || arg == "-?") { 405 llvm::errs() 406 << "f18-parse-demo options:\n" 407 << " -Mfixed | -Mfree force the source form\n" 408 << " -Mextend 132-column fixed form\n" 409 << " -f[no-]backslash enable[disable] \\escapes in literals\n" 410 << " -M[no]backslash disable[enable] \\escapes in literals\n" 411 << " -Mstandard enable conformance warnings\n" 412 << " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 " 413 "change default kinds of intrinsic types\n" 414 << " -Werror treat warnings as errors\n" 415 << " -ed enable fixed form D lines\n" 416 << " -E prescan & preprocess only\n" 417 << " -ftime-parse measure parsing time\n" 418 << " -fsyntax-only parse only, no output except messages\n" 419 << " -funparse parse & reformat only, no code " 420 "generation\n" 421 << " -fdump-provenance dump the provenance table (no code)\n" 422 << " -fdump-parse-tree dump the parse tree (no code)\n" 423 << " -v -c -o -I -D -U have their usual meanings\n" 424 << " -help print this again\n" 425 << "Other options are passed through to the $F18_FC compiler.\n"; 426 return exitStatus; 427 } else if (arg == "-V") { 428 llvm::errs() << "\nf18-parse-demo\n"; 429 return exitStatus; 430 } else { 431 driver.fcArgs.push_back(arg); 432 if (arg == "-v") { 433 driver.verbose = true; 434 } else if (arg == "-I") { 435 driver.fcArgs.push_back(args.front()); 436 driver.searchDirectories.push_back(args.front()); 437 args.pop_front(); 438 } else if (arg.substr(0, 2) == "-I") { 439 driver.searchDirectories.push_back(arg.substr(2)); 440 } 441 } 442 } 443 444 if (driver.warnOnNonstandardUsage) { 445 options.features.WarnOnAllNonstandard(); 446 } 447 if (!options.features.IsEnabled( 448 Fortran::common::LanguageFeature::BackslashEscapes)) { 449 driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash" 450 } 451 452 if (!anyFiles) { 453 driver.dumpUnparse = true; 454 CompileFortran("-", options, driver); 455 return exitStatus; 456 } 457 for (const auto &path : fortranSources) { 458 std::string relo{CompileFortran(path, options, driver)}; 459 if (!driver.compileOnly && !relo.empty()) { 460 relocatables.push_back(relo); 461 } 462 } 463 for (const auto &path : otherSources) { 464 std::string relo{CompileOtherLanguage(path, driver)}; 465 if (!driver.compileOnly && !relo.empty()) { 466 relocatables.push_back(relo); 467 } 468 } 469 if (!relocatables.empty()) { 470 Link(relocatables, driver); 471 } 472 return exitStatus; 473 } 474