gpcp/CompState.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  State Module for the Gardens Point Component Pascal Compiler.       *)
   4 (*      Copyright (c) John Gough 1999, 2000.                            *)
   5 (*                                                                      *)
   6 (*  Note that since this module is likely to be imported by most other  *)
   7 (*  modules, it is important to ensure that it does not import others,  *)
   8 (*  to avoid import cycles.                                             *)
   9 (*                                                                      *)
  10 (* ==================================================================== *)
  11
  12 MODULE CompState;
  13
  14   IMPORT
  15         GPCPcopyright,
  16         RTS,
  17         Error,
  18         GPText,
  19         Symbols,
  20         IdDesc,
  21         Console,
  22         CPascalS,
  23         NameHash,
  24         FileNames,
  25         ClassMaker,
  26         CPascalErrors;
  27
  28   CONST prefix     = "#gpcp: ";
  29         millis     = "mSec";
  30
  31   CONST netV1_0* = 0;
  32         netV1_1* = 1;
  33         netV2_0* = 2;
  34
  35 (* ==================================================================== *)
  36 (*                State Variables of this compilation                   *)
  37 (* ==================================================================== *)
  38
  39   VAR
  40     ntvObj* : Symbols.Type;     (* native Object type           *)
  41     ntvStr* : Symbols.Type;     (* native String type           *)
  42     ntvExc* : Symbols.Type;     (* native Exceptions type       *)
  43     ntvTyp* : Symbols.Type;     (* native System.Type type      *)
  44     ntvEvt* : Symbols.Type;     (* native MulticastDelegate     *)
  45     rtsXHR* : Symbols.Type;     (* native XHR type descriptor   *)
  46     ntvVal* : Symbols.Type;     (* native ValueType type        *)
  47
  48     objId*  : Symbols.Idnt;
  49     strId*  : Symbols.Idnt;
  50     excId*  : Symbols.Idnt;
  51     clsId*  : Symbols.Idnt;
  52     xhrId*  : IdDesc.FldId;     (* descriptor of RTS.XHR.prev   *)
  53     rtsBlk* : IdDesc.BlkId;
  54     prgArg* : IdDesc.BlkId;
  55     argLst* : IdDesc.VarId;     (* descriptor of RTS.argList    *)
  56
  57     srcBkt* : INTEGER;          (* hashtable bucket of "src"    *)
  58     corBkt* : INTEGER;          (* bucket of "mscorlib_System"  *)
  59
  60     fltInf*  : IdDesc.VarId;    (* descriptor of RTS.fltPosInf. *)
  61     dblInf*  : IdDesc.VarId;    (* descriptor of RTS.dblPosInf. *)
  62     fltNInf* : IdDesc.VarId;    (* descriptor of RTS.fltNegInf. *)
  63     dblNInf* : IdDesc.VarId;    (* descriptor of RTS.dblNegInf. *)
  64
  65   VAR
  66     modNam*   : FileNames.NameString;    (* name of the _MODULE_        *)
  67     basNam-,                             (* base name of source _FILE_  *)
  68     srcNam-,                             (* name of the source file     *)
  69     lstNam-   : FileNames.NameString;    (* name of the listing file    *)
  70
  71     target-   : ARRAY 6 OF CHAR;
  72     emitter-  : ClassMaker.ClassEmitter;
  73
  74     cpSymX-,                             (* User supplied CPSYM name    *)
  75     binDir-,                             (* PE-file directory .NET only *)
  76     symDir-   : FileNames.NameString;    (* Symbol file directory       *)
  77
  78     strict-,
  79     special-,
  80     warning-,
  81     verbose-,
  82     extras-,
  83     unsafe-,
  84     doStats-,
  85     doHelp-,
  86     ovfCheck-,
  87     debug-,
  88     doneHelp,
  89     doVersion-,
  90     doneVersion,
  91     doSym-,
  92     doAsm-,
  93     doJsmn-,
  94     forceIlasm,
  95     forcePerwapi,
  96     doIlasm-,
  97     doCode-,
  98     quiet-,
  99     system-    : BOOLEAN;
 100     legacy*    : BOOLEAN;
 101     netRel-,
 102     listLevel-,
 103     hashSize-  : INTEGER;
 104
 105     thisMod-   : IdDesc.BlkId;           (* Desc. of compiling module.  *)
 106     sysMod-    : IdDesc.BlkId;           (* Desc. of SYSTEM module.     *)
 107     sysLib-    : IdDesc.BlkId;           (* mscorlib OR java.lang BlkId *)
 108
 109     impSeq*    : Symbols.ScpSeq;
 110
 111     totalS*    : LONGINT;
 112     parseS*    : LONGINT;
 113     parseE*    : LONGINT;
 114     attrib*    : LONGINT;
 115     symEnd*    : LONGINT;
 116     asmEnd*    : LONGINT;
 117     totalE*    : LONGINT;
 118     import1*   : LONGINT;
 119     import2*   : LONGINT;
 120
 121     impMax*    : INTEGER;
 122
 123   VAR outNam*  : POINTER TO ARRAY OF CHAR;
 124
 125   VAR
 126     expectedNet : BOOLEAN;         (* A .NET specific option was parsed  *)
 127     expectedJvm : BOOLEAN;         (* A JVM specific option was parsed   *)
 128     expectedLlvm : BOOLEAN;        (* An LLVM specific option was parsed *)
 129
 130 (* ==================================================================== *)
 131 (*                             Utilities                                *)
 132 (* ==================================================================== *)
 133
 134     PROCEDURE SetSysLib*(lib : IdDesc.BlkId);
 135     BEGIN
 136       sysLib := lib;
 137     END SetSysLib;
 138
 139     PROCEDURE SetEmitter*(maker : ClassMaker.ClassEmitter);
 140     BEGIN
 141       emitter := maker;
 142     END SetEmitter;
 143
 144     PROCEDURE ImportObjectFeatures*();
 145     BEGIN
 146       emitter.ObjectFeatures();
 147     END ImportObjectFeatures;
 148
 149     PROCEDURE SetQuiet*();
 150     BEGIN
 151       CPascalErrors.nowarn := TRUE;
 152     END SetQuiet;
 153
 154     PROCEDURE RestoreQuiet*();
 155     BEGIN
 156       CPascalErrors.nowarn := ~warning;
 157     END RestoreQuiet;
 158
 159     PROCEDURE targetIsNET*() : BOOLEAN;
 160     BEGIN
 161       RETURN target = "net";
 162     END targetIsNET;
 163
 164     PROCEDURE targetIsJVM*() : BOOLEAN;
 165     BEGIN
 166       RETURN target = "jvm";
 167     END targetIsJVM;
 168
 169     PROCEDURE targetIsLLVM*() : BOOLEAN;
 170     BEGIN
 171       RETURN target = "llvm";
 172     END targetIsLLVM;
 173
 174     PROCEDURE Message*(IN mss : ARRAY OF CHAR);
 175     BEGIN
 176       Console.WriteString(prefix);
 177       Console.WriteString(mss);
 178       Console.WriteLn;
 179     END Message;
 180
 181     PROCEDURE PrintLn*(IN mss : ARRAY OF CHAR);
 182     BEGIN
 183       Console.WriteString(mss);
 184       Console.WriteLn;
 185     END PrintLn;
 186
 187     PROCEDURE ErrMesg*(IN mss : ARRAY OF CHAR);
 188     BEGIN
 189       Console.WriteString(prefix);
 190       Error.WriteString(mss);
 191       Error.WriteLn;
 192     END ErrMesg;
 193
 194     PROCEDURE Abort*(IN mss : ARRAY OF CHAR);
 195     BEGIN
 196       ErrMesg(mss); ASSERT(FALSE);
 197     END Abort;
 198
 199     PROCEDURE isForeign*() : BOOLEAN;
 200     BEGIN
 201       RETURN
 202         (Symbols.rtsMd IN thisMod.xAttr) OR
 203         (Symbols.frnMd IN thisMod.xAttr);
 204     END isForeign;
 205
 206     PROCEDURE TimeMsg*(IN mss : ARRAY OF CHAR; tim : LONGINT);
 207     BEGIN
 208       IF (tim < 0) OR (tim >= totalS) THEN tim := 0 END;
 209       Console.WriteString(prefix);
 210       Console.WriteString(mss);
 211       Console.WriteInt(SHORT(tim), 5);
 212       Console.WriteString(millis);
 213       Console.WriteLn;
 214     END TimeMsg;
 215
 216 (* ==================================================================== *)
 217
 218     PROCEDURE Usage;
 219     BEGIN
 220       PrintLn("gardens point component pascal: " + GPCPcopyright.verStr);
 221       Message("Usage from the command line ...");
 222       IF RTS.defaultTarget = "net" THEN
 223 PrintLn("       $ gpcp [cp-options] file {file}");
 224 PrintLn("# CP Options ...");
 225 PrintLn("       /bindir=XXX  ==> Place binary files in directory XXX");
 226 PrintLn("       /copyright   ==> Display copyright notice");
 227 PrintLn("       /cpsym=XXX   ==> Use environ. variable XXX instead of CPSYM");
 228 PrintLn("       /debug       ==> Generate debugging information (default)");
 229 PrintLn("       /nodebug     ==> Give up debugging for maximum speed");
 230 PrintLn("       /dostats     ==> Give a statistical summary");
 231 PrintLn("       /extras      ==> Enable experimental compiler features");
 232 PrintLn("       /help        ==> Write out this usage message");
 233 PrintLn("       /hsize=NNN   ==> Set hashtable size >= NNN (0 .. 65000)");
 234 PrintLn("       /ilasm       ==> Force compilation via ILASM");
 235 PrintLn("       /list        ==> (default) Create *.lst file if errors");
 236 PrintLn("       /list+       ==> Unconditionally create *.lst file");
 237 PrintLn("       /list-       ==> Don't create error *.lst file");
 238 PrintLn("       /noasm       ==> Don't create asm (or object) files");
 239 PrintLn("       /nocode      ==> Don't create any object files");
 240 PrintLn("       /nocheck     ==> Don't perform arithmetic overflow checks");
 241 PrintLn("       /nosym       ==> Don't create *.sym (or asm or object) files");
 242 PrintLn("       /perwapi     ==> Force compilation via PERWAPI");
 243 PrintLn("       /quiet       ==> Compile silently if possible");
 244 PrintLn("       /strict      ==> Disallow non-standard constructs");
 245 PrintLn("       /special     ==> Compile dummy symbol file");
 246 PrintLn("       /symdir=XXX  ==> Place symbol files in directory XXX");
 247 PrintLn("       /target=XXX  ==> Emit (jvm|net|llvm) assembly");
 248 PrintLn("       /unsafe      ==> Allow unsafe code generation");
 249 PrintLn("       /vX.X        ==> (v1.0 | v1.1 | v2.0) CLR target version");
 250 PrintLn("       /verbose     ==> Emit verbose diagnostics");
 251 PrintLn("       /version     ==> Write out version number");
 252 PrintLn("       /vserror     ==> Print error messages in Visual Studio format");
 253 PrintLn("       /warn-       ==> Don't emit warnings");
 254 PrintLn("       /nowarn      ==> Don't emit warnings");
 255 PrintLn("       /whidbey     ==> Target code for Whidbey Beta release");
 256 PrintLn("       /xmlerror    ==> Print error messages in XML format");
 257 PrintLn(' Unix-style options: "-option" are recognized also');
 258       ELSE
 259         IF RTS.defaultTarget = "jvm" THEN
 260 PrintLn("       $ cprun gpcp [cp-options] file {file}, OR");
 261 PrintLn("       $ java [java-options] CP.gpcp.gpcp [cp-options] file {file}");
 262         ELSIF RTS.defaultTarget = "llvm" THEN
 263           PrintLn("       $ gpcp [cp-options] file {file}");
 264         END;
 265 PrintLn("# CP Options ...");
 266 PrintLn("       -clsdir=XXX  ==> Set class tree root in directory XXX");
 267 PrintLn("       -copyright   ==> Display copyright notice");
 268 PrintLn("       -cpsym=XXX   ==> Use environ. variable XXX instead of CPSYM");
 269 PrintLn("       -dostats     ==> Give a statistical summary");
 270 PrintLn("       -extras      ==> Enable experimental compiler features");
 271 PrintLn("       -help        ==> Write out this usage message");
 272 PrintLn("       -hsize=NNN   ==> Set hashtable size >= NNN (0 .. 65000)");
 273 PrintLn("       -jasmin      ==> Ceate asm files and run Jasmin");
 274 PrintLn("       -list        ==> (default) Create *.lst file if errors");
 275 PrintLn("       -list+       ==> Unconditionally create *.lst file");
 276 PrintLn("       -list-       ==> Don't create error *.lst file");
 277 PrintLn("       -nocode      ==> Don't create any object files");
 278 PrintLn("       -noasm       ==> Don't create asm (or object) files");
 279 PrintLn("       -nosym       ==> Don't create *.sym (or asm or object) files");
 280 PrintLn("       -quiet       ==> Compile silently if possible");
 281 PrintLn("       -special     ==> Compile dummy symbol file");
 282 PrintLn("       -strict      ==> Disallow non-standard constructs");
 283 PrintLn("       -symdir=XXX  ==> Place symbol files in directory XXX");
 284 PrintLn("       -target=XXX  ==> Emit (jvm|net|llvm) assembly");
 285 PrintLn("       -verbose     ==> Emit verbose diagnostics");
 286 PrintLn("       -version     ==> Write out version number");
 287 PrintLn("       -warn-       ==> Don't emit warnings");
 288 PrintLn("       -nowarn      ==> Don't emit warnings");
 289 PrintLn("       -xmlerror    ==> Print error messages in XML format");
 290         IF RTS.defaultTarget = "jvm" THEN
 291 PrintLn("# Java Options ...");
 292 PrintLn("       -D<name>=<value>  pass <value> to JRE as system property <name>");
 293 PrintLn("       -DCPSYM=$CPSYM    pass value of CPSYM environment variable to JRE");
 294         END;
 295       END;
 296       Message("This program comes with NO WARRANTY");
 297       Message("Read source/GPCPcopyright for license details");
 298     END Usage;
 299
 300 (* ==================================================================== *)
 301 (*                           Option Setting                             *)
 302 (* ==================================================================== *)
 303
 304     PROCEDURE ParseOption*(IN opt : ARRAY OF CHAR);
 305           CONST MaxTargetLength = 4;
 306       VAR copy : ARRAY 16 OF CHAR;
 307               trgt : ARRAY MaxTargetLength + 1 OF CHAR;
 308           indx : INTEGER;
 309      (* ----------------------------------------- *)
 310       PROCEDURE Unknown(IN str : ARRAY OF CHAR);
 311       BEGIN
 312         Message('Unknown option "' + str + '"');
 313         doHelp := TRUE;
 314       END Unknown;
 315      (* ----------------------------------------- *)
 316       PROCEDURE BadSize();
 317       BEGIN Message('hsize must be integer in range 0 .. 65000') END BadSize;
 318      (* ----------------------------------------- *)
 319       PROCEDURE ParseSize(IN opt : ARRAY OF CHAR);
 320         VAR ix : INTEGER;
 321             nm : INTEGER;
 322             ch : CHAR;
 323       BEGIN
 324         nm := 0;
 325         ix := 7;
 326         WHILE opt[ix] # 0X DO
 327           ch := opt[ix];
 328           IF (ch >= '0') & (ch <= '9') THEN
 329             nm := nm * 10 + ORD(ch) - ORD('0');
 330             IF nm > 65521 THEN BadSize; hashSize := nm; RETURN END;
 331           ELSE
 332             BadSize; doHelp := TRUE; hashSize := nm; RETURN;
 333           END;
 334           INC(ix);
 335         END;
 336         hashSize := nm;
 337       END ParseSize;
 338      (* ----------------------------------------- *)
 339       PROCEDURE GetSuffix(preLen : INTEGER;
 340                          IN  opt : ARRAY OF CHAR;
 341                          OUT dir : ARRAY OF CHAR);
 342         VAR idx : INTEGER;
 343             chr : CHAR;
 344       BEGIN
 345         idx := preLen;
 346         chr := opt[idx];
 347         WHILE (chr # 0X) & (idx < LEN(opt)) DO
 348           dir[idx - preLen] := chr;
 349           INC(idx); chr := opt[idx];
 350         END;
 351       END GetSuffix;
 352      (* ----------------------------------------- *)
 353           PROCEDURE RaiseSuffix(preLen : INTEGER;
 354                                 outLen : INTEGER;
 355                                 IN opt : ARRAY OF CHAR;
 356                                                         OUT dir : ARRAY OF CHAR);
 357         VAR idx : INTEGER;
 358             chr : CHAR;
 359       BEGIN
 360         idx := 0;
 361                 REPEAT
 362           chr := opt[idx + preLen];
 363                   dir[idx] := CAP(chr);
 364                   INC(idx);
 365                 UNTIL (chr = 0X) OR (idx >= outLen) OR ((idx + preLen) > LEN(opt));
 366                 dir[idx] := 0X;
 367       END RaiseSuffix;
 368
 369      (* ----------------------------------------- *)
 370       PROCEDURE StartsWith(str : ARRAY OF CHAR; IN pat : ARRAY OF CHAR) : BOOLEAN;
 371       BEGIN
 372         str[LEN(pat$)] := 0X;
 373         RETURN str = pat;
 374       END StartsWith;
 375      (* ----------------------------------------- *)
 376     BEGIN
 377       indx := 1;
 378       WHILE (indx < 16) & (indx < LEN(opt)) DO
 379         copy[indx-1] := opt[indx]; INC(indx);
 380       END;
 381       copy[15] := 0X;
 382
 383       CASE copy[0] OF
 384       | "b" :
 385           IF StartsWith(copy, "bindir=") THEN
 386             GetSuffix(LEN("/bindir="), opt, binDir);
 387             expectedNet := TRUE;
 388             IF ~quiet THEN
 389               Message("bin directory set to <" + binDir +">");
 390             END;
 391           ELSE
 392             Unknown(opt);
 393           END;
 394       | "c" :
 395           IF copy = "copyright" THEN
 396             GPCPcopyright.Write;
 397           ELSIF StartsWith(copy, "clsdir=") THEN
 398             GetSuffix(LEN("/clsdir="), opt, binDir);
 399             expectedJvm := TRUE;
 400             IF ~quiet THEN
 401               Message("output class tree rooted at <" + binDir +">");
 402             END;
 403           ELSIF StartsWith(copy, "cpsym=") THEN
 404             GetSuffix(LEN("/cpsym="), opt, cpSymX);
 405             IF ~quiet THEN
 406               Message("using %" + cpSymX +"% as symbol file path");
 407             END;
 408           ELSE
 409             Unknown(opt);
 410           END;
 411       | "d" :
 412           IF copy = "dostats" THEN
 413             doStats := TRUE;
 414           ELSIF copy = "debug" THEN
 415             debug := TRUE;
 416             expectedNet := TRUE;
 417           ELSE
 418             Unknown(opt);
 419           END;
 420       | "e" : IF copy = "extras" THEN extras := TRUE ELSE Unknown(opt) END;
 421       | "h" :
 422           copy[6] := 0X;
 423           IF copy = "help" THEN
 424             doHelp := TRUE;
 425           ELSIF copy = "hsize=" THEN
 426             ParseSize(opt);
 427           ELSE
 428             Unknown(opt);
 429           END;
 430       | "i" :
 431           IF copy = "ilasm" THEN
 432             forceIlasm := TRUE;
 433             expectedNet := TRUE;
 434           ELSE
 435             Unknown(opt);
 436           END;
 437       | "j" :
 438           IF copy = "jasmin" THEN
 439             doCode     := TRUE;
 440             doJsmn     := TRUE;
 441             expectedJvm := TRUE;
 442           ELSE
 443             Unknown(opt);
 444           END;
 445       | "l" :
 446           IF copy = "list-" THEN
 447             listLevel  := CPascalS.listNever;
 448           ELSIF copy = "list+" THEN
 449             listLevel  := CPascalS.listAlways;
 450           ELSIF copy = "list" THEN
 451             listLevel  := CPascalS.listErrOnly;
 452           ELSIF copy = "legacy" THEN
 453             legacy := TRUE;
 454           ELSE
 455             Unknown(opt);
 456           END;
 457       | "n" :
 458           IF copy = "nosym" THEN
 459             doSym      := FALSE;
 460             doAsm      := FALSE;
 461             doCode     := FALSE;
 462           ELSIF copy = "noasm" THEN
 463             doAsm      := FALSE;
 464             doCode     := FALSE;
 465           ELSIF copy = "nocode" THEN
 466             doCode     := FALSE;
 467           ELSIF copy = "nowarn" THEN
 468             warning    := FALSE;
 469             CPascalErrors.nowarn := TRUE;
 470           ELSIF copy = "nocheck" THEN
 471             ovfCheck   := FALSE;
 472             expectedNet := TRUE;
 473           ELSIF copy = "nodebug" THEN
 474             debug    := FALSE;
 475             expectedNet := TRUE;
 476           ELSE
 477             Unknown(opt);
 478           END;
 479           | "p" :
 480           IF copy = "perwapi" THEN
 481             forcePerwapi := TRUE;
 482             expectedNet := TRUE;
 483           ELSE
 484             Unknown(opt);
 485           END;
 486       | "q" :
 487           IF copy = "quiet" THEN
 488             quiet := TRUE;
 489             warning := FALSE;
 490           ELSE
 491             Unknown(opt);
 492           END;
 493       | "s" :
 494           IF copy = "special" THEN
 495             doAsm      := FALSE;
 496             special    := TRUE;
 497             strict     := FALSE;
 498           ELSIF copy = "strict" THEN
 499             strict     := TRUE;
 500           ELSIF StartsWith(copy, "symdir=") THEN
 501             GetSuffix(LEN("/symdir="), opt, symDir);
 502             IF ~quiet THEN
 503               Message("sym directory set to <" + symDir +">");
 504             END;
 505           ELSE
 506             Unknown(opt);
 507           END;
 508       | "t" :
 509           IF StartsWith(copy, "target=") THEN
 510             RaiseSuffix(LEN("/target="), MaxTargetLength, opt, trgt);
 511             IF trgt = "JVM" THEN
 512               IF RTS.defaultTarget = "jvm" THEN
 513                 Message("JVM is default target for this build");
 514               END;
 515               target := "jvm";
 516             ELSIF (trgt = "NET") OR (trgt = "CLR") THEN
 517               IF RTS.defaultTarget = "net" THEN
 518                 Message("NET is default target for this build");
 519               END;
 520               target := "net";
 521             ELSIF trgt = "LLVM" THEN
 522               target := "llvm";
 523             ELSE
 524               Message('Unknown target, using "target=' +
 525                                                     RTS.defaultTarget + '"');
 526             END;
 527           ELSE
 528             Unknown(opt);
 529           END;
 530       | "u" :
 531           IF copy = "unsafe" THEN
 532             unsafe := TRUE;
 533             expectedNet := TRUE;
 534           ELSE
 535             Unknown(opt);
 536           END;
 537       | "v" :
 538           IF copy = "version" THEN
 539             doVersion  := TRUE;
 540           ELSIF copy = "verbose" THEN
 541             quiet      := FALSE;
 542             warning    := TRUE;
 543             verbose    := TRUE;
 544             doStats    := TRUE;
 545             CPascalErrors.prompt := TRUE;
 546           ELSIF copy = "vserror" THEN
 547             CPascalErrors.forVisualStudio := TRUE;
 548             expectedNet := TRUE;
 549           ELSIF copy = "v1.0" THEN
 550             netRel := netV1_0;
 551             expectedNet := TRUE;
 552           ELSIF copy = "v1.1" THEN
 553             netRel := netV1_1;
 554             expectedNet := TRUE;
 555           ELSIF copy = "v2.0" THEN
 556             netRel := netV2_0;
 557             expectedNet := TRUE;
 558           ELSE
 559             Unknown(opt);
 560           END;
 561       | "w" :
 562           IF copy = "warn-" THEN
 563             warning    := FALSE;
 564             CPascalErrors.nowarn := TRUE;
 565           ELSIF copy = "whidbey" THEN
 566             netRel := netV2_0;
 567             expectedNet := TRUE;
 568           ELSE
 569             Unknown(opt);
 570           END;
 571       | "x" :
 572           IF copy = "xmlerror" THEN
 573             CPascalErrors.xmlErrors := TRUE;
 574           ELSE
 575             Unknown(opt);
 576           END;
 577       ELSE
 578         Unknown(opt);
 579       END;
 580       IF doVersion & ~doneVersion THEN
 581         Message(target + GPCPcopyright.verStr);
 582         doneVersion := TRUE;
 583       END;
 584       IF doHelp & ~doneHelp THEN Usage; doneHelp := TRUE END;
 585     END ParseOption;
 586
 587 (* ==================================================================== *)
 588
 589     PROCEDURE CheckOptionsOK*;
 590     BEGIN
 591       IF target = "net" THEN
 592         IF expectedJvm THEN Message
 593           ("WARNING - a JVM-specific option was specified for .NET target");
 594           expectedJvm := FALSE;
 595         END;
 596         IF expectedLlvm THEN Message
 597           ("WARNING - an LLVM-specific option was specified for .NET target");
 598           expectedLlvm := FALSE;
 599         END;
 600       ELSIF target = "jvm" THEN
 601         IF expectedNet THEN Message
 602           ("WARNING - a .NET-specific option was specified for JVM target");
 603           expectedNet := FALSE;
 604         END;
 605         IF expectedLlvm THEN Message
 606           ("WARNING - an LLVM-specific option was specified for JVM target");
 607           expectedLlvm := FALSE;
 608         END;
 609       ELSIF target = "llvm" THEN
 610         IF expectedJvm THEN Message
 611           ("WARNING - a JVM-specific option was specified for LLVM target");
 612           expectedJvm := FALSE;
 613         END;
 614         IF expectedNet THEN Message
 615           ("WARNING - a .NET-specific option was specified for LLVM target");
 616           expectedNet := FALSE;
 617         END;
 618       END;
 619      (*
 620       *  If debug is set, for this version, ILASM is used unless /perwapi is explicit
 621       *  If debug is clar, for this versin, PERWAPI is used unless /ilasm is explicit
 622       *)
 623       IF forceIlasm THEN      doIlasm := TRUE;
 624       ELSIF forcePerwapi THEN doIlasm := FALSE;
 625       ELSE                    doIlasm := debug;
 626       END;
 627     END CheckOptionsOK;
 628
 629 (* ==================================================================== *)
 630
 631     PROCEDURE CreateThisMod*();
 632     BEGIN
 633       NEW(thisMod);
 634       thisMod.SetKind(IdDesc.modId);
 635       thisMod.ovfChk := ovfCheck;
 636     END CreateThisMod;
 637
 638     PROCEDURE InitCompState*(IN nam : ARRAY OF CHAR);
 639     BEGIN
 640       IF verbose THEN Message("opened local file <" + nam + ">") END;
 641       GPText.Assign(nam, srcNam);
 642       CPascalErrors.SetSrcNam(nam);
 643       FileNames.StripExt(nam, basNam);
 644       FileNames.AppendExt(basNam, "lst", lstNam);
 645
 646       CreateThisMod;
 647       xhrId := IdDesc.newFldId();
 648       xhrId.hash := NameHash.enterStr("prev");
 649       srcBkt     := NameHash.enterStr("src");
 650       corBkt     := NameHash.enterStr("mscorlib_System");
 651
 652       NEW(sysMod);
 653       sysMod.SetKind(IdDesc.impId);
 654     END InitCompState;
 655
 656 (* ==================================================================== *)
 657
 658   PROCEDURE Report*;
 659     VAR str1 : ARRAY 8 OF CHAR;
 660         str2 : ARRAY 8 OF CHAR;
 661   BEGIN
 662     Message(target + GPCPcopyright.verStr);
 663     GPText.IntToStr(CPascalS.line, str1);
 664     Message(str1 + " source lines");
 665     GPText.IntToStr(impMax, str1);
 666     Message("import recursion depth " + str1);
 667     GPText.IntToStr(NameHash.size, str2);
 668     GPText.IntToStr(NameHash.entries, str1);
 669     Message(str1 + " entries in hashtable of size " + str2);
 670     TimeMsg("import time   ", import2 - import1);
 671     TimeMsg("source time   ", parseS  - totalS);
 672     TimeMsg("parse time    ", parseE  - parseS - import2 + import1);
 673     TimeMsg("analysis time ", attrib  - parseE);
 674     TimeMsg("symWrite time ", symEnd  - attrib);
 675     TimeMsg("asmWrite time ", asmEnd  - symEnd);
 676     TimeMsg("assemble time ", totalE  - asmEnd);
 677     TimeMsg("total time    ", totalE  - totalS);
 678   END Report;
 679
 680 (* ==================================================================== *)
 681
 682   PROCEDURE InitOptions*;
 683   BEGIN
 684     legacy      := FALSE;
 685     warning     := TRUE;
 686     verbose     := FALSE;
 687     doHelp      := FALSE; doneHelp    := FALSE;
 688     doVersion   := FALSE; doneVersion := FALSE;
 689     ovfCheck    := TRUE;
 690     debug       := TRUE;
 691     netRel      := netV2_0; (* probably should be from RTS? *)
 692     doSym       := TRUE;
 693     extras      := FALSE;
 694     unsafe      := FALSE;
 695     doStats     := FALSE;
 696     doJsmn      := FALSE;
 697     doIlasm     := TRUE;
 698     forceIlasm  := FALSE;
 699     forcePerwapi := FALSE;
 700     doCode      := TRUE;
 701     doAsm       := TRUE;
 702     special     := FALSE;
 703     strict      := FALSE;
 704     quiet       := FALSE;
 705     system      := FALSE;
 706     listLevel   := CPascalS.listErrOnly;
 707     hashSize    := 5000;        (* gets default hash size *)
 708     expectedNet := FALSE;
 709     expectedJvm := FALSE;
 710     expectedLlvm := FALSE;
 711     cpSymX      := "CPSYM";
 712   END InitOptions;
 713
 714 (* ==================================================================== *)
 715 BEGIN
 716   GPText.Assign(RTS.defaultTarget, target);
 717 END CompState.
 718 (* ==================================================================== *)
 719