gcc/m2/gm2-compiler/M2Comp.mod

   1 (* M2Comp.mod continually calls the compiler for every source file.
   2
   3 Copyright (C) 2001-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  *)
  21
  22 IMPLEMENTATION MODULE M2Comp ;
  23
  24
  25 FROM M2Pass IMPORT SetPassToPass0, SetPassToPass1, SetPassToPass2, SetPassToPassC,
  26                    SetPassToPass3, SetPassToNoPass, SetPassToPassHidden ;
  27
  28 FROM M2Reserved IMPORT toktype ;
  29 FROM M2Search IMPORT FindSourceDefFile, FindSourceModFile ;
  30 FROM M2Code IMPORT Code ;
  31
  32 FROM M2LexBuf IMPORT OpenSource, CloseSource, ResetForNewPass, currenttoken, GetToken,
  33                      ReInitialize, currentstring, GetTokenNo ;
  34
  35 FROM M2FileName IMPORT CalculateFileName ;
  36 FROM M2Preprocess IMPORT PreprocessModule, MakeSaveTempsFileNameExt, OnExitDelete ;
  37 FROM libc IMPORT exit ;
  38
  39 FROM M2Error IMPORT ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
  40                     WriteFormat0, FlushErrors, FlushWarnings, ResetErrorScope ;
  41
  42 FROM M2MetaError IMPORT MetaErrorString0, MetaErrorString1, MetaError0, MetaError1,
  43                         MetaString0 ;
  44
  45 FROM FormatStrings IMPORT Sprintf1 ;
  46 FROM P0SymBuild IMPORT P0Init, P1Init ;
  47 FROM M2Debug IMPORT Assert ;
  48
  49 IMPORT m2flex ;
  50 IMPORT P0SyntaxCheck ;
  51 IMPORT P1Build ;
  52 IMPORT P2Build ;
  53 IMPORT PCBuild ;
  54 IMPORT P3Build ;
  55 IMPORT PHBuild ;
  56 IMPORT PCSymBuild ;
  57 IMPORT DynamicStrings ;
  58
  59 FROM M2Batch IMPORT GetSource, GetModuleNo, GetDefinitionModuleFile, GetModuleFile,
  60                     AssociateModule, AssociateDefinition, MakeImplementationSource,
  61                     MakeProgramSource ;
  62
  63 FROM SymbolTable IMPORT GetSymName, IsDefImp, NulSym,
  64                         IsHiddenTypeDeclared, GetFirstUsed, GetMainModule, SetMainModule,
  65                         ResolveConstructorTypes, SanityCheckConstants, IsDefinitionForC,
  66                         IsBuiltinInModule, PutModLink, IsDefLink, IsModLink, PutLibName,
  67                         GetModuleDefImportStatementList, GetModuleModImportStatementList,
  68                         GetImportModule, IsImportStatement, IsImport,
  69                         GetImportStatementList ;
  70
  71 FROM M2Search IMPORT FindSourceDefFile ;
  72
  73 FROM FIO IMPORT File, StdErr, StdOut, Close, EOF, IsNoError, WriteLine,
  74                 WriteChar, FlushOutErr ;
  75
  76 FROM SFIO IMPORT WriteS, OpenToRead, OpenToWrite, ReadS, WriteS ;
  77 FROM NameKey IMPORT Name, GetKey, KeyToCharStar, makekey ;
  78 FROM M2Printf IMPORT fprintf0, fprintf1 ;
  79 FROM M2Quiet IMPORT qprintf0, qprintf1, qprintf2 ;
  80
  81 FROM M2Options IMPORT Verbose, GetM2Prefix, GetM, GetMM, GetDepTarget, GetMF, GetMP,
  82                       GetObj, PPonly, Statistics, Quiet, WholeProgram, GetMD, GetMMD,
  83                       ExtendedOpaque, GenModuleList ;
  84
  85 FROM PathName IMPORT DumpPathName ;
  86 FROM Lists IMPORT List, NoOfItemsInList, GetItemFromList ;
  87 FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice, HighIndice ;
  88
  89 FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar,
  90                            Dup, Mark, EqualArray, string, Length, ConCat, ConCatChar,
  91                            InitStringChar, RIndex, Slice, Equal, RemoveWhitePrefix ;
  92
  93
  94 CONST
  95    Debugging = FALSE ;
  96
  97 VAR
  98    ModuleType : (None, Definition, Implementation, Program) ;
  99    DepContent : Index ;
 100    DepOutput  : String ;
 101
 102
 103 (*
 104    CompilingDefinitionModule - returns true if the current module being
 105                                compiled is a definition module.
 106 *)
 107
 108 PROCEDURE CompilingDefinitionModule() : BOOLEAN ;
 109 BEGIN
 110    RETURN( ModuleType=Definition )
 111 END CompilingDefinitionModule ;
 112
 113
 114 (*
 115    CompilingImplementationModule - returns true if the current module being
 116                                    compiled is an implementation module.
 117 *)
 118
 119 PROCEDURE CompilingImplementationModule() : BOOLEAN ;
 120 BEGIN
 121    RETURN( ModuleType=Implementation )
 122 END CompilingImplementationModule ;
 123
 124
 125 (*
 126    CompilingProgramModule - returns true if the current module being
 127                             compiled is a program module.
 128 *)
 129
 130 PROCEDURE CompilingProgramModule() : BOOLEAN ;
 131 BEGIN
 132    RETURN( ModuleType=Program )
 133 END CompilingProgramModule ;
 134
 135
 136 (*
 137    NeedToParseImplementation -
 138 *)
 139
 140 PROCEDURE NeedToParseImplementation (sym: CARDINAL) : BOOLEAN ;
 141 BEGIN
 142    RETURN (IsDefImp(sym) AND IsHiddenTypeDeclared(sym) AND ExtendedOpaque) OR
 143           (IsDefImp(sym) AND IsBuiltinInModule(sym)) OR
 144           (WholeProgram AND (NOT IsDefinitionForC(sym)))
 145 END NeedToParseImplementation ;
 146
 147
 148 (*
 149    GenerateDefDependency - generate a single dependency for the definition module
 150                            providing that it can be found and is not blocked by -MM.
 151 *)
 152
 153 PROCEDURE GenerateDefDependency (module: CARDINAL) ;
 154 VAR
 155    stem,
 156    fullpath,
 157    named   : String ;
 158 BEGIN
 159    stem := InitStringCharStar (KeyToCharStar (GetSymName (module))) ;
 160    named := NIL ;
 161    IF FindSourceDefFile (stem, fullpath, named)
 162    THEN
 163       IF EqualArray (named, '') OR (NOT GetMM ())
 164       THEN
 165          MergeDep (DepContent, fullpath)
 166       ELSE
 167          fullpath := KillString (fullpath)
 168       END
 169    END ;
 170    stem := KillString (stem) ;
 171    named := KillString (named)
 172 END GenerateDefDependency ;
 173
 174
 175 (*
 176    GenerateDependenciesFromImport - lookup the module associated with the import
 177                                     and call GenerateDefDependency.
 178 *)
 179
 180 PROCEDURE GenerateDependenciesFromImport (import: CARDINAL) ;
 181 VAR
 182    module  : CARDINAL ;
 183 BEGIN
 184    Assert (IsImport (import)) ;
 185    module := GetImportModule (import) ;
 186    GenerateDefDependency (module)
 187 END GenerateDependenciesFromImport ;
 188
 189
 190 (*
 191    GenerateDependenciesFromList - iterative over the import lists and for
 192                                   each module issue a dependency.
 193 *)
 194
 195 PROCEDURE GenerateDependenciesFromList (dep: List) ;
 196 VAR
 197    importList: List ;
 198    import    : CARDINAL ;
 199    i, n, j, m: CARDINAL ;
 200 BEGIN
 201    n := NoOfItemsInList (dep) ;
 202    i := 1 ;
 203    WHILE i <= n DO
 204       import := GetItemFromList (dep, i) ;
 205       IF IsImportStatement (import)
 206       THEN
 207          importList := GetImportStatementList (import) ;
 208          j := 1 ;
 209          m := NoOfItemsInList (importList) ;
 210          WHILE j <= m DO
 211             import := GetItemFromList (importList, j) ;
 212             GenerateDependenciesFromImport (import) ;
 213             INC (j)
 214          END
 215       ELSE
 216          GenerateDependenciesFromImport (import)
 217       END ;
 218       INC (i)
 219    END
 220 END GenerateDependenciesFromList ;
 221
 222
 223 (*
 224    GenerateDependencies - generate a list of dependencies for the main module where
 225                           the source code is found in sourcefile.
 226 *)
 227
 228 PROCEDURE GenerateDependencies (sourcefile: String) ;
 229 BEGIN
 230    IF IsDefImp (GetMainModule ())
 231    THEN
 232       GenerateDependenciesFromList (GetModuleDefImportStatementList (GetMainModule ())) ;
 233       GenerateDefDependency (GetMainModule ())
 234    END ;
 235    GenerateDependenciesFromList (GetModuleModImportStatementList (GetMainModule ())) ;
 236    WriteDepContents (DepOutput, DepContent)
 237 END GenerateDependencies ;
 238
 239
 240 (*
 241    Compile - compile file, s, using a 5 pass technique.
 242 *)
 243
 244 PROCEDURE Compile (s: String) ;
 245 BEGIN
 246    DoPass0 (s) ;
 247    FlushWarnings ; FlushErrors ;
 248    ResetForNewPass ; ResetErrorScope ;
 249    qprintf0('Pass 1: scopes, enumerated types, imports and exports\n') ;
 250    DoPass1 ;
 251    FlushWarnings ; FlushErrors ;
 252    IF GetM () OR GetMM ()
 253    THEN
 254       GenerateDependencies (s)
 255    END ;
 256    IF NOT PPonly
 257    THEN
 258       qprintf0('Pass 2: constants and types\n') ;
 259       ResetForNewPass ; ResetErrorScope ;
 260       DoPass2 ;
 261       FlushWarnings ; FlushErrors ;
 262       qprintf0('Pass C: aggregate constants\n') ;
 263       ResetForNewPass ; ResetErrorScope ;
 264       DoPassC ;
 265       FlushWarnings ; FlushErrors ;
 266       qprintf0('Pass 3: quadruple generation\n') ;
 267       ResetForNewPass ; ResetErrorScope ;
 268       DoPass3 ;
 269       FlushWarnings ; FlushErrors ;
 270       qprintf0('Pass 4: gcc tree generation\n') ;
 271       Code ;
 272       FlushWarnings ; FlushErrors
 273    END
 274 END Compile ;
 275
 276
 277 (*
 278    compile - compile the filename.
 279 *)
 280
 281 PROCEDURE compile (filename: ADDRESS) ;
 282 VAR
 283    f: String ;
 284 BEGIN
 285    f := InitStringCharStar (filename) ;
 286    Compile (f) ;
 287    f := KillString (f)
 288 END compile ;
 289
 290
 291 (*
 292    ExamineCompilationUnit - opens the source file to obtain the module name and kind of module.
 293 *)
 294
 295 PROCEDURE ExamineCompilationUnit (VAR name: ADDRESS; VAR isdefimp: BOOLEAN) ;
 296 VAR
 297    Message: String ;
 298 BEGIN
 299    isdefimp := FALSE ;   (* default to program module *)
 300    (* stop if we see eof, ';' or '[' *)
 301    WHILE (currenttoken#eoftok) AND (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
 302       IF (currenttoken=implementationtok) OR (currenttoken=definitiontok)
 303       THEN
 304          isdefimp := TRUE ;
 305          GetToken
 306       END ;
 307       IF currenttoken=identtok
 308       THEN
 309          name := currentstring ;
 310          RETURN
 311       END ;
 312       GetToken
 313    END ;
 314    Message := MetaString0 (InitString ('no {%kMODULE} name found')) ;
 315    m2flex.M2Error (string (Message)) ;
 316    exit (1)
 317 END ExamineCompilationUnit ;
 318
 319
 320 (*
 321    PeepInto - peeps into source, s, and initializes a definition/implementation or
 322               program module accordingly.
 323 *)
 324
 325 PROCEDURE PeepInto (s: String) ;
 326 VAR
 327    name    : ADDRESS ;
 328    isdefimp: BOOLEAN ;
 329 BEGIN
 330    IF OpenSource (s)
 331    THEN
 332       ExamineCompilationUnit (name, isdefimp) ;
 333       IF isdefimp
 334       THEN
 335          SetMainModule (MakeImplementationSource (GetTokenNo (), makekey (name)))
 336       ELSE
 337          SetMainModule (MakeProgramSource (GetTokenNo (), makekey (name)))
 338       END ;
 339       CloseSource ;
 340       ReInitialize
 341    ELSE
 342       fprintf1 (StdErr, 'failed to open %s\n', s) ;
 343       exit (1)
 344    END
 345 END PeepInto ;
 346
 347
 348 (*
 349    qprintLibName - print the libname.
 350 *)
 351
 352 PROCEDURE qprintLibName (LibName: String) ;
 353 BEGIN
 354    IF (LibName # NIL) AND (NOT EqualArray (LibName, ''))
 355    THEN
 356       qprintf1 (' [%s]', LibName)
 357    END
 358 END qprintLibName ;
 359
 360
 361 (*
 362    CreateFileStem - create a stem using the template LibName_ModuleName.
 363 *)
 364
 365 PROCEDURE CreateFileStem (SymName, LibName: String) : String ;
 366 BEGIN
 367    IF Length (LibName) > 0
 368    THEN
 369       RETURN ConCat (Dup (LibName), ConCat (InitStringChar ('_'), SymName))
 370    ELSE
 371       RETURN SymName
 372    END
 373 END CreateFileStem ;
 374
 375
 376 (*
 377    Return basename of path.  CutExt determines whether the .extension
 378    should be removed.
 379 *)
 380
 381 PROCEDURE BaseName (Path: String; CutExt: BOOLEAN) : String ;
 382 VAR
 383    ext,
 384    basename: INTEGER ;
 385 BEGIN
 386    basename := RIndex (Path, '/', 0) ;
 387    IF basename = -1
 388    THEN
 389       basename := 0
 390    ELSE
 391       basename := basename + 1
 392    END ;
 393    IF CutExt
 394    THEN
 395       ext := RIndex (Path, '.', 0) ;
 396       IF ext=-1
 397       THEN
 398          ext := 0
 399       END
 400    ELSE
 401       ext := 0
 402    END ;
 403    RETURN Slice (Path, basename, ext)
 404 END BaseName ;
 405
 406
 407 (*
 408    IsLibrary - return TRUE if line contains a library module.
 409 *)
 410
 411 PROCEDURE IsLibrary (line: String) : BOOLEAN ;
 412 VAR
 413    moduleName,
 414    libname, filename: String ;
 415    result           : BOOLEAN ;
 416 BEGIN
 417    result := FALSE ;
 418    moduleName := BaseName (line, TRUE) ;
 419    filename := NIL ;
 420    libname := NIL ;
 421    IF FindSourceDefFile (moduleName, filename, libname)
 422    THEN
 423       moduleName := KillString (moduleName) ;
 424       IF Length (libname) > 0
 425       THEN
 426          moduleName := BaseName (line, FALSE) ;
 427          line := BaseName (line, FALSE) ;
 428          result := Equal (line, moduleName) ;
 429          line := KillString (line) ;
 430       END
 431    END ;
 432    libname := KillString (libname) ;
 433    filename := KillString (filename) ;
 434    moduleName := KillString (moduleName) ;
 435    RETURN result
 436 END IsLibrary ;
 437
 438
 439 (*
 440    IsUnique - return TRUE if line is unique in array content.
 441 *)
 442
 443 PROCEDURE IsUnique (content: Index; line: String) : BOOLEAN ;
 444 VAR
 445    high, i: CARDINAL ;
 446 BEGIN
 447    high := HighIndice (content) ;
 448    i := 1 ;
 449    WHILE i <= high DO
 450       IF Equal (line, GetIndice (content, i))
 451       THEN
 452          RETURN FALSE
 453       END ;
 454       INC (i)
 455    END ;
 456    RETURN TRUE
 457 END IsUnique ;
 458
 459
 460 (*
 461    Append - append line to array content.
 462 *)
 463
 464 PROCEDURE Append (content: Index; line: String) ;
 465 VAR
 466    high: CARDINAL ;
 467 BEGIN
 468    high := HighIndice (content) ;
 469    PutIndice (content, high+1, line)
 470 END Append ;
 471
 472
 473 (*
 474    MergeDep - if line is unique in array content then append.
 475               Check to see (and ignore) if line is a library module and -MM
 476               is present.
 477 *)
 478
 479 PROCEDURE MergeDep (content: Index; line: String) ;
 480 BEGIN
 481    line := RemoveWhitePrefix (line) ;
 482    IF (NOT EqualArray (line, "\")) AND (Length (line) > 0)
 483    THEN
 484       (* Ignore if -MM and is a library module.  *)
 485       IF NOT (GetMM () AND IsLibrary (line))
 486       THEN
 487          IF IsUnique (content, line)
 488          THEN
 489             Append (content, line)
 490          END
 491       END
 492    END
 493 END MergeDep ;
 494
 495
 496 (*
 497    splitLine - split a line into words separated by spaces
 498                and call MergeDep on each word.
 499 *)
 500
 501 PROCEDURE splitLine (content: Index; line: String) ;
 502 VAR
 503    word : String ;
 504    space: INTEGER ;
 505 BEGIN
 506    REPEAT
 507       line := RemoveWhitePrefix (line) ;
 508       space := DynamicStrings.Index (line, ' ', 0) ;
 509       IF space > 0
 510       THEN
 511          word := Slice (line, 0, space) ;
 512          word := RemoveWhitePrefix (word) ;
 513          IF Length (word) > 0
 514          THEN
 515             MergeDep (content, word)
 516          END ;
 517          line := Slice (line, space, 0) ;
 518       ELSIF space < 0
 519       THEN
 520          MergeDep (content, line)
 521       END
 522    UNTIL space <= 0
 523 END splitLine ;
 524
 525
 526 (*
 527    MergeDeps - foreach dependency in ChildDep do
 528                   add dependency to ChildDep if not already present.
 529                ignore all ChildDep if -MM and libname # "".
 530 *)
 531
 532 PROCEDURE MergeDeps (content: Index; ChildDep, LibName: String) ;
 533 VAR
 534    line: String ;
 535    in  : File ;
 536 BEGIN
 537    IF (content # NIL) AND (NOT (GetMM () AND (Length (LibName) > 0)))
 538    THEN
 539       in := OpenToRead (ChildDep) ;
 540       IF IsNoError (in)
 541       THEN
 542          line := ReadS (in) ;  (* Skip over first line containing the module object.  *)
 543          WHILE NOT EOF (in) DO
 544             line := ReadS (in) ;
 545             splitLine (content, line)
 546          END
 547       END ;
 548       Close (in)
 549    END
 550 END MergeDeps ;
 551
 552
 553 (*
 554    GetRuleTarget - return the rule target which is derived from the -MT arg
 555                    or -o arg or filename.mod.
 556 *)
 557
 558 PROCEDURE GetRuleTarget (filename: String) : String ;
 559 BEGIN
 560    IF GetDepTarget () # NIL
 561    THEN
 562       RETURN InitStringCharStar (GetDepTarget ())
 563    ELSIF GetMF () # NIL
 564    THEN
 565       RETURN InitStringCharStar (GetMF ())
 566    ELSE
 567       RETURN ConCat (BaseName (filename, TRUE), InitString ('.o'))
 568    END
 569 END GetRuleTarget ;
 570
 571
 572 (*
 573    ReadDepContents - reads the contents of file dep into a dynamic array
 574                      and return the array.  The file will be split into words
 575                      and each word stored as an entry in the array.
 576 *)
 577
 578 PROCEDURE ReadDepContents (filename, dep: String) : Index ;
 579 VAR
 580    content: Index ;
 581    line   : String ;
 582    in     : File ;
 583 BEGIN
 584    content := NIL ;
 585    IF GetM () OR GetMM ()
 586    THEN
 587       in := OpenToRead (dep) ;
 588       (* The file might not be created (if -MD or -MMD is used as these options
 589          operate without preprocessing) in which case we create an dynamic
 590          array with the source filename and target.  *)
 591       content := InitIndex (1) ;
 592       IF GetMD () OR GetMMD () OR (NOT IsNoError (in))
 593       THEN
 594          (* No preprocessing done therefore create first two lines using
 595             target and source.  *)
 596          PutIndice (content, 1, ConCatChar (GetRuleTarget (filename), ':')) ;
 597          PutIndice (content, 2, Dup (filename))
 598       ELSE
 599          (* Preprocessing (using cc1) has created one for us, so we read it.  *)
 600          WHILE NOT EOF (in) DO
 601             line := ReadS (in) ;
 602             splitLine (content, line)
 603          END
 604       END ;
 605       Close (in)
 606    END ;
 607    RETURN content
 608 END ReadDepContents ;
 609
 610
 611 (*
 612    WriteDep - write the dependencies and target to file out.
 613 *)
 614
 615 PROCEDURE WriteDep (dep: String; contents: Index; out: File) ;
 616 VAR
 617    i, h: CARDINAL ;
 618    line: String ;
 619 BEGIN
 620    i := 1 ;
 621    h := HighIndice (contents) ;
 622    WHILE i <= h DO
 623       line := GetIndice (contents, i) ;
 624       line := RemoveWhitePrefix (line) ;
 625       IF Length (line) > 0
 626       THEN
 627          IF i = 1
 628          THEN
 629             (* First line is always the target.  *)
 630             IF GetDepTarget () # NIL
 631             THEN
 632                line := ConCatChar (InitStringCharStar (GetDepTarget ()), ':')
 633             END
 634          ELSIF i > 1
 635          THEN
 636             WriteChar (out, ' ')
 637          END ;
 638          line := WriteS (out, line) ;
 639          IF i < h
 640          THEN
 641             WriteChar (out, ' ') ;
 642             WriteChar (out, '\')
 643          END ;
 644          WriteLine (out)
 645       END ;
 646       INC (i)
 647    END
 648 END WriteDep ;
 649
 650
 651 (*
 652    WritePhonyDep - write the dependencies and target to file out.
 653 *)
 654
 655 PROCEDURE WritePhonyDep (dep: String; contents: Index; out: File) ;
 656 VAR
 657    i, h: CARDINAL ;
 658    line: String ;
 659 BEGIN
 660    (* The first line is always the target and the second line is always
 661       the top level source file.  *)
 662    i := 3 ;
 663    h := HighIndice (contents) ;
 664    WHILE i <= h DO
 665       line := GetIndice (contents, i) ;
 666       line := RemoveWhitePrefix (line) ;
 667       IF Length (line) > 0
 668       THEN
 669          line := WriteS (out, line) ;
 670          WriteChar (out, ':') ;
 671          WriteLine (out)
 672       END ;
 673       INC (i)
 674    END
 675 END WritePhonyDep ;
 676
 677
 678 (*
 679    WriteDepContents - write the dynamic array to filename dep (or StdOut) if
 680                       the GetMF file is NIL.
 681 *)
 682
 683 PROCEDURE WriteDepContents (dep: String; contents: Index) ;
 684 VAR
 685    out: File ;
 686 BEGIN
 687    IF (contents # NIL) AND (GetM () OR GetMM ())
 688    THEN
 689       IF GetMF () = NIL
 690       THEN
 691          out := StdOut ;
 692          dep := OnExitDelete (dep)
 693       ELSE
 694          out := OpenToWrite (dep)
 695       END ;
 696       IF IsNoError (out)
 697       THEN
 698          WriteDep (dep, contents, out) ;
 699          IF GetMP ()
 700          THEN
 701             WritePhonyDep (dep, contents, out)
 702          END
 703       END ;
 704       IF GetMF () = NIL
 705       THEN
 706          FlushOutErr
 707       ELSE
 708          Close (out) ;
 709       END ;
 710       contents := KillIndex (contents)
 711    END
 712 END WriteDepContents ;
 713
 714
 715 (*
 716    CreateDepFilename - return a dependency filename associated with filename or use GetMF.
 717 *)
 718
 719 PROCEDURE CreateDepFilename (filename: String) : String ;
 720 VAR
 721    depfile: String ;
 722 BEGIN
 723    IF GetMF () = NIL
 724    THEN
 725       depfile := MakeSaveTempsFileNameExt (filename, InitString ('.d')) ;
 726       RETURN OnExitDelete (depfile)
 727    ELSE
 728       RETURN InitStringCharStar (GetMF ())
 729    END
 730 END CreateDepFilename ;
 731
 732
 733 (*
 734    Pass0CheckDef -
 735 *)
 736
 737 PROCEDURE Pass0CheckDef (sym: CARDINAL) : BOOLEAN ;
 738 VAR
 739    ChildDep,
 740    SymName,
 741    FileName,
 742    LibName : String ;
 743 BEGIN
 744    LibName := NIL ;
 745    FileName := NIL ;
 746    SymName := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
 747    IF IsDefImp (sym)
 748    THEN
 749       IF FindSourceDefFile (SymName, FileName, LibName)
 750       THEN
 751          ModuleType := Definition ;
 752          ChildDep := MakeSaveTempsFileNameExt (CreateFileStem (SymName, LibName), InitString ('.def.d')) ;
 753          IF OpenSource (AssociateDefinition (PreprocessModule (FileName, FALSE, TRUE,
 754                                                                ChildDep), sym))
 755          THEN
 756             IF NOT P0SyntaxCheck.CompilationUnit ()
 757             THEN
 758                WriteFormat0 ('compilation failed') ;
 759                CloseSource ;
 760                SymName := KillString (SymName) ;
 761                FileName := KillString (FileName) ;
 762                LibName := KillString (LibName) ;
 763                RETURN FALSE
 764             END ;
 765             qprintf2 ('   Module %-20s : %s', SymName, FileName) ;
 766             qprintLibName (LibName) ;
 767             PutLibName (sym, makekey (string (LibName))) ;
 768             IF IsDefinitionForC (sym)
 769             THEN
 770                qprintf0 (' (for C)')
 771             END ;
 772             IF IsDefLink (sym)
 773             THEN
 774                qprintf0 (' (linking)')
 775             END ;
 776             qprintf0 ('\n') ;
 777             CloseSource ;
 778             MergeDeps (DepContent, ChildDep, LibName)
 779          ELSE
 780             (* Unrecoverable error.  *)
 781             MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
 782                                         FileName), sym)
 783          END
 784       ELSE
 785          (* Unrecoverable error.  *)
 786          MetaError1 ('the file containing the definition module {%1EMAa} cannot be found', sym)
 787       END ;
 788       ModuleType := Implementation
 789    ELSE
 790       ModuleType := Program
 791    END ;
 792    SymName := KillString (SymName) ;
 793    FileName := KillString (FileName) ;
 794    LibName := KillString (LibName) ;
 795    RETURN TRUE
 796 END Pass0CheckDef ;
 797
 798
 799 (*
 800    Pass0CheckMod -
 801 *)
 802
 803 PROCEDURE Pass0CheckMod (sym: CARDINAL; PPSource: String) : BOOLEAN ;
 804 VAR
 805    Main    : CARDINAL ;
 806    ChildDep,
 807    SymName,
 808    FileName,
 809    LibName : String ;
 810 BEGIN
 811    SymName := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
 812    FileName := NIL ;
 813    LibName := NIL ;
 814    Main := GetMainModule () ;
 815    IF (Main = sym) OR NeedToParseImplementation (sym)
 816    THEN
 817       (* Only need to read implementation module if hidden types are
 818          declared or it is the main module.  *)
 819       IF Main = sym
 820       THEN
 821          FileName := Dup (PPSource) ;
 822          LibName := InitStringCharStar (GetM2Prefix ()) ;
 823          PutLibName (sym, makekey (string (LibName)))
 824       ELSE
 825          IF FindSourceModFile (SymName, FileName, LibName)
 826          THEN
 827             ChildDep := MakeSaveTempsFileNameExt (CreateFileStem (SymName, LibName), InitString ('.mod.d')) ;
 828             FileName := PreprocessModule (FileName, FALSE, TRUE, ChildDep) ;
 829             PutLibName (sym, makekey (string (LibName))) ;
 830             MergeDeps (DepContent, ChildDep, LibName)
 831          ELSE
 832             qprintf1 ('   Module %-20s : implementation source file not found\n', SymName)
 833          END
 834       END ;
 835
 836       IF FileName # NIL
 837       THEN
 838          IF OpenSource (AssociateModule (Dup (FileName), sym))
 839          THEN
 840             IF NOT P0SyntaxCheck.CompilationUnit ()
 841             THEN
 842                WriteFormat0 ('compilation failed') ;
 843                CloseSource ;
 844                SymName := KillString (SymName) ;
 845                FileName := KillString (FileName) ;
 846                LibName := KillString (LibName) ;
 847                RETURN FALSE
 848             END ;
 849             qprintf2 ('   Module %-20s : %s', SymName, FileName) ;
 850             qprintLibName (LibName) ;
 851             IF IsModLink (sym)
 852             THEN
 853                qprintf0 (' (linking)')
 854             END ;
 855             qprintf0 ('\n') ;
 856             CloseSource
 857          ELSE
 858             (* It is quite legitimate to implement a module in C (and pretend it was a M2
 859                implementation) providing that it is not the main program module and the
 860                definition module does not declare a hidden type when -fextended-opaque
 861                is used.  *)
 862             IF (NOT WholeProgram) OR (sym = Main) OR IsHiddenTypeDeclared (sym)
 863             THEN
 864                (* Unrecoverable error.  *)
 865                MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
 866                                            FileName), sym) ;
 867             END
 868          END
 869       END
 870    ELSIF GenModuleList
 871    THEN
 872       IF NOT IsDefinitionForC (sym)
 873       THEN
 874          (* The implementation module is only useful if -fgen-module-list= is
 875             used (to gather all dependencies) although we do not insist upon finding the
 876             implementation module.  *)
 877          LibName := NIL ;
 878          IF FindSourceModFile (SymName, FileName, LibName)
 879          THEN
 880             PutLibName (sym, makekey (string (LibName))) ;
 881             qprintf2 ('   Module %-20s : %s' , SymName, FileName) ;
 882             qprintLibName (LibName) ;
 883             qprintf0 (' (linking)\n') ;
 884             ChildDep := MakeSaveTempsFileNameExt (CreateFileStem (SymName, LibName), InitString ('.mod.d')) ;
 885             IF OpenSource (AssociateModule (PreprocessModule (FileName, FALSE, TRUE, ChildDep), sym))
 886             THEN
 887                PutModLink (sym, TRUE) ;   (* This source is only used to determine link time info.  *)
 888                IF NOT P0SyntaxCheck.CompilationUnit ()
 889                THEN
 890                   WriteFormat0 ('compilation failed') ;
 891                   CloseSource ;
 892                   SymName := KillString (SymName) ;
 893                   FileName := KillString (FileName) ;
 894                   LibName := KillString (LibName) ;
 895                   RETURN FALSE
 896                END ;
 897                CloseSource ;
 898                MergeDeps (DepContent, ChildDep, LibName)
 899             END
 900          END
 901       END
 902    END ;
 903    SymName := KillString (SymName) ;
 904    FileName := KillString (FileName) ;
 905    LibName := KillString (LibName) ;
 906    RETURN TRUE
 907 END Pass0CheckMod ;
 908
 909
 910 (*
 911    DoPass0 -
 912 *)
 913
 914 PROCEDURE DoPass0 (filename: String) ;
 915 VAR
 916    sym       : CARDINAL ;
 917    i         : CARDINAL ;
 918    PPSource  : String ;
 919 BEGIN
 920    P0Init ;
 921    SetPassToPass0 ;
 922    (* Maybe preprocess the main file.  *)
 923    DepOutput := CreateDepFilename (filename) ;
 924    PPSource := PreprocessModule (filename, TRUE, FALSE, DepOutput) ;
 925    DepContent := ReadDepContents (filename, DepOutput) ;
 926    PeepInto (PPSource) ;
 927    i := 1 ;
 928    sym := GetModuleNo (i) ;
 929    qprintf1 ('Compiling: %s\n', PPSource) ;
 930    IF Debugging
 931    THEN
 932       DumpPathName ('DoPass0')
 933    END ;
 934    IF Verbose
 935    THEN
 936       fprintf1 (StdOut, 'Compiling: %s\n', PPSource)
 937    END ;
 938    qprintf0 ('Pass 0: lexical analysis, parsing, modules and associated filenames\n') ;
 939    WHILE sym # NulSym DO
 940       IF NOT Pass0CheckDef (sym)
 941       THEN
 942          RETURN
 943       END ;
 944       IF NOT Pass0CheckMod (sym, PPSource)
 945       THEN
 946          RETURN
 947       END ;
 948       INC (i) ;
 949       sym := GetModuleNo (i)
 950    END ;
 951    SetPassToNoPass
 952 END DoPass0 ;
 953
 954
 955 (*
 956    DoPass1 - parses the sources of all modules necessary to compile
 957              the required module, Main.
 958 *)
 959
 960 PROCEDURE DoPass1 ;
 961 VAR
 962    name    : Name ;
 963    Sym     : CARDINAL ;
 964    i       : CARDINAL ;
 965    FileName: String ;
 966 BEGIN
 967    P1Init ;
 968    SetPassToPass1 ;
 969    i := 1 ;
 970    Sym := GetModuleNo(i) ;
 971    WHILE Sym#NulSym DO
 972       FileName := GetDefinitionModuleFile(Sym) ;
 973       IF FileName#NIL
 974       THEN
 975          IF Debugging
 976          THEN
 977             name := GetSymName(Sym) ;
 978             qprintf1('   Module %a\n', name)
 979          END ;
 980          IF OpenSource(FileName)
 981          THEN
 982             ModuleType := Definition ;
 983             IF NOT P1Build.CompilationUnit()
 984             THEN
 985                MetaError0('compilation failed') ;
 986                CloseSource ;
 987                RETURN
 988             END ;
 989             CloseSource
 990          ELSE
 991             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
 992             exit(1)
 993          END ;
 994          ModuleType := Implementation
 995       ELSE
 996          ModuleType := Program
 997       END ;
 998       FileName := GetModuleFile(Sym) ;
 999       IF FileName#NIL
1000       THEN
1001          IF Debugging
1002          THEN
1003             name := GetSymName(Sym) ;
1004             qprintf1('   Module %a\n', name)
1005          END ;
1006          IF OpenSource(FileName)
1007          THEN
1008             IF NOT P1Build.CompilationUnit()
1009             THEN
1010                MetaError0('compilation failed') ;
1011                CloseSource ;
1012                RETURN
1013             END ;
1014             CloseSource
1015          ELSE
1016             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1017             exit(1)
1018          END
1019       END ;
1020       INC(i) ;
1021       Sym := GetModuleNo(i)
1022    END ;
1023    SetPassToNoPass
1024 END DoPass1 ;
1025
1026
1027 (*
1028    DoPass2 - parses the sources of all modules necessary to compile
1029              the required module, Main.
1030 *)
1031
1032 PROCEDURE DoPass2 ;
1033 VAR
1034    name    : Name ;
1035    Sym     : CARDINAL ;
1036    i       : CARDINAL ;
1037    FileName: String ;
1038 BEGIN
1039    SetPassToPass2 ;
1040    i := 1 ;
1041    Sym := GetModuleNo(i) ;
1042    WHILE Sym#NulSym DO
1043       FileName := GetDefinitionModuleFile(Sym) ;
1044       IF FileName#NIL
1045       THEN
1046          IF Debugging
1047          THEN
1048             name := GetSymName(Sym) ;
1049             qprintf1('   Module %a\n', name)
1050          END ;
1051          IF OpenSource(FileName)
1052          THEN
1053             ModuleType := Definition ;
1054             IF NOT P2Build.CompilationUnit()
1055             THEN
1056                MetaError0('compilation failed') ;
1057                CloseSource ;
1058                RETURN
1059             END ;
1060             CloseSource
1061          ELSE
1062             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1063             exit(1)
1064          END ;
1065          ModuleType := Implementation
1066       ELSE
1067          ModuleType := Program
1068       END ;
1069       FileName := GetModuleFile(Sym) ;
1070       IF FileName#NIL
1071       THEN
1072          IF Debugging
1073          THEN
1074             name := GetSymName(Sym) ;
1075             qprintf1('   Module %a\n', name)
1076          END ;
1077          IF OpenSource(FileName)
1078          THEN
1079             IF NOT P2Build.CompilationUnit()
1080             THEN
1081                MetaError0('compilation failed') ;
1082                CloseSource ;
1083                RETURN
1084             END ;
1085             CloseSource
1086          ELSE
1087             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1088             exit(1)
1089          END
1090       END ;
1091       INC(i) ;
1092       Sym := GetModuleNo(i)
1093    END ;
1094    SetPassToNoPass
1095 END DoPass2 ;
1096
1097
1098 (*
1099    DoPassC - parses the sources of all modules necessary to compile
1100              the required module, Main.
1101 *)
1102
1103 PROCEDURE DoPassC ;
1104 VAR
1105    name    : Name ;
1106    Sym     : CARDINAL ;
1107    i       : CARDINAL ;
1108    FileName: String ;
1109 BEGIN
1110    SetPassToPassC ;
1111    i := 1 ;
1112    Sym := GetModuleNo(i) ;
1113    WHILE Sym#NulSym DO
1114       FileName := GetDefinitionModuleFile(Sym) ;
1115       IF FileName#NIL
1116       THEN
1117          IF Debugging
1118          THEN
1119             name := GetSymName(Sym) ;
1120             qprintf1('   Module %a\n', name)
1121          END ;
1122          IF OpenSource(FileName)
1123          THEN
1124             ModuleType := Definition ;
1125             IF NOT PCBuild.CompilationUnit()
1126             THEN
1127                MetaError0('compilation failed') ;
1128                CloseSource ;
1129                RETURN
1130             END ;
1131             CloseSource
1132          ELSE
1133             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1134             exit(1)
1135          END ;
1136          ModuleType := Implementation
1137       ELSE
1138          ModuleType := Program
1139       END ;
1140       FileName := GetModuleFile(Sym) ;
1141       IF FileName#NIL
1142       THEN
1143          IF Debugging
1144          THEN
1145             name := GetSymName(Sym) ;
1146             qprintf1('   Module %a\n', name)
1147          END ;
1148          IF OpenSource(FileName)
1149          THEN
1150             IF NOT PCBuild.CompilationUnit()
1151             THEN
1152                MetaError0('compilation failed') ;
1153                CloseSource ;
1154                RETURN
1155             END ;
1156             CloseSource
1157          ELSE
1158             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1159             exit(1)
1160          END
1161       END ;
1162       INC(i) ;
1163       Sym := GetModuleNo(i)
1164    END ;
1165    PCSymBuild.ResolveConstTypes ;
1166    ResolveConstructorTypes ;
1167    SanityCheckConstants ;
1168    SetPassToNoPass
1169 END DoPassC ;
1170
1171
1172 (*
1173    DoPass3 - parses the sources of all modules necessary to compile
1174              the required module, Main.
1175 *)
1176
1177 PROCEDURE DoPass3 ;
1178 VAR
1179    Main,
1180    Sym     : CARDINAL ;
1181    i       : CARDINAL ;
1182    FileName: String ;
1183 BEGIN
1184    SetPassToPass3 ;
1185    Main := GetMainModule() ;
1186    i := 1 ;
1187    Sym := GetModuleNo(i) ;
1188    WHILE Sym#NulSym DO
1189       FileName := GetDefinitionModuleFile(Sym) ;
1190       IF FileName#NIL
1191       THEN
1192          IF OpenSource(FileName)
1193          THEN
1194             ModuleType := Definition ;
1195             IF NOT P3Build.CompilationUnit()
1196             THEN
1197                MetaError0('compilation failed') ;
1198                CloseSource ;
1199                RETURN
1200             END ;
1201             CloseSource
1202          ELSE
1203             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1204             exit(1)
1205          END ;
1206          ModuleType := Implementation
1207       ELSE
1208          ModuleType := Program
1209       END ;
1210       FileName := GetModuleFile(Sym) ;
1211       IF FileName#NIL
1212       THEN
1213          IF OpenSource(FileName)
1214          THEN
1215             IF (Main=Sym) OR WholeProgram
1216             THEN
1217                IF NOT P3Build.CompilationUnit()
1218                THEN
1219                   MetaError0('compilation failed') ;
1220                   CloseSource ;
1221                   RETURN
1222                END
1223             ELSE
1224                (*
1225                   not the main module .mod therefore must be implementing
1226                   a hidden type - we dont want to generate any
1227                   StatementSequence quadrupes but we do want to build TYPEs
1228                   and ConstExpressions.
1229                *)
1230                SetPassToNoPass ;
1231                SetPassToPassHidden ;
1232                IF NOT PHBuild.CompilationUnit()
1233                THEN
1234                   MetaError0('compilation failed') ;
1235                   CloseSource ;
1236                   RETURN
1237                END ;
1238                SetPassToNoPass ;
1239                SetPassToPass3
1240             END ;
1241             CloseSource
1242          ELSE
1243             fprintf1(StdErr, 'failed to open %s\n', FileName) ;
1244             exit(1)
1245          END
1246       END ;
1247       INC(i) ;
1248       Sym := GetModuleNo(i)
1249    END ;
1250    SetPassToNoPass
1251 END DoPass3 ;
1252
1253
1254 BEGIN
1255    ModuleType := None ;
1256    DepContent := NIL ;
1257    DepOutput := NIL
1258 END M2Comp.