Trurl-based/Dev/Mod/Compiler.txt

   1 MODULE DevCompiler;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Compiler.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT Kernel,
   7                 Files, Views, Dialog, Controls,
   8                 TextModels, TextMappers, TextViews, TextControllers,
   9                 StdLog, StdDialog,
  10                 DevMarkers, DevCommanders, DevSelectors,
  11                 DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPV := DevCPV486;
  12
  13         CONST
  14                 (* compiler options: *)
  15                 checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5; srcpos = 6; reallib = 7; signatures = 8;
  16                 hint = 29; oberon = 30; errorTrap = 31;
  17                 defopt = {checks, assert, obj, ref, allref, srcpos, signatures};
  18
  19                 (* additional scanner types *)
  20                 import = 100; module = 101; semicolon = 102; becomes = 103; comEnd = 104;
  21
  22         VAR
  23                 sourceR: TextModels.Reader;
  24                 s: TextMappers.Scanner;
  25                 str: Dialog.String;
  26                 found: BOOLEAN; (* DevComDebug was found -> DTC *)
  27
  28         PROCEDURE Module (source: TextModels.Reader; opt: SET; log: TextModels.Model; VAR error: BOOLEAN);
  29                 VAR ext, new: BOOLEAN; p: DevCPT.Node;
  30         BEGIN
  31                 DevCPM.Init(source, log);
  32                 IF found THEN INCL(DevCPM.options, DevCPM.comAware) END;
  33                 IF errorTrap IN opt THEN INCL(DevCPM.options, DevCPM.trap) END;
  34                 IF oberon IN opt THEN INCL(DevCPM.options, DevCPM.oberon) END;
  35                 DevCPT.Init(opt);
  36                 DevCPB.typSize := DevCPV.TypeSize;
  37                 DevCPT.processor := DevCPV.processor;
  38                 DevCPP.Module(p);
  39                 IF DevCPM.noerr THEN
  40                         IF DevCPT.libName # "" THEN EXCL(opt, obj) END;
  41 (*
  42                         IF errorTrap IN opt THEN DevCPDump.DumpTree(p) END;
  43 *)
  44                         DevCPV.Init(opt); DevCPV.Allocate; DevCPT.Export(ext, new);
  45                         IF DevCPM.noerr & (obj IN opt) THEN
  46                                 DevCPV.Module(p)
  47                         END;
  48                         DevCPV.Close
  49                 END;
  50                 IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
  51                 ELSE DevCPM.DeleteNewSym
  52                 END;
  53                 DevCPT.Close;
  54                 error := ~DevCPM.noerr;
  55                 DevCPM.Close;
  56                 p := NIL;
  57                 Kernel.FastCollect;
  58                 IF error THEN
  59                         DevCPM.InsertMarks(source.Base());
  60                         DevCPM.LogWLn; DevCPM.LogWStr(" ");
  61                         IF DevCPM.errors = 1 THEN
  62                                 Dialog.MapString("#Dev:OneErrorDetected", str)
  63                         ELSE
  64                                 DevCPM.LogWNum(DevCPM.errors, 0); Dialog.MapString("#Dev:ErrorsDetected", str)
  65                         END;
  66                         StdLog.String(str)
  67                 ELSE
  68                         IF hint IN opt THEN DevCPM.InsertMarks(source.Base()) END;
  69                         DevCPM.LogWStr("  "); DevCPM.LogWNum(DevCPE.pc, 8);
  70                         DevCPM.LogWStr("  "); DevCPM.LogWNum(DevCPE.dsize, 8)
  71                 END;
  72                 DevCPM.LogWLn
  73         END Module;
  74
  75         PROCEDURE Scan (VAR s: TextMappers.Scanner);
  76         BEGIN
  77                 s.Scan;
  78                 IF s.type = TextMappers.string THEN
  79                         IF s.string = "MODULE" THEN s.type := module END
  80                 ELSIF s.type = TextMappers.char THEN
  81                         IF s.char = "(" THEN
  82                                 IF s.rider.char = "*" THEN
  83                                         s.rider.Read;
  84                                         REPEAT Scan(s) UNTIL (s.type = TextMappers.eot) OR (s.type = comEnd);
  85                                         Scan(s)
  86                                 END
  87                         ELSIF s.char = "*" THEN
  88                                 IF s.rider.char = ")" THEN s.rider.Read; s.type := comEnd END
  89                         END
  90                 END
  91         END Scan;
  92
  93         PROCEDURE Do (source, log: TextModels.Model; beg: INTEGER; opt: SET; VAR error: BOOLEAN);
  94                 VAR s: TextMappers.Scanner;
  95         BEGIN
  96                 Dialog.MapString("#Dev:Compiling", str);
  97                 StdLog.String(str); StdLog.Char(" ");
  98                 s.ConnectTo(source); s.SetPos(beg);
  99                 Scan(s);
 100                 WHILE (s.type # TextMappers.eot) & (s.type # module) DO Scan(s) END;
 101                 IF s.type = module THEN
 102                         Scan(s);
 103                         IF s.type = TextMappers.string THEN
 104                                 StdLog.Char('"'); StdLog.String(s.string); StdLog.Char('"')
 105                         END
 106                 END;
 107                 sourceR := source.NewReader(NIL); sourceR.SetPos(beg);
 108                 Module(sourceR, opt, log, error)
 109         END Do;
 110
 111
 112         PROCEDURE Open;
 113         BEGIN
 114                 Dialog.ShowStatus("#Dev:Compiling");
 115                 StdLog.buf.Delete(0, StdLog.buf.Length())
 116         END Open;
 117
 118         PROCEDURE Close;
 119         BEGIN
 120                 StdLog.text.Append(StdLog.buf);
 121                 IF DevCPM.noerr THEN Dialog.ShowStatus("#Dev:Ok")
 122                 END;
 123                 sourceR := NIL;
 124                 Kernel.Cleanup
 125         END Close;
 126
 127         PROCEDURE Compile*;
 128                 VAR t: TextModels.Model; error: BOOLEAN;
 129         BEGIN
 130                 Open;
 131                 t := TextViews.FocusText();
 132                 IF t # NIL THEN
 133                         Do(t, StdLog.text, 0, defopt, error);
 134                         IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
 135                 ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
 136                 END;
 137                 Close
 138         END Compile;
 139
 140         PROCEDURE CompileOpt* (opt: ARRAY OF CHAR);
 141                 VAR t: TextModels.Model; error: BOOLEAN; i: INTEGER; opts: SET;
 142         BEGIN
 143                 i := 0; opts := defopt;
 144                 WHILE opt[i] # 0X DO
 145                         IF opt[i] = "-" THEN
 146                                 IF srcpos IN opts THEN EXCL(opts, srcpos)
 147                                 ELSIF allref IN opts THEN EXCL(opts, allref)
 148                                 ELSIF ref IN opts THEN EXCL(opts, ref)
 149                                 ELSE EXCL(opts, obj)
 150                                 END
 151                         ELSIF opt[i] = "!" THEN
 152                                 IF assert IN opts THEN EXCL(opts, assert)
 153                                 ELSE EXCL(opts, checks)
 154                                 END
 155                         ELSIF opt[i] = "+" THEN INCL(opts, allchecks)
 156                         ELSIF opt[i] = "?" THEN INCL(opts, hint)
 157                         ELSIF opt[i] = "@" THEN INCL(opts, errorTrap)
 158                         ELSIF opt[i] = "$" THEN INCL(opts, oberon)
 159                         END;
 160                         INC(i)
 161                 END;
 162                 Open;
 163                 t := TextViews.FocusText();
 164                 IF t # NIL THEN
 165                         Do(t, StdLog.text, 0, opts, error);
 166                         IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
 167                 ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
 168                 END;
 169                 Close
 170         END CompileOpt;
 171
 172         PROCEDURE CompileText* (text: TextModels.Model; beg: INTEGER; OUT error: BOOLEAN);
 173         BEGIN
 174                 ASSERT(text # NIL, 20); ASSERT((beg >= 0) & (beg < text.Length()), 21);
 175                 Open;
 176                 Do(text, StdLog.text, beg, defopt, error);
 177                 IF error THEN DevMarkers.ShowFirstError(text, TextViews.focusOnly) END;
 178                 Close
 179         END CompileText;
 180
 181         PROCEDURE CompileAndUnload*;
 182                 VAR t: TextModels.Model; error: BOOLEAN; mod: Kernel.Module; n: ARRAY 256 OF CHAR;
 183         BEGIN
 184                 Open;
 185                 t := TextViews.FocusText();
 186                 IF t # NIL THEN
 187                         Do(t, StdLog.text, 0, defopt, error);
 188                         IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly)
 189                         ELSE
 190                                 mod := Kernel.ThisLoadedMod(DevCPT.SelfName);
 191                                 IF mod # NIL THEN
 192                                         Kernel.UnloadMod(mod);
 193                                         n := DevCPT.SelfName$;
 194                                         IF mod.refcnt < 0 THEN
 195                                                 Dialog.MapParamString("#Dev:Unloaded", n, "", "", str);
 196                                                 StdLog.String(str); StdLog.Ln;
 197                                                 Controls.Relink
 198                                         ELSE
 199                                                 Dialog.MapParamString("#Dev:UnloadingFailed", n, "", "", str);
 200                                                 StdLog.String(str); StdLog.Ln
 201                                         END
 202                                 END
 203                         END
 204                 ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
 205                 END;
 206                 Close
 207         END CompileAndUnload;
 208
 209         PROCEDURE CompileSelection*;
 210                 VAR c: TextControllers.Controller; t: TextModels.Model; beg, end: INTEGER; error: BOOLEAN;
 211         BEGIN
 212                 Open;
 213                 c := TextControllers.Focus();
 214                 IF c # NIL THEN
 215                         t := c.text;
 216                         IF c.HasSelection() THEN
 217                                 c.GetSelection(beg, end); Do(t, StdLog.text, beg, defopt, error);
 218                                 IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
 219                         ELSE Dialog.ShowMsg("#Dev:NoSelectionFound")
 220                         END
 221                 ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
 222                 END;
 223                 Close
 224         END CompileSelection;
 225
 226         PROCEDURE CompileList (beg, end: INTEGER; c: TextControllers.Controller);
 227                 VAR v: Views.View; i: INTEGER; error, one: BOOLEAN; name: Files.Name; loc: Files.Locator;
 228                         t: TextModels.Model; opts: SET; title, entry: ARRAY 64 OF CHAR;
 229         BEGIN
 230                 s.SetPos(beg); s.Scan; one := FALSE;
 231                 WHILE (s.start < end) & (s.type = TextMappers.string) & (s.len < LEN(name)) DO
 232                         s.Scan; one := TRUE;
 233                         WHILE (s.start < end) & (s.type = TextMappers.char) &
 234                                 ((s.char = "-") OR (s.char = "+") OR
 235                                 (s.char = "!") OR (s.char = "*") OR (s.char = "?") OR (s.char = "^") OR (s.char = "("))
 236                         DO
 237                                 IF s.char = "(" THEN
 238                                         WHILE (s.start < end) & ((s.type # TextMappers.char) OR (s.char # ")")) DO s.Scan END
 239                                 END;
 240                                 s.Scan
 241                         END
 242                 END;
 243                 IF one & (s.start >= end) THEN
 244                         s.SetPos(beg); s.Scan; error := FALSE;
 245                         WHILE (s.start < end) & (s.type = TextMappers.string) & ~error DO
 246                                 i := 0; WHILE i < LEN(name) DO name[i] := 0X; INC(i) END;
 247                                 StdDialog.GetSubLoc(s.string, "Mod", loc, name);
 248                                 t := NIL;
 249                                 IF loc # NIL THEN
 250                                         v := Views.OldView(loc, name);
 251                                         IF v # NIL THEN
 252                                                 WITH v: TextViews.View DO t := v.ThisModel()
 253                                                 ELSE Dialog.ShowParamMsg("#Dev:NoTextFileFound", name, "", ""); error := TRUE
 254                                                 END
 255                                         ELSE Dialog.ShowParamMsg("#Dev:CannotOpenFile", name, "", ""); error := TRUE
 256                                         END
 257                                 ELSE Dialog.ShowParamMsg("#System:FileNotFound", name, "", ""); error := TRUE
 258                                 END;
 259                                 s.Scan; opts := defopt;
 260                                 WHILE (s.start < end) & (s.type = TextMappers.char) DO
 261                                         IF s.char = "-" THEN
 262                                                 IF srcpos IN opts THEN EXCL(opts, srcpos)
 263                                                 ELSIF allref IN opts THEN EXCL(opts, allref)
 264                                                 ELSIF ref IN opts THEN EXCL(opts, ref)
 265                                                 ELSE EXCL(opts, obj)
 266                                                 END
 267                                         ELSIF s.char = "!" THEN
 268                                                 IF assert IN opts THEN EXCL(opts, assert)
 269                                                 ELSE EXCL(opts, checks)
 270                                                 END
 271                                         ELSIF s.char = "+" THEN INCL(opts, allchecks)
 272                                         ELSIF s.char = "?" THEN INCL(opts, hint)
 273                                         ELSIF s.char = "@" THEN INCL(opts, errorTrap)
 274                                         ELSIF s.char = "$" THEN INCL(opts, oberon)
 275                                         ELSIF s.char = "(" THEN
 276                                                 s.Scan;
 277                                                 WHILE (s.start < end) & (s.type = TextMappers.string) DO
 278                                                         title := s.string$; s.Scan;
 279                                                         IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ":") THEN
 280                                                                 s.Scan;
 281                                                                 IF (s.start < end) & (s.type = TextMappers.string) THEN
 282                                                                         entry := s.string$; s.Scan;
 283                                                                         IF t # NIL THEN DevSelectors.ChangeTo(t, title, entry) END
 284                                                                 END
 285                                                         END;
 286                                                         IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ",") THEN s.Scan END
 287                                                 END
 288                                         END;
 289                                         s.Scan
 290                                 END;
 291                                 IF t # NIL THEN
 292                                         Do(t, StdLog.text, 0, opts, error)
 293                                 END
 294                         END
 295                 ELSE Dialog.ShowMsg("#Dev:NotOnlyFileNames")
 296                 END;
 297                 s.ConnectTo(NIL);
 298                 IF error & (c # NIL) & c.HasSelection() & (s.start < end) THEN
 299                         c.SetSelection(s.start, end)
 300                 END;
 301                 IF error & (v # NIL) THEN
 302                         Views.Open(v, loc, name, NIL);
 303                         DevMarkers.ShowFirstError(t, TextViews.any)
 304                 END
 305         END CompileList;
 306
 307         PROCEDURE CompileModuleList*;
 308                 VAR c: TextControllers.Controller; beg, end: INTEGER;
 309         BEGIN
 310                 Open;
 311                 c := TextControllers.Focus();
 312                 IF c # NIL THEN
 313                         s.ConnectTo(c.text);
 314                         IF c.HasSelection() THEN c.GetSelection(beg, end)
 315                         ELSE beg := 0; end := c.text.Length()
 316                         END;
 317                         CompileList(beg, end, c)
 318                 ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
 319                 END;
 320                 Close
 321         END CompileModuleList;
 322
 323         PROCEDURE CompileThis*;
 324                 VAR p: DevCommanders.Par; beg, end: INTEGER;
 325         BEGIN
 326                 Open;
 327                 p := DevCommanders.par;
 328                 IF p # NIL THEN
 329                         DevCommanders.par := NIL;
 330                         s.ConnectTo(p.text); beg := p.beg; end := p.end;
 331                         CompileList(beg, end, NIL)
 332                 ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
 333                 END;
 334                 Close
 335         END CompileThis;
 336
 337         PROCEDURE Init;
 338                 VAR loc: Files.Locator; f: Files.File;
 339         BEGIN
 340                 loc := Files.dir.This("Dev"); loc := loc.This("Code");
 341                 f := Files.dir.Old(loc, "ComDebug.ocf", TRUE);
 342                 found := f # NIL;
 343                 IF f # NIL THEN f.Close END
 344         END Init;
 345
 346 BEGIN
 347         Init
 348 END DevCompiler.