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 warnOnSuspiciousUsage{false}; // -pedantic 89 bool warningsAreErrors{false}; // -Werror 90 Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1}; 91 bool lineDirectives{true}; // -P disables 92 bool syntaxOnly{false}; 93 bool dumpProvenance{false}; 94 bool noReformat{false}; // -E -fno-reformat 95 bool dumpUnparse{false}; 96 bool dumpParseTree{false}; 97 bool timeParse{false}; 98 std::vector<std::string> fcArgs; 99 const char *prefix{nullptr}; 100 }; 101 102 void Exec(std::vector<llvm::StringRef> &argv, bool verbose = false) { 103 if (verbose) { 104 for (size_t j{0}; j < argv.size(); ++j) { 105 llvm::errs() << (j > 0 ? " " : "") << argv[j]; 106 } 107 llvm::errs() << '\n'; 108 } 109 std::string ErrMsg; 110 llvm::ErrorOr<std::string> Program = llvm::sys::findProgramByName(argv[0]); 111 if (!Program) 112 ErrMsg = Program.getError().message(); 113 if (!Program || 114 llvm::sys::ExecuteAndWait( 115 Program.get(), argv, std::nullopt, {}, 0, 0, &ErrMsg)) { 116 llvm::errs() << "execvp(" << argv[0] << ") failed: " << ErrMsg << '\n'; 117 exit(EXIT_FAILURE); 118 } 119 } 120 121 void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) { 122 std::vector<llvm::StringRef> argv; 123 for (size_t j{0}; j < driver.fcArgs.size(); ++j) { 124 argv.push_back(driver.fcArgs[j]); 125 } 126 char dashC[3] = "-c", dashO[3] = "-o"; 127 argv.push_back(dashC); 128 argv.push_back(dashO); 129 argv.push_back(relo); 130 argv.push_back(source); 131 Exec(argv, driver.verbose); 132 } 133 134 std::string RelocatableName(const DriverOptions &driver, std::string path) { 135 if (driver.compileOnly && !driver.outputPath.empty()) { 136 return driver.outputPath; 137 } 138 std::string base{path}; 139 auto slash{base.rfind("/")}; 140 if (slash != std::string::npos) { 141 base = base.substr(slash + 1); 142 } 143 std::string relo{base}; 144 auto dot{base.rfind(".")}; 145 if (dot != std::string::npos) { 146 relo = base.substr(0, dot); 147 } 148 relo += ".o"; 149 return relo; 150 } 151 152 int exitStatus{EXIT_SUCCESS}; 153 154 std::string CompileFortran( 155 std::string path, Fortran::parser::Options options, DriverOptions &driver) { 156 if (!driver.forcedForm) { 157 auto dot{path.rfind(".")}; 158 if (dot != std::string::npos) { 159 std::string suffix{path.substr(dot + 1)}; 160 options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; 161 } 162 } 163 options.searchDirectories = driver.searchDirectories; 164 Fortran::parser::AllSources allSources; 165 Fortran::parser::AllCookedSources allCookedSources{allSources}; 166 Fortran::parser::Parsing parsing{allCookedSources}; 167 168 auto start{CPUseconds()}; 169 parsing.Prescan(path, options); 170 if (!parsing.messages().empty() && 171 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) { 172 llvm::errs() << driver.prefix << "could not scan " << path << '\n'; 173 parsing.messages().Emit(llvm::errs(), parsing.allCooked()); 174 exitStatus = EXIT_FAILURE; 175 return {}; 176 } 177 if (driver.dumpProvenance) { 178 parsing.DumpProvenance(llvm::outs()); 179 return {}; 180 } 181 if (options.prescanAndReformat) { 182 parsing.messages().Emit(llvm::errs(), allCookedSources); 183 if (driver.noReformat) { 184 parsing.DumpCookedChars(llvm::outs()); 185 } else { 186 parsing.EmitPreprocessedSource(llvm::outs(), driver.lineDirectives); 187 } 188 return {}; 189 } 190 parsing.Parse(llvm::outs()); 191 auto stop{CPUseconds()}; 192 if (driver.timeParse) { 193 if (canTime) { 194 llvm::outs() << "parse time for " << path << ": " << (stop - start) 195 << " CPU seconds\n"; 196 } else { 197 llvm::outs() << "no timing information due to lack of clock_gettime()\n"; 198 } 199 } 200 201 parsing.ClearLog(); 202 parsing.messages().Emit(llvm::errs(), parsing.allCooked()); 203 if (!parsing.consumedWholeFile()) { 204 parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), 205 "parser FAIL (final position)", "error: ", llvm::raw_ostream::RED); 206 exitStatus = EXIT_FAILURE; 207 return {}; 208 } 209 if ((!parsing.messages().empty() && 210 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) || 211 !parsing.parseTree()) { 212 llvm::errs() << driver.prefix << "could not parse " << path << '\n'; 213 exitStatus = EXIT_FAILURE; 214 return {}; 215 } 216 auto &parseTree{*parsing.parseTree()}; 217 if (driver.dumpParseTree) { 218 Fortran::parser::DumpTree(llvm::outs(), parseTree); 219 return {}; 220 } 221 if (driver.dumpUnparse) { 222 Unparse(llvm::outs(), parseTree, driver.encoding, true /*capitalize*/, 223 options.features.IsEnabled( 224 Fortran::common::LanguageFeature::BackslashEscapes)); 225 return {}; 226 } 227 if (driver.syntaxOnly) { 228 return {}; 229 } 230 231 std::string relo{RelocatableName(driver, path)}; 232 233 llvm::SmallString<32> tmpSourcePath; 234 { 235 int fd; 236 std::error_code EC = 237 llvm::sys::fs::createUniqueFile("f18-%%%%.f90", fd, tmpSourcePath); 238 if (EC) { 239 llvm::errs() << EC.message() << "\n"; 240 std::exit(EXIT_FAILURE); 241 } 242 llvm::raw_fd_ostream tmpSource(fd, /*shouldClose*/ true); 243 Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/, 244 options.features.IsEnabled( 245 Fortran::common::LanguageFeature::BackslashEscapes)); 246 } 247 248 RunOtherCompiler(driver, tmpSourcePath.data(), relo.data()); 249 filesToDelete.emplace_back(tmpSourcePath); 250 if (!driver.compileOnly && driver.outputPath.empty()) { 251 filesToDelete.push_back(relo); 252 } 253 return relo; 254 } 255 256 std::string CompileOtherLanguage(std::string path, DriverOptions &driver) { 257 std::string relo{RelocatableName(driver, path)}; 258 RunOtherCompiler(driver, path.data(), relo.data()); 259 if (!driver.compileOnly && driver.outputPath.empty()) { 260 filesToDelete.push_back(relo); 261 } 262 return relo; 263 } 264 265 void Link(std::vector<std::string> &relocatables, DriverOptions &driver) { 266 std::vector<llvm::StringRef> argv; 267 for (size_t j{0}; j < driver.fcArgs.size(); ++j) { 268 argv.push_back(driver.fcArgs[j].data()); 269 } 270 for (auto &relo : relocatables) { 271 argv.push_back(relo.data()); 272 } 273 if (!driver.outputPath.empty()) { 274 char dashO[3] = "-o"; 275 argv.push_back(dashO); 276 argv.push_back(driver.outputPath.data()); 277 } 278 Exec(argv, driver.verbose); 279 } 280 281 int main(int argc, char *const argv[]) { 282 283 atexit(CleanUpAtExit); 284 285 DriverOptions driver; 286 const char *fc{getenv("F18_FC")}; 287 driver.fcArgs.push_back(fc ? fc : "gfortran"); 288 289 std::list<std::string> args{argList(argc, argv)}; 290 std::string prefix{args.front()}; 291 args.pop_front(); 292 prefix += ": "; 293 driver.prefix = prefix.data(); 294 295 Fortran::parser::Options options; 296 options.predefinitions.emplace_back("__F18", "1"); 297 options.predefinitions.emplace_back("__F18_MAJOR__", "1"); 298 options.predefinitions.emplace_back("__F18_MINOR__", "1"); 299 options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1"); 300 301 options.features.Enable( 302 Fortran::common::LanguageFeature::BackslashEscapes, true); 303 304 Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; 305 306 std::vector<std::string> fortranSources, otherSources, relocatables; 307 bool anyFiles{false}; 308 309 while (!args.empty()) { 310 std::string arg{std::move(args.front())}; 311 args.pop_front(); 312 if (arg.empty() || arg == "-Xflang") { 313 } else if (arg.at(0) != '-') { 314 anyFiles = true; 315 auto dot{arg.rfind(".")}; 316 if (dot == std::string::npos) { 317 driver.fcArgs.push_back(arg); 318 } else { 319 std::string suffix{arg.substr(dot + 1)}; 320 if (suffix == "f" || suffix == "F" || suffix == "ff" || 321 suffix == "f90" || suffix == "F90" || suffix == "ff90" || 322 suffix == "f95" || suffix == "F95" || suffix == "ff95" || 323 suffix == "cuf" || suffix == "CUF" || suffix == "f18" || 324 suffix == "F18" || suffix == "ff18") { 325 fortranSources.push_back(arg); 326 } else if (suffix == "o" || suffix == "a") { 327 relocatables.push_back(arg); 328 } else { 329 otherSources.push_back(arg); 330 } 331 } 332 } else if (arg == "-") { 333 fortranSources.push_back("-"); 334 } else if (arg == "--") { 335 while (!args.empty()) { 336 fortranSources.emplace_back(std::move(args.front())); 337 args.pop_front(); 338 } 339 break; 340 } else if (arg == "-Mfixed") { 341 driver.forcedForm = true; 342 options.isFixedForm = true; 343 } else if (arg == "-Mfree") { 344 driver.forcedForm = true; 345 options.isFixedForm = false; 346 } else if (arg == "-Mextend") { 347 options.fixedFormColumns = 132; 348 } else if (arg == "-Mbackslash") { 349 options.features.Enable( 350 Fortran::common::LanguageFeature::BackslashEscapes, false); 351 } else if (arg == "-Mnobackslash") { 352 options.features.Enable( 353 Fortran::common::LanguageFeature::BackslashEscapes); 354 } else if (arg == "-Mstandard") { 355 driver.warnOnNonstandardUsage = true; 356 } else if (arg == "-pedantic") { 357 driver.warnOnNonstandardUsage = true; 358 driver.warnOnSuspiciousUsage = true; 359 } else if (arg == "-fopenmp") { 360 options.features.Enable(Fortran::common::LanguageFeature::OpenMP); 361 options.predefinitions.emplace_back("_OPENMP", "201511"); 362 } else if (arg == "-Werror") { 363 driver.warningsAreErrors = true; 364 } else if (arg == "-ed") { 365 options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines); 366 } else if (arg == "-E") { 367 options.prescanAndReformat = true; 368 } else if (arg == "-P") { 369 driver.lineDirectives = false; 370 } else if (arg == "-fno-reformat") { 371 driver.noReformat = true; 372 } else if (arg == "-fbackslash") { 373 options.features.Enable( 374 Fortran::common::LanguageFeature::BackslashEscapes); 375 } else if (arg == "-fno-backslash") { 376 options.features.Enable( 377 Fortran::common::LanguageFeature::BackslashEscapes, false); 378 } else if (arg == "-fdump-provenance") { 379 driver.dumpProvenance = true; 380 } else if (arg == "-fdump-parse-tree") { 381 driver.dumpParseTree = true; 382 } else if (arg == "-funparse") { 383 driver.dumpUnparse = true; 384 } else if (arg == "-ftime-parse") { 385 driver.timeParse = true; 386 } else if (arg == "-fparse-only" || arg == "-fsyntax-only") { 387 driver.syntaxOnly = true; 388 } else if (arg == "-c") { 389 driver.compileOnly = true; 390 } else if (arg == "-o") { 391 driver.outputPath = args.front(); 392 args.pop_front(); 393 } else if (arg.substr(0, 2) == "-D") { 394 auto eq{arg.find('=')}; 395 if (eq == std::string::npos) { 396 options.predefinitions.emplace_back(arg.substr(2), "1"); 397 } else { 398 options.predefinitions.emplace_back( 399 arg.substr(2, eq - 2), arg.substr(eq + 1)); 400 } 401 } else if (arg.substr(0, 2) == "-U") { 402 options.predefinitions.emplace_back( 403 arg.substr(2), std::optional<std::string>{}); 404 } else if (arg == "-r8" || arg == "-fdefault-real-8") { 405 defaultKinds.set_defaultRealKind(8); 406 } else if (arg == "-i8" || arg == "-fdefault-integer-8") { 407 defaultKinds.set_defaultIntegerKind(8); 408 } else if (arg == "-help" || arg == "--help" || arg == "-?") { 409 llvm::errs() 410 << "f18-parse-demo options:\n" 411 << " -Mfixed | -Mfree force the source form\n" 412 << " -Mextend 132-column fixed form\n" 413 << " -f[no-]backslash enable[disable] \\escapes in literals\n" 414 << " -M[no]backslash disable[enable] \\escapes in literals\n" 415 << " -Mstandard enable conformance warnings\n" 416 << " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 " 417 "change default kinds of intrinsic types\n" 418 << " -Werror treat warnings as errors\n" 419 << " -ed enable fixed form D lines\n" 420 << " -E prescan & preprocess only\n" 421 << " -ftime-parse measure parsing time\n" 422 << " -fsyntax-only parse only, no output except messages\n" 423 << " -funparse parse & reformat only, no code " 424 "generation\n" 425 << " -fdump-provenance dump the provenance table (no code)\n" 426 << " -fdump-parse-tree dump the parse tree (no code)\n" 427 << " -v -c -o -I -D -U have their usual meanings\n" 428 << " -help print this again\n" 429 << "Other options are passed through to the $F18_FC compiler.\n"; 430 return exitStatus; 431 } else if (arg == "-V") { 432 llvm::errs() << "\nf18-parse-demo\n"; 433 return exitStatus; 434 } else { 435 driver.fcArgs.push_back(arg); 436 if (arg == "-v") { 437 driver.verbose = true; 438 } else if (arg == "-I") { 439 driver.fcArgs.push_back(args.front()); 440 driver.searchDirectories.push_back(args.front()); 441 args.pop_front(); 442 } else if (arg.substr(0, 2) == "-I") { 443 driver.searchDirectories.push_back(arg.substr(2)); 444 } 445 } 446 } 447 448 if (driver.warnOnNonstandardUsage) { 449 options.features.WarnOnAllNonstandard(); 450 } 451 if (driver.warnOnSuspiciousUsage) { 452 options.features.WarnOnAllUsage(); 453 } 454 if (!options.features.IsEnabled( 455 Fortran::common::LanguageFeature::BackslashEscapes)) { 456 driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash" 457 } 458 459 if (!anyFiles) { 460 driver.dumpUnparse = true; 461 CompileFortran("-", options, driver); 462 return exitStatus; 463 } 464 for (const auto &path : fortranSources) { 465 std::string relo{CompileFortran(path, options, driver)}; 466 if (!driver.compileOnly && !relo.empty()) { 467 relocatables.push_back(relo); 468 } 469 } 470 for (const auto &path : otherSources) { 471 std::string relo{CompileOtherLanguage(path, driver)}; 472 if (!driver.compileOnly && !relo.empty()) { 473 relocatables.push_back(relo); 474 } 475 } 476 if (!relocatables.empty()) { 477 Link(relocatables, driver); 478 } 479 return exitStatus; 480 } 481