1 //===-- tools/f18/f18.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 // Temporary Fortran front end driver main program for development scaffolding.
10
11 #include "flang/Common/Fortran-features.h"
12 #include "flang/Common/default-kinds.h"
13 #include "flang/Evaluate/expression.h"
14 #include "flang/Lower/PFTBuilder.h"
15 #include "flang/Parser/characters.h"
16 #include "flang/Parser/dump-parse-tree.h"
17 #include "flang/Parser/message.h"
18 #include "flang/Parser/parse-tree-visitor.h"
19 #include "flang/Parser/parse-tree.h"
20 #include "flang/Parser/parsing.h"
21 #include "flang/Parser/provenance.h"
22 #include "flang/Parser/unparse.h"
23 #include "flang/Semantics/expression.h"
24 #include "flang/Semantics/runtime-type-info.h"
25 #include "flang/Semantics/semantics.h"
26 #include "flang/Semantics/unparse-with-symbols.h"
27 #include "flang/Version.inc"
28 #include "llvm/Support/Errno.h"
29 #include "llvm/Support/FileSystem.h"
30 #include "llvm/Support/FileUtilities.h"
31 #include "llvm/Support/Program.h"
32 #include "llvm/Support/Signals.h"
33 #include "llvm/Support/raw_ostream.h"
34 #include <cstdio>
35 #include <cstring>
36 #include <fstream>
37 #include <list>
38 #include <memory>
39 #include <optional>
40 #include <stdlib.h>
41 #include <string>
42 #include <vector>
43
argList(int argc,char * const argv[])44 static std::list<std::string> argList(int argc, char *const argv[]) {
45 std::list<std::string> result;
46 for (int j = 0; j < argc; ++j) {
47 result.emplace_back(argv[j]);
48 }
49 return result;
50 }
51
52 struct MeasurementVisitor {
PreMeasurementVisitor53 template <typename A> bool Pre(const A &) { return true; }
PostMeasurementVisitor54 template <typename A> void Post(const A &) {
55 ++objects;
56 bytes += sizeof(A);
57 }
58 size_t objects{0}, bytes{0};
59 };
60
MeasureParseTree(const Fortran::parser::Program & program)61 void MeasureParseTree(const Fortran::parser::Program &program) {
62 MeasurementVisitor visitor;
63 Fortran::parser::Walk(program, visitor);
64 llvm::outs() << "Parse tree comprises " << visitor.objects
65 << " objects and occupies " << visitor.bytes
66 << " total bytes.\n";
67 }
68
69 std::vector<std::string> filesToDelete;
70
CleanUpAtExit()71 void CleanUpAtExit() {
72 for (const auto &path : filesToDelete) {
73 if (!path.empty()) {
74 llvm::sys::fs::remove(path);
75 }
76 }
77 }
78
79 struct GetDefinitionArgs {
80 int line, startColumn, endColumn;
81 };
82
83 struct DriverOptions {
DriverOptionsDriverOptions84 DriverOptions() {}
85 bool verbose{false}; // -v
86 bool compileOnly{false}; // -c
87 std::string outputPath; // -o path
88 std::vector<std::string> searchDirectories; // -I dir
89 std::string moduleDirectory{"."s}; // -module dir
90 std::string moduleFileSuffix{".mod"}; // -moduleSuffix suff
91 bool forcedForm{false}; // -Mfixed or -Mfree appeared
92 bool warnOnNonstandardUsage{false}; // -Mstandard
93 bool warningsAreErrors{false}; // -Werror
94 bool byteswapio{false}; // -byteswapio
95 Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF_8};
96 bool syntaxOnly{false};
97 bool dumpProvenance{false};
98 bool dumpCookedChars{false};
99 bool dumpUnparse{false};
100 bool dumpUnparseWithSymbols{false};
101 bool dumpParseTree{false};
102 bool dumpPreFirTree{false};
103 bool dumpSymbols{false};
104 bool debugNoSemantics{false};
105 bool debugModuleWriter{false};
106 bool defaultReal8{false};
107 bool measureTree{false};
108 bool useAnalyzedObjectsForUnparse{true};
109 std::vector<std::string> F18_FCArgs;
110 const char *prefix{nullptr};
111 bool getDefinition{false};
112 GetDefinitionArgs getDefinitionArgs{0, 0, 0};
113 bool getSymbolsSources{false};
114 std::optional<bool> forcePreprocessing; // -cpp & -nocpp
115 };
116
Exec(std::vector<llvm::StringRef> & argv,bool verbose=false)117 void Exec(std::vector<llvm::StringRef> &argv, bool verbose = false) {
118 if (verbose) {
119 for (size_t j{0}; j < argv.size(); ++j) {
120 llvm::errs() << (j > 0 ? " " : "") << argv[j];
121 }
122 llvm::errs() << '\n';
123 }
124 std::string ErrMsg;
125 llvm::ErrorOr<std::string> Program = llvm::sys::findProgramByName(argv[0]);
126 if (!Program)
127 ErrMsg = Program.getError().message();
128 if (!Program ||
129 llvm::sys::ExecuteAndWait(
130 Program.get(), argv, llvm::None, {}, 0, 0, &ErrMsg)) {
131 llvm::errs() << "execvp(" << argv[0] << ") failed: " << ErrMsg << '\n';
132 exit(EXIT_FAILURE);
133 }
134 }
135
RunOtherCompiler(DriverOptions & driver,char * source,char * relo)136 void RunOtherCompiler(DriverOptions &driver, char *source, char *relo) {
137 std::vector<llvm::StringRef> argv;
138 for (size_t j{0}; j < driver.F18_FCArgs.size(); ++j) {
139 argv.push_back(driver.F18_FCArgs[j]);
140 }
141 char dashC[3] = "-c", dashO[3] = "-o";
142 argv.push_back(dashC);
143 argv.push_back(dashO);
144 argv.push_back(relo);
145 argv.push_back(source);
146 Exec(argv, driver.verbose);
147 }
148
RelocatableName(const DriverOptions & driver,std::string path)149 std::string RelocatableName(const DriverOptions &driver, std::string path) {
150 if (driver.compileOnly && !driver.outputPath.empty()) {
151 return driver.outputPath;
152 }
153 std::string base{path};
154 auto slash{base.rfind("/")};
155 if (slash != std::string::npos) {
156 base = base.substr(slash + 1);
157 }
158 std::string relo{base};
159 auto dot{base.rfind(".")};
160 if (dot != std::string::npos) {
161 relo = base.substr(0, dot);
162 }
163 relo += ".o";
164 return relo;
165 }
166
167 int exitStatus{EXIT_SUCCESS};
168
169 static Fortran::parser::AnalyzedObjectsAsFortran asFortran{
__anon719c25f20102() 170 [](llvm::raw_ostream &o, const Fortran::evaluate::GenericExprWrapper &x) {
171 if (x.v) {
172 x.v->AsFortran(o);
173 } else {
174 o << "(bad expression)";
175 }
176 },
177 [](llvm::raw_ostream &o,
__anon719c25f20202() 178 const Fortran::evaluate::GenericAssignmentWrapper &x) {
179 if (x.v) {
180 x.v->AsFortran(o);
181 } else {
182 o << "(bad assignment)";
183 }
184 },
__anon719c25f20302() 185 [](llvm::raw_ostream &o, const Fortran::evaluate::ProcedureRef &x) {
186 x.AsFortran(o << "CALL ");
187 },
188 };
189
CompileFortran(std::string path,Fortran::parser::Options options,DriverOptions & driver,const Fortran::common::IntrinsicTypeDefaultKinds & defaultKinds)190 std::string CompileFortran(std::string path, Fortran::parser::Options options,
191 DriverOptions &driver,
192 const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds) {
193 Fortran::parser::AllSources allSources;
194 Fortran::parser::AllCookedSources allCookedSources{allSources};
195 allSources.set_encoding(driver.encoding);
196 Fortran::semantics::SemanticsContext semanticsContext{
197 defaultKinds, options.features, allCookedSources};
198 semanticsContext.set_moduleDirectory(driver.moduleDirectory)
199 .set_moduleFileSuffix(driver.moduleFileSuffix)
200 .set_searchDirectories(driver.searchDirectories)
201 .set_warnOnNonstandardUsage(driver.warnOnNonstandardUsage)
202 .set_warningsAreErrors(driver.warningsAreErrors);
203 if (!driver.forcedForm) {
204 auto dot{path.rfind(".")};
205 if (dot != std::string::npos) {
206 std::string suffix{path.substr(dot + 1)};
207 options.isFixedForm = suffix == "f" || suffix == "F" || suffix == "ff";
208 }
209 }
210 options.searchDirectories = driver.searchDirectories;
211 Fortran::parser::Parsing parsing{allCookedSources};
212 parsing.Prescan(path, options);
213 if (!parsing.messages().empty() &&
214 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) {
215 llvm::errs() << driver.prefix << "Could not scan " << path << '\n';
216 parsing.messages().Emit(llvm::errs(), allCookedSources);
217 exitStatus = EXIT_FAILURE;
218 return {};
219 }
220 if (driver.dumpProvenance) {
221 parsing.DumpProvenance(llvm::outs());
222 return {};
223 }
224 if (driver.dumpCookedChars) {
225 parsing.messages().Emit(llvm::errs(), allCookedSources);
226 parsing.DumpCookedChars(llvm::outs());
227 return {};
228 }
229 parsing.Parse(llvm::outs());
230 if (options.instrumentedParse) {
231 parsing.DumpParsingLog(llvm::outs());
232 return {};
233 }
234 parsing.ClearLog();
235 parsing.messages().Emit(llvm::errs(), allCookedSources);
236 if (!parsing.consumedWholeFile()) {
237 parsing.EmitMessage(llvm::errs(), parsing.finalRestingPlace(),
238 "Parser FAIL (final position)");
239 exitStatus = EXIT_FAILURE;
240 return {};
241 }
242 if ((!parsing.messages().empty() &&
243 (driver.warningsAreErrors || parsing.messages().AnyFatalError())) ||
244 !parsing.parseTree()) {
245 llvm::errs() << driver.prefix << "Could not parse " << path << '\n';
246 exitStatus = EXIT_FAILURE;
247 return {};
248 }
249 auto &parseTree{*parsing.parseTree()};
250 if (driver.measureTree) {
251 MeasureParseTree(parseTree);
252 }
253 if (!driver.debugNoSemantics || driver.dumpSymbols ||
254 driver.dumpUnparseWithSymbols || driver.getDefinition ||
255 driver.getSymbolsSources) {
256 Fortran::semantics::Semantics semantics{
257 semanticsContext, parseTree, driver.debugModuleWriter};
258 semantics.Perform();
259 Fortran::semantics::RuntimeDerivedTypeTables tables;
260 if (!semantics.AnyFatalError()) {
261 tables =
262 Fortran::semantics::BuildRuntimeDerivedTypeTables(semanticsContext);
263 if (!tables.schemata) {
264 llvm::errs() << driver.prefix
265 << "could not find module file for __fortran_type_info\n";
266 }
267 }
268 semantics.EmitMessages(llvm::errs());
269 if (semantics.AnyFatalError()) {
270 if (driver.dumpSymbols) {
271 semantics.DumpSymbols(llvm::outs());
272 }
273 llvm::errs() << driver.prefix << "Semantic errors in " << path << '\n';
274 exitStatus = EXIT_FAILURE;
275 if (driver.dumpParseTree) {
276 Fortran::parser::DumpTree(llvm::outs(), parseTree, &asFortran);
277 }
278 return {};
279 }
280 if (driver.dumpSymbols) {
281 semantics.DumpSymbols(llvm::outs());
282 }
283 if (driver.dumpUnparseWithSymbols) {
284 Fortran::semantics::UnparseWithSymbols(
285 llvm::outs(), parseTree, driver.encoding);
286 return {};
287 }
288 if (driver.getSymbolsSources) {
289 semantics.DumpSymbolsSources(llvm::outs());
290 return {};
291 }
292 if (driver.getDefinition) {
293 if (auto cb{allCookedSources.GetCharBlockFromLineAndColumns(
294 driver.getDefinitionArgs.line,
295 driver.getDefinitionArgs.startColumn,
296 driver.getDefinitionArgs.endColumn)}) {
297 llvm::errs() << "String range: >" << cb->ToString() << "<\n";
298 if (auto symbol{semanticsContext.FindScope(*cb).FindSymbol(*cb)}) {
299 llvm::errs() << "Found symbol name: " << symbol->name().ToString()
300 << "\n";
301 if (auto sourceInfo{
302 allCookedSources.GetSourcePositionRange(symbol->name())}) {
303 llvm::outs() << symbol->name().ToString() << ": "
304 << sourceInfo->first.file.path() << ", "
305 << sourceInfo->first.line << ", "
306 << sourceInfo->first.column << "-"
307 << sourceInfo->second.column << "\n";
308 exitStatus = EXIT_SUCCESS;
309 return {};
310 }
311 }
312 }
313 llvm::errs() << "Symbol not found.\n";
314 exitStatus = EXIT_FAILURE;
315 return {};
316 }
317 }
318 if (driver.dumpParseTree) {
319 Fortran::parser::DumpTree(llvm::outs(), parseTree, &asFortran);
320 }
321 if (driver.dumpUnparse) {
322 // Prepare the output stream
323 std::unique_ptr<llvm::raw_fd_ostream> os;
324 std::string outputFile = "-";
325 if (!driver.outputPath.empty()) {
326 outputFile = driver.outputPath;
327 }
328
329 std::error_code EC;
330 os.reset(new llvm::raw_fd_ostream(
331 outputFile, EC, llvm::sys::fs::OF_TextWithCRLF));
332 if (EC) {
333 llvm::errs() << EC.message() << "\n";
334 std::exit(EXIT_FAILURE);
335 }
336
337 Unparse(*os, parseTree, driver.encoding, true /*capitalize*/,
338 options.features.IsEnabled(
339 Fortran::common::LanguageFeature::BackslashEscapes),
340 nullptr /* action before each statement */,
341 driver.useAnalyzedObjectsForUnparse ? &asFortran : nullptr);
342 return {};
343 }
344 if (driver.dumpPreFirTree) {
345 if (auto ast{Fortran::lower::createPFT(parseTree, semanticsContext)}) {
346 Fortran::lower::dumpPFT(llvm::outs(), *ast);
347 } else {
348 llvm::errs() << "Pre FIR Tree is NULL.\n";
349 exitStatus = EXIT_FAILURE;
350 }
351 }
352 if (driver.syntaxOnly) {
353 return {};
354 }
355
356 std::string relo{RelocatableName(driver, path)};
357
358 llvm::SmallString<32> tmpSourcePath;
359 {
360 int fd;
361 std::error_code EC =
362 llvm::sys::fs::createUniqueFile("f18-%%%%.f90", fd, tmpSourcePath);
363 if (EC) {
364 llvm::errs() << EC.message() << "\n";
365 std::exit(EXIT_FAILURE);
366 }
367 llvm::raw_fd_ostream tmpSource(fd, /*shouldClose*/ true);
368 Unparse(tmpSource, parseTree, driver.encoding, true /*capitalize*/,
369 options.features.IsEnabled(
370 Fortran::common::LanguageFeature::BackslashEscapes),
371 nullptr /* action before each statement */,
372 driver.useAnalyzedObjectsForUnparse ? &asFortran : nullptr);
373 }
374
375 RunOtherCompiler(driver, tmpSourcePath.data(), relo.data());
376 filesToDelete.emplace_back(tmpSourcePath);
377 if (!driver.compileOnly && driver.outputPath.empty()) {
378 filesToDelete.push_back(relo);
379 }
380 return relo;
381 }
382
CompileOtherLanguage(std::string path,DriverOptions & driver)383 std::string CompileOtherLanguage(std::string path, DriverOptions &driver) {
384 std::string relo{RelocatableName(driver, path)};
385 RunOtherCompiler(driver, path.data(), relo.data());
386 if (!driver.compileOnly && driver.outputPath.empty()) {
387 filesToDelete.push_back(relo);
388 }
389 return relo;
390 }
391
Link(std::vector<std::string> & liblist,std::vector<std::string> & objects,DriverOptions & driver)392 void Link(std::vector<std::string> &liblist, std::vector<std::string> &objects,
393 DriverOptions &driver) {
394 std::vector<llvm::StringRef> argv;
395 for (size_t j{0}; j < driver.F18_FCArgs.size(); ++j) {
396 argv.push_back(driver.F18_FCArgs[j].data());
397 }
398 for (auto &obj : objects) {
399 argv.push_back(obj.data());
400 }
401 if (!driver.outputPath.empty()) {
402 char dashO[3] = "-o";
403 argv.push_back(dashO);
404 argv.push_back(driver.outputPath.data());
405 }
406 for (auto &lib : liblist) {
407 argv.push_back(lib.data());
408 }
409 Exec(argv, driver.verbose);
410 }
411
printVersion()412 int printVersion() {
413 llvm::errs() << "\nf18 compiler (under development), version "
414 << FLANG_VERSION_STRING << "\n";
415 return exitStatus;
416 }
417
418 // Generate the path to look for intrinsic modules
getIntrinsicDir()419 static std::string getIntrinsicDir() {
420 // TODO: Find a system independent API
421 llvm::SmallString<128> driverPath;
422 driverPath.assign(llvm::sys::fs::getMainExecutable(nullptr, nullptr));
423 llvm::sys::path::remove_filename(driverPath);
424 driverPath.append("/../include/flang/");
425 return std::string(driverPath);
426 }
427
main(int argc,char * const argv[])428 int main(int argc, char *const argv[]) {
429
430 atexit(CleanUpAtExit);
431
432 DriverOptions driver;
433 const char *F18_FC{getenv("F18_FC")};
434 driver.F18_FCArgs.push_back(F18_FC ? F18_FC : "gfortran");
435 bool isPGF90{driver.F18_FCArgs.back().rfind("pgf90") != std::string::npos};
436
437 std::list<std::string> args{argList(argc, argv)};
438 std::vector<std::string> objlist, liblist;
439 std::string prefix{args.front()};
440 args.pop_front();
441 prefix += ": ";
442 driver.prefix = prefix.data();
443
444 Fortran::parser::Options options;
445 std::vector<Fortran::parser::Options::Predefinition> predefinitions;
446 predefinitions.emplace_back("__F18", "1");
447 predefinitions.emplace_back("__F18_MAJOR__", "1");
448 predefinitions.emplace_back("__F18_MINOR__", "1");
449 predefinitions.emplace_back("__F18_PATCHLEVEL__", "1");
450 predefinitions.emplace_back("__flang__", FLANG_VERSION_STRING);
451 predefinitions.emplace_back("__flang_major__", FLANG_VERSION_MAJOR_STRING);
452 predefinitions.emplace_back("__flang_minor__", FLANG_VERSION_MINOR_STRING);
453 predefinitions.emplace_back(
454 "__flang_patchlevel__", FLANG_VERSION_PATCHLEVEL_STRING);
455 #if __x86_64__
456 predefinitions.emplace_back("__x86_64__", "1");
457 #endif
458
459 Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;
460
461 std::vector<std::string> fortranSources, otherSources;
462 bool anyFiles{false};
463
464 // Add the default intrinsic module directory to the list of search
465 // directories
466 driver.searchDirectories.push_back(getIntrinsicDir());
467
468 while (!args.empty()) {
469 std::string arg{std::move(args.front())};
470 auto dot{arg.rfind(".")};
471 std::string suffix{arg.substr(dot + 1)};
472 std::string prefix{arg.substr(0, 2)};
473 args.pop_front();
474 if (arg.empty()) {
475 } else if (arg.at(0) != '-') {
476 anyFiles = true;
477 if (dot == std::string::npos) {
478 driver.F18_FCArgs.push_back(arg);
479 } else {
480 if (suffix == "f" || suffix == "F" || suffix == "ff" ||
481 suffix == "f90" || suffix == "F90" || suffix == "ff90" ||
482 suffix == "f95" || suffix == "F95" || suffix == "ff95" ||
483 suffix == "cuf" || suffix == "CUF" || suffix == "f18" ||
484 suffix == "F18" || suffix == "ff18") {
485 fortranSources.push_back(arg);
486 } else if (suffix == "o" || suffix == "so") {
487 objlist.push_back(arg);
488 } else if (suffix == "a") {
489 liblist.push_back(arg);
490 } else {
491 otherSources.push_back(arg);
492 }
493 }
494 } else if (prefix == "-l" || suffix == "a") {
495 liblist.push_back(arg);
496 } else if (arg == "-") {
497 fortranSources.push_back("-");
498 } else if (arg == "--") {
499 while (!args.empty()) {
500 fortranSources.emplace_back(std::move(args.front()));
501 args.pop_front();
502 }
503 break;
504 } else if (arg == "-Mfixed" || arg == "-ffixed-form") {
505 driver.forcedForm = true;
506 options.isFixedForm = true;
507 } else if (arg == "-Mfree" || arg == "-ffree-form") {
508 driver.forcedForm = true;
509 options.isFixedForm = false;
510 } else if (arg == "-Mextend" || arg == "-ffixed-line-length-132") {
511 options.fixedFormColumns = 132;
512 } else if (arg == "-Munlimited" || arg == "-ffree-line-length-none" ||
513 arg == "-ffree-line-length-0" || arg == "-ffixed-line-length-none" ||
514 arg == "-ffixed-line-length-0") {
515 // For reparsing f18's -E output of fixed-form cooked character stream
516 options.fixedFormColumns = 1000000;
517 } else if (arg == "-Mbackslash") {
518 options.features.Enable(
519 Fortran::common::LanguageFeature::BackslashEscapes, false);
520 } else if (arg == "-Mnobackslash") {
521 options.features.Enable(
522 Fortran::common::LanguageFeature::BackslashEscapes, true);
523 } else if (arg == "-Mstandard" || arg == "-std=f95" ||
524 arg == "-std=f2003" || arg == "-std=f2008" || arg == "-std=legacy" ||
525 arg == "-std=f2018" || arg == "-pedantic") {
526 driver.warnOnNonstandardUsage = true;
527 } else if (arg == "-fopenacc") {
528 options.features.Enable(Fortran::common::LanguageFeature::OpenACC);
529 predefinitions.emplace_back("_OPENACC", "202011");
530 } else if (arg == "-fopenmp") {
531 options.features.Enable(Fortran::common::LanguageFeature::OpenMP);
532 predefinitions.emplace_back("_OPENMP", "201511");
533 } else if (arg.find("-W") != std::string::npos) {
534 if (arg == "-Werror")
535 driver.warningsAreErrors = true;
536 } else if (arg == "-ed") {
537 options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines);
538 } else if (arg == "-E") {
539 driver.dumpCookedChars = true;
540 } else if (arg == "-fbackslash" || arg == "-fno-backslash") {
541 options.features.Enable(
542 Fortran::common::LanguageFeature::BackslashEscapes,
543 arg == "-fbackslash");
544 } else if (arg == "-fxor-operator" || arg == "-fno-xor-operator") {
545 options.features.Enable(Fortran::common::LanguageFeature::XOROperator,
546 arg == "-fxor-operator");
547 } else if (arg == "-flogical-abbreviations" ||
548 arg == "-fno-logical-abbreviations") {
549 options.features.Enable(
550 Fortran::parser::LanguageFeature::LogicalAbbreviations,
551 arg == "-flogical-abbreviations");
552 } else if (arg == "-fimplicit-none-type-always" ||
553 arg == "-fimplicit-none") {
554 options.features.Enable(
555 Fortran::common::LanguageFeature::ImplicitNoneTypeAlways);
556 } else if (arg == "-fno-implicit-none") {
557 options.features.Enable(
558 Fortran::common::LanguageFeature::ImplicitNoneTypeAlways, false);
559 } else if (arg == "-fimplicit-none-type-never") {
560 options.features.Enable(
561 Fortran::common::LanguageFeature::ImplicitNoneTypeNever);
562 } else if (arg == "-falternative-parameter-statement") {
563 options.features.Enable(
564 Fortran::common::LanguageFeature::OldStyleParameter, true);
565 } else if (arg == "-fdebug-dump-provenance") {
566 driver.dumpProvenance = true;
567 options.needProvenanceRangeToCharBlockMappings = true;
568 } else if (arg == "-fdebug-dump-parse-tree") {
569 driver.dumpParseTree = true;
570 driver.syntaxOnly = true;
571 } else if (arg == "-fdebug-pre-fir-tree") {
572 driver.dumpPreFirTree = true;
573 } else if (arg == "-fdebug-dump-symbols") {
574 driver.dumpSymbols = true;
575 driver.syntaxOnly = true;
576 } else if (arg == "-fdebug-module-writer") {
577 driver.debugModuleWriter = true;
578 } else if (arg == "-fdebug-measure-parse-tree") {
579 driver.measureTree = true;
580 } else if (arg == "-fdebug-instrumented-parse" ||
581 arg == "-fdebug-dump-parsing-log") {
582 options.instrumentedParse = true;
583 } else if (arg == "-fdebug-no-semantics") {
584 driver.debugNoSemantics = true;
585 } else if (arg == "-fdebug-unparse-no-sema") {
586 driver.debugNoSemantics = true;
587 driver.dumpUnparse = true;
588 } else if (arg == "-fdebug-dump-parse-tree-no-sema") {
589 driver.debugNoSemantics = true;
590 driver.dumpParseTree = true;
591 driver.syntaxOnly = true;
592 } else if (arg == "-funparse" || arg == "-fdebug-unparse") {
593 driver.dumpUnparse = true;
594 } else if (arg == "-funparse-with-symbols" ||
595 arg == "-fdebug-unparse-with-symbols") {
596 driver.dumpUnparseWithSymbols = true;
597 } else if (arg == "-fno-analyzed-objects-for-unparse") {
598 driver.useAnalyzedObjectsForUnparse = false;
599 } else if (arg == "-fparse-only" || arg == "-fsyntax-only") {
600 driver.syntaxOnly = true;
601 } else if (arg == "-c") {
602 driver.compileOnly = true;
603 } else if (arg == "-o") {
604 driver.outputPath = args.front();
605 args.pop_front();
606 } else if (arg.substr(0, 2) == "-D") {
607 auto eq{arg.find('=')};
608 if (eq == std::string::npos) {
609 predefinitions.emplace_back(arg.substr(2), "1");
610 } else {
611 predefinitions.emplace_back(arg.substr(2, eq - 2), arg.substr(eq + 1));
612 }
613 } else if (arg.substr(0, 2) == "-U") {
614 predefinitions.emplace_back(arg.substr(2), std::optional<std::string>{});
615 } else if (arg == "-r8" || arg == "-fdefault-real-8") {
616 driver.defaultReal8 = true;
617 defaultKinds.set_defaultRealKind(8);
618 defaultKinds.set_doublePrecisionKind(16);
619 } else if (arg == "-fdefault-double-8") {
620 if (!driver.defaultReal8) {
621 // -fdefault-double-8 has to be used with -fdefault-real-8
622 // to be compatible with gfortran. See:
623 // https://gcc.gnu.org/onlinedocs/gfortran/Fortran-Dialect-Options.html
624 llvm::errs()
625 << "Use of `-fdefault-double-8` requires `-fdefault-real-8`\n";
626 return EXIT_FAILURE;
627 }
628 defaultKinds.set_doublePrecisionKind(8);
629 } else if (arg == "-i8" || arg == "-fdefault-integer-8") {
630 defaultKinds.set_defaultIntegerKind(8);
631 defaultKinds.set_subscriptIntegerKind(8);
632 defaultKinds.set_sizeIntegerKind(8);
633 if (isPGF90) {
634 driver.F18_FCArgs.push_back("-i8");
635 } else {
636 driver.F18_FCArgs.push_back("-fdefault-integer-8");
637 }
638 } else if (arg == "-flarge-sizes") {
639 defaultKinds.set_sizeIntegerKind(8);
640 } else if (arg == "-fno-large-sizes") {
641 defaultKinds.set_sizeIntegerKind(4);
642 } else if (arg == "-module") {
643 driver.moduleDirectory = args.front();
644 args.pop_front();
645 } else if (arg == "-module-dir") {
646 driver.moduleDirectory = args.front();
647 driver.searchDirectories.push_back(driver.moduleDirectory);
648 args.pop_front();
649 } else if (arg == "-module-suffix") {
650 driver.moduleFileSuffix = args.front();
651 args.pop_front();
652 } else if (arg == "-intrinsic-module-directory" ||
653 arg == "-fintrinsic-modules-path") {
654 // prepend to the list of search directories
655 driver.searchDirectories.insert(
656 driver.searchDirectories.begin(), args.front());
657 args.pop_front();
658 } else if (arg == "-futf-8") {
659 driver.encoding = Fortran::parser::Encoding::UTF_8;
660 } else if (arg == "-flatin") {
661 driver.encoding = Fortran::parser::Encoding::LATIN_1;
662 } else if (arg == "-fget-definition") {
663 // Receives 3 arguments: line, startColumn, endColumn.
664 options.needProvenanceRangeToCharBlockMappings = true;
665 driver.getDefinition = true;
666 char *endptr;
667 int arguments[3];
668 for (int i = 0; i < 3; i++) {
669 if (args.empty()) {
670 llvm::errs() << "Must provide 3 arguments for -fget-definitions.\n";
671 return EXIT_FAILURE;
672 }
673 arguments[i] = std::strtol(args.front().c_str(), &endptr, 10);
674 if (*endptr != '\0') {
675 llvm::errs() << "error: invalid value '" << args.front()
676 << "' in 'fget-definition'" << '\n';
677 return EXIT_FAILURE;
678 }
679 args.pop_front();
680 }
681 driver.getDefinitionArgs = {arguments[0], arguments[1], arguments[2]};
682 } else if (arg == "-fget-symbols-sources") {
683 driver.getSymbolsSources = true;
684 } else if (arg == "-byteswapio") {
685 driver.byteswapio = true; // TODO: Pass to lowering, generate call
686 } else if (arg == "-cpp") {
687 driver.forcePreprocessing = true;
688 } else if (arg == "-nocpp") {
689 driver.forcePreprocessing = false;
690 } else if (arg == "-h" || arg == "-help" || arg == "--help" ||
691 arg == "-?") {
692 llvm::errs()
693 << "f18: LLVM Fortran compiler\n"
694 << "\n"
695 << "Usage: f18 [options] <input files>\n"
696 << "\n"
697 << "Defaults:\n"
698 << " When invoked with input files, and no options to tell\n"
699 << " it otherwise, f18 will unparse its input and pass that on to "
700 "an\n"
701 << " external compiler to continue the compilation.\n"
702 << " The external compiler is specified by the F18_FC environment\n"
703 << " variable. The default is 'gfortran'.\n"
704 << " If invoked with no input files, f18 reads source code from\n"
705 << " stdin and runs with -fdebug-measure-parse-tree -funparse.\n"
706 << "\n"
707 << "f18 options:\n"
708 << " -Mfixed | -Mfree | -ffixed-form | -ffree-form force the "
709 "source form\n"
710 << " -Mextend | -ffixed-line-length-132 132-column fixed form\n"
711 << " -f[no-]backslash enable[disable] \\escapes in literals\n"
712 << " -M[no]backslash disable[enable] \\escapes in literals\n"
713 << " -Mstandard enable conformance warnings\n"
714 << " -std=<standard> enable conformance warnings\n"
715 << " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 | "
716 "-fdefault-double-8 change default kinds of intrinsic types\n"
717 << " -Werror treat warnings as errors\n"
718 << " -ed enable fixed form D lines\n"
719 << " -E prescan & preprocess only\n"
720 << " -module dir module output directory (default .)\n"
721 << " -module-dir/-J <dir> Put MODULE files in <dir>\n"
722 << " -flatin interpret source as Latin-1 (ISO 8859-1) "
723 "rather than UTF-8\n"
724 << " -fsyntax-only parsing and semantics only, no output "
725 "except messages\n"
726 << " -funparse parse & reformat only, no code "
727 "generation\n"
728 << " -funparse-with-symbols parse, resolve symbols, and unparse\n"
729 << " -fdebug-measure-parse-tree\n"
730 << " -fdebug-dump-provenance\n"
731 << " -fdebug-dump-parse-tree\n"
732 << " -fdebug-dump-symbols\n"
733 << " -fdebug-instrumented-parse\n"
734 << " -fdebug-no-semantics disable semantic checks\n"
735 << " -fget-definition\n"
736 << " -fget-symbols-sources\n"
737 << " -v -c -o -I -D -U have their usual meanings\n"
738 << " -cpp / -nocpp force / inhibit macro replacement\n"
739 << " -help print this again\n"
740 << "Unrecognised options are passed through to the external "
741 "compiler\n"
742 << "set by F18_FC (see defaults).\n";
743 return exitStatus;
744 } else if (arg == "-V" || arg == "--version") {
745 return printVersion();
746 } else if (arg == "-fdebug-stack-trace") {
747 llvm::sys::PrintStackTraceOnErrorSignal(llvm::StringRef{}, true);
748 } else {
749 driver.F18_FCArgs.push_back(arg);
750 if (arg == "-v") {
751 if (args.size() > 1) {
752 driver.verbose = true;
753 } else {
754 return printVersion();
755 }
756 } else if (arg == "-I") {
757 driver.F18_FCArgs.push_back(args.front());
758 driver.searchDirectories.push_back(args.front());
759 args.pop_front();
760 } else if (arg.substr(0, 2) == "-I") {
761 driver.searchDirectories.push_back(arg.substr(2));
762 } else if (arg == "-J") {
763 driver.F18_FCArgs.push_back(args.front());
764 driver.moduleDirectory = args.front();
765 driver.searchDirectories.push_back(driver.moduleDirectory);
766 args.pop_front();
767 } else if (arg.substr(0, 2) == "-J") {
768 driver.moduleDirectory = arg.substr(2);
769 driver.searchDirectories.push_back(driver.moduleDirectory);
770 }
771 }
772 }
773
774 if (driver.warnOnNonstandardUsage) {
775 options.features.WarnOnAllNonstandard();
776 }
777 if (isPGF90) {
778 if (!options.features.IsEnabled(
779 Fortran::common::LanguageFeature::BackslashEscapes)) {
780 driver.F18_FCArgs.push_back(
781 "-Mbackslash"); // yes, this *disables* them in pgf90
782 }
783 if (options.features.IsEnabled(Fortran::common::LanguageFeature::OpenMP)) {
784 driver.F18_FCArgs.push_back("-mp");
785 }
786
787 Fortran::parser::useHexadecimalEscapeSequences = false;
788 } else {
789 if (options.features.IsEnabled(
790 Fortran::common::LanguageFeature::BackslashEscapes)) {
791 driver.F18_FCArgs.push_back("-fbackslash");
792 }
793 if (options.features.IsEnabled(Fortran::common::LanguageFeature::OpenMP)) {
794 driver.F18_FCArgs.push_back("-fopenmp");
795 }
796
797 Fortran::parser::useHexadecimalEscapeSequences = true;
798 }
799
800 if (!anyFiles) {
801 driver.measureTree = true;
802 driver.dumpUnparse = true;
803 llvm::outs() << "Enter Fortran source\n"
804 << "Use EOF character (^D) to end file\n";
805 CompileFortran("-", options, driver, defaultKinds);
806 return exitStatus;
807 }
808 for (const auto &path : fortranSources) {
809 options.predefinitions.clear();
810 if (driver.forcePreprocessing) {
811 if (*driver.forcePreprocessing) {
812 options.predefinitions = predefinitions;
813 }
814 } else {
815 auto dot{path.rfind(".")};
816 if (dot != std::string::npos) {
817 std::string suffix{path.substr(dot + 1)};
818 if (suffix == "F" || suffix == "F90" || suffix == "F95" ||
819 suffix == "CUF" || suffix == "F18") {
820 options.predefinitions = predefinitions;
821 }
822 }
823 }
824 std::string relo{CompileFortran(path, options, driver, defaultKinds)};
825 if (!driver.compileOnly && !relo.empty()) {
826 objlist.push_back(relo);
827 }
828 }
829 for (const auto &path : otherSources) {
830 std::string relo{CompileOtherLanguage(path, driver)};
831 if (!driver.compileOnly && !relo.empty()) {
832 objlist.push_back(relo);
833 }
834 }
835 if (!driver.compileOnly && !objlist.empty()) {
836 Link(liblist, objlist, driver);
837 }
838 return exitStatus;
839 }
840