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/raw_ostream.h" 37 #include <cstdio> 38 #include <cstring> 39 #include <fstream> 40 #include <list> 41 #include <memory> 42 #include <optional> 43 #include <stdlib.h> 44 #include <string> 45 #include <sys/wait.h> 46 #include <time.h> 47 #include <unistd.h> 48 #include <vector> 49 50 static std::list<std::string> argList(int argc, char *const argv[]) { 51 std::list<std::string> result; 52 for (int j = 0; j < argc; ++j) { 53 result.emplace_back(argv[j]); 54 } 55 return result; 56 } 57 58 std::vector<std::string> filesToDelete; 59 60 void CleanUpAtExit() { 61 for (const auto &path : filesToDelete) { 62 if (!path.empty()) { 63 unlink(path.data()); 64 } 65 } 66 } 67 68 #if _POSIX_C_SOURCE >= 199309L && _POSIX_TIMERS > 0 && _POSIX_CPUTIME && \ 69 defined CLOCK_PROCESS_CPUTIME_ID 70 static constexpr bool canTime{true}; 71 double CPUseconds() { 72 struct timespec tspec; 73 clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tspec); 74 return tspec.tv_nsec * 1.0e-9 + tspec.tv_sec; 75 } 76 #else 77 static constexpr bool canTime{false}; 78 double CPUseconds() { return 0; } 79 #endif 80 81 struct DriverOptions { 82 DriverOptions() {} 83 bool verbose{false}; // -v 84 bool compileOnly{false}; // -c 85 std::string outputPath; // -o path 86 std::vector<std::string> searchDirectories{"."s}; // -I dir 87 bool forcedForm{false}; // -Mfixed or -Mfree appeared 88 bool warnOnNonstandardUsage{false}; // -Mstandard 89 bool warningsAreErrors{false}; // -Werror 90 Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1}; 91 bool parseOnly{false}; 92 bool dumpProvenance{false}; 93 bool dumpCookedChars{false}; 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 bool ParentProcess() { 102 if (fork() == 0) { 103 return false; // in child process 104 } 105 int childStat{0}; 106 wait(&childStat); 107 if (!WIFEXITED(childStat) || WEXITSTATUS(childStat) != 0) { 108 exit(EXIT_FAILURE); 109 } 110 return true; 111 } 112 113 void Exec(std::vector<char *> &argv, bool verbose = false) { 114 if (verbose) { 115 for (size_t j{0}; j < argv.size(); ++j) { 116 llvm::errs() << (j > 0 ? " " : "") << argv[j]; 117 } 118 llvm::errs() << '\n'; 119 } 120 argv.push_back(nullptr); 121 execvp(argv[0], &argv[0]); 122 llvm::errs() << "execvp(" << argv[0] 123 << ") failed: " << llvm::sys::StrError(errno) << '\n'; 124 exit(EXIT_FAILURE); 125 } 126 127 void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) { 128 std::vector<char *> argv; 129 for (size_t j{0}; j < driver.fcArgs.size(); ++j) { 130 argv.push_back(driver.fcArgs[j].data()); 131 } 132 char dashC[3] = "-c", dashO[3] = "-o"; 133 argv.push_back(dashC); 134 argv.push_back(dashO); 135 argv.push_back(relo); 136 argv.push_back(source); 137 Exec(argv, driver.verbose); 138 } 139 140 std::string RelocatableName(const DriverOptions &driver, std::string path) { 141 if (driver.compileOnly && !driver.outputPath.empty()) { 142 return driver.outputPath; 143 } 144 std::string base{path}; 145 auto slash{base.rfind("/")}; 146 if (slash != std::string::npos) { 147 base = base.substr(slash + 1); 148 } 149 std::string relo{base}; 150 auto dot{base.rfind(".")}; 151 if (dot != std::string::npos) { 152 relo = base.substr(0, dot); 153 } 154 relo += ".o"; 155 return relo; 156 } 157 158 int exitStatus{EXIT_SUCCESS}; 159 160 std::string CompileFortran( 161 std::string path, Fortran::parser::Options options, DriverOptions &driver) { 162 if (!driver.forcedForm) { 163 auto dot{path.rfind(".")}; 164 if (dot != std::string::npos) { 165 std::string suffix{path.substr(dot + 1)}; 166 options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff"; 167 } 168 } 169 options.searchDirectories = driver.searchDirectories; 170 Fortran::parser::AllSources allSources; 171 Fortran::parser::Parsing parsing{allSources}; 172 173 auto start{CPUseconds()}; 174 parsing.Prescan(path, options); 175 if (!parsing.messages().empty() && 176 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) { 177 llvm::errs() << driver.prefix << "could not scan " << path << '\n'; 178 parsing.messages().Emit(llvm::errs(), parsing.cooked()); 179 exitStatus = EXIT_FAILURE; 180 return {}; 181 } 182 if (driver.dumpProvenance) { 183 parsing.DumpProvenance(llvm::outs()); 184 return {}; 185 } 186 if (driver.dumpCookedChars) { 187 parsing.DumpCookedChars(llvm::outs()); 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.cooked()); 203 if (!parsing.consumedWholeFile()) { 204 parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(), 205 "parser FAIL (final position)"); 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.parseOnly) { 228 return {}; 229 } 230 231 std::string relo{RelocatableName(driver, path)}; 232 233 char tmpSourcePath[32]; 234 std::snprintf(tmpSourcePath, sizeof tmpSourcePath, "/tmp/f18-%lx.f90", 235 static_cast<unsigned long>(getpid())); 236 { 237 std::error_code EC; 238 llvm::raw_fd_ostream tmpSource(tmpSourcePath, EC, llvm::sys::fs::F_None); 239 if (EC) { 240 llvm::errs() << EC.message(); 241 std::exit(EXIT_FAILURE); 242 } 243 Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/, 244 options.features.IsEnabled( 245 Fortran::common::LanguageFeature::BackslashEscapes)); 246 } 247 248 if (ParentProcess()) { 249 filesToDelete.push_back(tmpSourcePath); 250 if (!driver.compileOnly && driver.outputPath.empty()) { 251 filesToDelete.push_back(relo); 252 } 253 return relo; 254 } 255 RunOtherCompiler(driver, tmpSourcePath, relo.data()); 256 return {}; 257 } 258 259 std::string CompileOtherLanguage(std::string path, DriverOptions &driver) { 260 std::string relo{RelocatableName(driver, path)}; 261 if (ParentProcess()) { 262 if (!driver.compileOnly && driver.outputPath.empty()) { 263 filesToDelete.push_back(relo); 264 } 265 return relo; 266 } 267 RunOtherCompiler(driver, path.data(), relo.data()); 268 return {}; 269 } 270 271 void Link(std::vector<std::string> &relocatables, DriverOptions &driver) { 272 if (!ParentProcess()) { 273 std::vector<char *> argv; 274 for (size_t j{0}; j < driver.fcArgs.size(); ++j) { 275 argv.push_back(driver.fcArgs[j].data()); 276 } 277 for (auto &relo : relocatables) { 278 argv.push_back(relo.data()); 279 } 280 if (!driver.outputPath.empty()) { 281 char dashO[3] = "-o"; 282 argv.push_back(dashO); 283 argv.push_back(driver.outputPath.data()); 284 } 285 Exec(argv, driver.verbose); 286 } 287 } 288 289 int main(int argc, char *const argv[]) { 290 291 atexit(CleanUpAtExit); 292 293 DriverOptions driver; 294 const char *fc{getenv("F18_FC")}; 295 driver.fcArgs.push_back(fc ? fc : "gfortran"); 296 297 std::list<std::string> args{argList(argc, argv)}; 298 std::string prefix{args.front()}; 299 args.pop_front(); 300 prefix += ": "; 301 driver.prefix = prefix.data(); 302 303 Fortran::parser::Options options; 304 options.predefinitions.emplace_back("__F18", "1"); 305 options.predefinitions.emplace_back("__F18_MAJOR__", "1"); 306 options.predefinitions.emplace_back("__F18_MINOR__", "1"); 307 options.predefinitions.emplace_back("__F18_PATCHLEVEL__", "1"); 308 309 options.features.Enable( 310 Fortran::common::LanguageFeature::BackslashEscapes, true); 311 312 Fortran::common::IntrinsicTypeDefaultKinds defaultKinds; 313 314 std::vector<std::string> fortranSources, otherSources, relocatables; 315 bool anyFiles{false}; 316 317 while (!args.empty()) { 318 std::string arg{std::move(args.front())}; 319 args.pop_front(); 320 if (arg.empty()) { 321 } else if (arg.at(0) != '-') { 322 anyFiles = true; 323 auto dot{arg.rfind(".")}; 324 if (dot == std::string::npos) { 325 driver.fcArgs.push_back(arg); 326 } else { 327 std::string suffix{arg.substr(dot + 1)}; 328 if (suffix == "f" || suffix == "F" || suffix == "ff" || 329 suffix == "f90" || suffix == "F90" || suffix == "ff90" || 330 suffix == "f95" || suffix == "F95" || suffix == "ff95" || 331 suffix == "cuf" || suffix == "CUF" || suffix == "f18" || 332 suffix == "F18" || suffix == "ff18") { 333 fortranSources.push_back(arg); 334 } else if (suffix == "o" || suffix == "a") { 335 relocatables.push_back(arg); 336 } else { 337 otherSources.push_back(arg); 338 } 339 } 340 } else if (arg == "-") { 341 fortranSources.push_back("-"); 342 } else if (arg == "--") { 343 while (!args.empty()) { 344 fortranSources.emplace_back(std::move(args.front())); 345 args.pop_front(); 346 } 347 break; 348 } else if (arg == "-Mfixed") { 349 driver.forcedForm = true; 350 options.isFixedForm = true; 351 } else if (arg == "-Mfree") { 352 driver.forcedForm = true; 353 options.isFixedForm = false; 354 } else if (arg == "-Mextend") { 355 options.fixedFormColumns = 132; 356 } else if (arg == "-Mbackslash") { 357 options.features.Enable( 358 Fortran::common::LanguageFeature::BackslashEscapes, false); 359 } else if (arg == "-Mnobackslash") { 360 options.features.Enable( 361 Fortran::common::LanguageFeature::BackslashEscapes); 362 } else if (arg == "-Mstandard") { 363 driver.warnOnNonstandardUsage = true; 364 } else if (arg == "-fopenmp") { 365 options.features.Enable(Fortran::common::LanguageFeature::OpenMP); 366 options.predefinitions.emplace_back("_OPENMP", "201511"); 367 } else if (arg == "-Werror") { 368 driver.warningsAreErrors = true; 369 } else if (arg == "-ed") { 370 options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines); 371 } else if (arg == "-E" || arg == "-fpreprocess-only") { 372 driver.dumpCookedChars = true; 373 } else if (arg == "-fbackslash") { 374 options.features.Enable( 375 Fortran::common::LanguageFeature::BackslashEscapes); 376 } else if (arg == "-fno-backslash") { 377 options.features.Enable( 378 Fortran::common::LanguageFeature::BackslashEscapes, false); 379 } else if (arg == "-fdump-provenance") { 380 driver.dumpProvenance = true; 381 } else if (arg == "-fdump-parse-tree") { 382 driver.dumpParseTree = true; 383 } else if (arg == "-funparse") { 384 driver.dumpUnparse = true; 385 } else if (arg == "-ftime-parse") { 386 driver.timeParse = true; 387 } else if (arg == "-fparse-only") { 388 driver.parseOnly = true; 389 } else if (arg == "-c") { 390 driver.compileOnly = true; 391 } else if (arg == "-o") { 392 driver.outputPath = args.front(); 393 args.pop_front(); 394 } else if (arg.substr(0, 2) == "-D") { 395 auto eq{arg.find('=')}; 396 if (eq == std::string::npos) { 397 options.predefinitions.emplace_back(arg.substr(2), "1"); 398 } else { 399 options.predefinitions.emplace_back( 400 arg.substr(2, eq - 2), arg.substr(eq + 1)); 401 } 402 } else if (arg.substr(0, 2) == "-U") { 403 options.predefinitions.emplace_back( 404 arg.substr(2), std::optional<std::string>{}); 405 } else if (arg == "-r8" || arg == "-fdefault-real-8") { 406 defaultKinds.set_defaultRealKind(8); 407 } else if (arg == "-i8" || arg == "-fdefault-integer-8") { 408 defaultKinds.set_defaultIntegerKind(8); 409 } else if (arg == "-help" || arg == "--help" || arg == "-?") { 410 llvm::errs() 411 << "f18-parse-demo options:\n" 412 << " -Mfixed | -Mfree force the source form\n" 413 << " -Mextend 132-column fixed form\n" 414 << " -f[no-]backslash enable[disable] \\escapes in literals\n" 415 << " -M[no]backslash disable[enable] \\escapes in literals\n" 416 << " -Mstandard enable conformance warnings\n" 417 << " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 " 418 "change default kinds of intrinsic types\n" 419 << " -Werror treat warnings as errors\n" 420 << " -ed enable fixed form D lines\n" 421 << " -E prescan & preprocess only\n" 422 << " -ftime-parse measure parsing time\n" 423 << " -fparse-only parse only, no output except messages\n" 424 << " -funparse parse & reformat only, no code " 425 "generation\n" 426 << " -fdump-provenance dump the provenance table (no code)\n" 427 << " -fdump-parse-tree dump the parse tree (no code)\n" 428 << " -v -c -o -I -D -U have their usual meanings\n" 429 << " -help print this again\n" 430 << "Other options are passed through to the $F18_FC compiler.\n"; 431 return exitStatus; 432 } else if (arg == "-V") { 433 llvm::errs() << "\nf18-parse-demo\n"; 434 return exitStatus; 435 } else { 436 driver.fcArgs.push_back(arg); 437 if (arg == "-v") { 438 driver.verbose = true; 439 } else if (arg == "-I") { 440 driver.fcArgs.push_back(args.front()); 441 driver.searchDirectories.push_back(args.front()); 442 args.pop_front(); 443 } else if (arg.substr(0, 2) == "-I") { 444 driver.searchDirectories.push_back(arg.substr(2)); 445 } 446 } 447 } 448 449 if (driver.warnOnNonstandardUsage) { 450 options.features.WarnOnAllNonstandard(); 451 } 452 if (!options.features.IsEnabled( 453 Fortran::common::LanguageFeature::BackslashEscapes)) { 454 driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash" 455 } 456 457 if (!anyFiles) { 458 driver.dumpUnparse = true; 459 CompileFortran("-", options, driver); 460 return exitStatus; 461 } 462 for (const auto &path : fortranSources) { 463 std::string relo{CompileFortran(path, options, driver)}; 464 if (!driver.compileOnly && !relo.empty()) { 465 relocatables.push_back(relo); 466 } 467 } 468 for (const auto &path : otherSources) { 469 std::string relo{CompileOtherLanguage(path, driver)}; 470 if (!driver.compileOnly && !relo.empty()) { 471 relocatables.push_back(relo); 472 } 473 } 474 if (!relocatables.empty()) { 475 Link(relocatables, driver); 476 } 477 return exitStatus; 478 } 479