gpcp/CPascal.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  Main Module for the Gardens Point Component Pascal Compiler.        *)
   4 (*      Copyright (c) John Gough 1999, 2000.                            *)
   5 (*      This module was extensively modified from the driver            *)
   6 (*      automatically produced by the M2 version of COCO/R, using       *)
   7 (*      the CPascal.atg grammar used for the JVM version of GPCP.       *)
   8 (*                                                                      *)
   9 (* ==================================================================== *)
  10
  11 MODULE CPascal;
  12 (* This is an example of a rudimentary main module for use with COCO/R.
  13    The auxiliary modules <Grammar>S (scanner) and <Grammar>P (parser)
  14    are assumed to have been constructed with COCO/R compiler generator. *)
  15
  16   IMPORT
  17         GPCPcopyright,
  18         Symbols,
  19         RTS,
  20         FileNames,
  21         IdDesc,
  22         Error,
  23         Console,
  24         ProgArgs,
  25         CSt := CompState,
  26         CPascalP,
  27         Scnr := CPascalS,
  28         CPascalErrors,
  29         New := NewSymFileRW,
  30         Old := OldSymFileRW,
  31         NameHash,
  32         Visitor,
  33         Builtin,
  34         GPText,
  35         Target,
  36         TxtFil := GPTextFiles,
  37         BinFil := GPBinFiles;
  38
  39 (* ==================================================================== *)
  40 (*                         Option Setting                               *)
  41 (* ==================================================================== *)
  42
  43     PROCEDURE ResetOptions*;
  44     BEGIN
  45       CSt.InitOptions;
  46     END ResetOptions;
  47
  48     (* -------------------------- *)
  49
  50     PROCEDURE Message*(IN msg : ARRAY OF CHAR);
  51     BEGIN
  52       CSt.Message(msg);
  53     END Message;
  54
  55     (* -------------------------- *)
  56
  57     PROCEDURE DoOption*(IN opt : ARRAY OF CHAR);
  58     BEGIN
  59       CSt.ParseOption(opt);
  60     END DoOption;
  61
  62     (* -------------------------- *)
  63
  64     PROCEDURE CondMsg(IN msg : ARRAY OF CHAR);
  65     BEGIN
  66       IF CSt.verbose THEN CSt.Message(msg) END;
  67     END CondMsg;
  68
  69 (* ==================================================================== *)
  70 (*                    Calling the Compiler                              *)
  71 (* ==================================================================== *)
  72
  73     PROCEDURE Finalize*;
  74       VAR a : ARRAY 16 OF CHAR;
  75           b : ARRAY 256 OF CHAR;
  76     BEGIN
  77       IF CPascalErrors.forVisualStudio OR
  78          CPascalErrors.xmlErrors THEN RETURN END;
  79       b := "<" + CSt.modNam + ">";
  80       IF Scnr.errors = 0 THEN
  81         b := (b + " No errors");
  82       ELSIF Scnr.errors = 1 THEN
  83         b := (b + " There was one error");
  84       ELSE
  85         GPText.IntToStr(Scnr.errors, a);
  86         b := (b + " There were " + a + " errors");
  87       END;
  88       IF Scnr.warnings = 1 THEN
  89         b := (b + ", and one warning");
  90       ELSIF Scnr.warnings > 1 THEN
  91         GPText.IntToStr(Scnr.warnings, a);
  92         b := (b + ", and " + a + " warnings");
  93       END;
  94       IF ~CSt.quiet THEN CSt.Message(b) END;
  95     END Finalize;
  96
  97 (* ==================================================================== *)
  98
  99     PROCEDURE FixListing*;
 100       VAR doList : BOOLEAN;
 101           events : INTEGER;
 102     BEGIN
 103       doList := (CSt.listLevel > Scnr.listNever);
 104       events := Scnr.errors;
 105       IF CSt.warning THEN INC(events, Scnr.warnings) END;
 106       IF (events > 0) OR
 107          (CSt.listLevel = Scnr.listAlways) THEN
 108         Scnr.lst := TxtFil.createFile(CSt.lstNam);
 109         IF Scnr.lst # NIL THEN
 110           CPascalErrors.PrintListing(doList);
 111           TxtFil.CloseFile(Scnr.lst);
 112           Scnr.lst := NIL;
 113         ELSE
 114           CSt.Message("cannot create file <" + CSt.lstNam + ">");
 115           IF events > 0 THEN CPascalErrors.PrintListing(FALSE) END;
 116         END;
 117       END;
 118       CPascalErrors.ResetErrorList();
 119     END FixListing;
 120
 121 (* ==================================================================== *)
 122
 123     PROCEDURE Compile*(IN nam : ARRAY OF CHAR; OUT retVal : INTEGER);
 124     BEGIN
 125       CSt.CheckOptionsOK;
 126       retVal := 0;
 127       CSt.totalS := RTS.GetMillis();
 128       Scnr.src := BinFil.findLocal(nam);
 129       IF Scnr.src = NIL THEN
 130         CSt.Message("cannot open local file <" + nam + ">");
 131       ELSE
 132         NameHash.InitNameHash(CSt.hashSize);
 133         CSt.outNam := NIL;
 134         CSt.InitCompState(nam);
 135         Builtin.RebindBuiltins();
 136         Target.Select(CSt.thisMod, CSt.target);
 137         Target.Init();
 138         CondMsg("Starting Parse");
 139         CPascalP.Parse;   (* do the compilation here *)
 140         CSt.parseE := RTS.GetMillis();
 141         IF Scnr.errors = 0 THEN
 142           CondMsg("Doing statement attribution");
 143           CSt.thisMod.StatementAttribution(Visitor.newImplementedCheck());
 144           IF (Scnr.errors = 0) & CSt.extras THEN
 145             CondMsg("Doing type erasure");
 146             CSt.thisMod.TypeErasure(Visitor.newTypeEraser());
 147           END;
 148           IF Scnr.errors = 0 THEN
 149             CondMsg("Doing dataflow analysis");
 150             CSt.thisMod.DataflowAttribution();
 151             CSt.attrib := RTS.GetMillis();
 152             IF Scnr.errors = 0 THEN
 153               IF CSt.doSym THEN
 154                 CondMsg("Emitting symbol file");
 155                 IF CSt.legacy THEN
 156                   Old.EmitSymfile(CSt.thisMod);
 157                 ELSE
 158                   New.EmitSymfile(CSt.thisMod);
 159                 END;
 160                 CSt.symEnd := RTS.GetMillis();
 161                 IF CSt.doAsm THEN
 162                   IF CSt.isForeign() THEN
 163                     CondMsg("Foreign module: no code output");
 164                   ELSE
 165                     CondMsg("Emitting assembler");
 166                     Target.Emit();
 167                     CSt.asmEnd := RTS.GetMillis();
 168                     IF CSt.doCode THEN Target.Assemble() END;
 169                   END;
 170                 END;
 171               END;
 172             END;
 173           END;
 174         END;
 175         IF Scnr.errors # 0 THEN retVal := 2 END;
 176         CSt.totalE := RTS.GetMillis();
 177         FixListing;
 178         Finalize;
 179         IF CSt.doStats THEN CSt.Report END;
 180       END;
 181     RESCUE (sysX)
 182       retVal := 2;
 183       CSt.Message("<< COMPILER PANIC >>");
 184       Scnr.SemError.RepSt1(299, RTS.getStr(sysX), 1, 1);
 185      (*
 186       *  If an exception is raised during listing, FixListing will
 187       *  be called twice. Avoid an attempted sharing violation...
 188       *)
 189       IF Scnr.lst # NIL THEN
 190         TxtFil.CloseFile(Scnr.lst);
 191         CSt.Message(RTS.getStr(sysX));
 192         Scnr.lst := NIL;
 193       ELSE
 194         FixListing;
 195       END;
 196       Finalize;
 197     END Compile;
 198
 199 (* ==================================================================== *)
 200 (*                       Main Argument Loop                             *)
 201 (* ==================================================================== *)
 202
 203 BEGIN
 204   CSt.InitOptions;
 205   CPascalErrors.Init;
 206   Builtin.InitBuiltins;
 207 END CPascal.
 208
 209 (* ==================================================================== *)