DEADSOFTWARE

add preprocesor for condition compilation
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Sat, 14 Dec 2019 13:43:01 +0000 (16:43 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Sat, 14 Dec 2019 13:43:01 +0000 (16:43 +0300)
make-bootstrap.sh
make.sh
src/generic/Dev/Mod/CPR.cp [new file with mode: 0644]
src/generic/Dev/Mod/CPS.odc
src/generic/Dsw/Mod/Compiler486Main.cp
src/generic/Dsw/Mod/CompilerCPfrontMain.cp

index 34069ec230a6711d9cc273bbdaa3dfddd1170ccb..c3a36e66e3e699c3e28dc0cdec84ab8d4e5f6a3d 100755 (executable)
@@ -76,7 +76,7 @@ mkdir -p "$_this/bootstrap"
 make_bootstrap 486 cpfront linux
 #make_bootstrap 486 cpfront cygwin
 #make_bootstrap arm cpfront linux
-make_bootstrap powerpc cpfront osx
+#make_bootstrap powerpc cpfront osx
 
 ###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
 ### Hack: remove temp files from v0.1 ###
diff --git a/make.sh b/make.sh
index 0cd0960b2c308f9b724d2acb7e667d4f595493cf..f704a52662d522706d6fa009cdfd7d1392463828 100755 (executable)
--- a/make.sh
+++ b/make.sh
@@ -227,9 +227,9 @@ compile_all() {
   ### Compile Dev subsystem ###
   ###_______________________###
 
-  compile Dev/Mod/CPM.cp Dev/Mod/CPT.odc Dev/Mod/CPS.odc Dev/Mod/CPB.odc \
-    Dev/Mod/CPP.odc Dev/Mod/CPE.odc Dev/Mod/CPH.odc Dev/Mod/CPL486.odc \
-    Dev/Mod/CPC486.odc Dev/Mod/CPV486.odc
+  compile Dev/Mod/CPM.cp Dev/Mod/CPT.odc Dev/Mod/CPR.cp Dev/Mod/CPS.odc \
+    Dev/Mod/CPB.odc Dev/Mod/CPP.odc Dev/Mod/CPE.odc Dev/Mod/CPH.odc \
+    Dev/Mod/CPL486.odc Dev/Mod/CPC486.odc Dev/Mod/CPV486.odc
 
   ###^^^^^^^^^^^^^^^^^^^^^^^^###
   ### Compile Dev2 subsystem ###
@@ -266,7 +266,7 @@ link_all() {
     PosixCtypes PosixCmacro \
     Kernel Console Files Dates Math Strings Services Log \
     HostLang HostConsole HostFiles HostDates DswLog $_debug_module \
-    DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+    DevCPM DevCPT DevCPR DevCPS DevCPB DevCPP DevCPE DevCPH \
     DevCPL486 DevCPC486 DevCPV486 \
     DswDocuments DswCompiler486Main
 
@@ -282,7 +282,7 @@ link_all() {
     PosixCtypes PosixCmacro \
     Kernel Console Files Dates Math Strings Services Log \
     HostLang HostConsole HostFiles HostDates DswLog $_debug_module \
-    DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+    DevCPM DevCPT DevCPR DevCPS DevCPB DevCPP DevCPE DevCPH \
     CPfrontCPG CPfrontCPC CPfrontCPV\
     DswDocuments DswCompilerCPfrontMain
 
diff --git a/src/generic/Dev/Mod/CPR.cp b/src/generic/Dev/Mod/CPR.cp
new file mode 100644 (file)
index 0000000..233b121
--- /dev/null
@@ -0,0 +1,246 @@
+MODULE DevCPR;
+
+  IMPORT Strings, DevCPM, DevCPT;
+
+  CONST
+    MaxIdLen = LEN(DevCPT.Name);
+
+    (* symbol values *)
+    null = 0;
+    if = 1; then = 2; else = 3; elsif = 4; end = 5; new = 6;
+    ident = 7; plus = 8; minus = 9;
+    not = 10; and = 11; or = 12; rpar = 13; lpar = 14;
+    endcom = 15; eof = 16;
+
+  TYPE
+    Context = POINTER TO RECORD
+      next: Context; (* upper level block *)
+      alt: BOOLEAN;  (* else branch *)
+      val: BOOLEAN;  (* condition value, inverted if alt *)
+      ref: INTEGER   (* ELSIF count *)
+    END;
+
+    Selector = POINTER TO RECORD
+      next: Selector;
+      name: DevCPT.Name;
+      val: BOOLEAN
+    END;
+
+  VAR
+    ch: CHAR; (* current character *)
+    name: DevCPT.Name; (* ident *)
+
+  VAR
+    sym: BYTE; (* parser symbol *)
+    fold: INTEGER; (* condition folding *)
+    scope: Selector;
+    top: Context;
+
+  PROCEDURE err (n: SHORTINT);
+  BEGIN DevCPM.err(n)
+  END err;
+
+  PROCEDURE Identifier (VAR sym: BYTE);
+    VAR i, res: INTEGER; n: ARRAY MaxIdLen OF CHAR;
+  BEGIN i := 0;
+    REPEAT
+      n[i] := ch; INC(i); DevCPM.Get(ch)
+    UNTIL ~Strings.IsIdent(ch) OR (i = MaxIdLen);
+    IF i = MaxIdLen THEN err(240); DEC(i) END ;
+    n[i] := 0X; Strings.StringToUtf8(n, name, res); sym := ident;
+    IF res = 1 (*truncated*) THEN err(240) END
+  END Identifier;
+
+  PROCEDURE Get (VAR sym: BYTE);
+  BEGIN
+    DevCPM.errpos := DevCPM.curpos - 1;
+    WHILE (ch # DevCPM.Eot) & ((ch <= " ") OR (ch = 0A0X)) DO DevCPM.Get(ch) END;
+    DevCPM.startpos := DevCPM.curpos - 1;
+    CASE ch OF
+    | DevCPM.Eot: sym := eof
+    | "&": sym := and; DevCPM.Get(ch)
+    | "(": sym := lpar; DevCPM.Get(ch)
+    | ")": sym := rpar; DevCPM.Get(ch)
+    | "*":
+        sym := null; DevCPM.Get(ch);
+        IF ch = ">" THEN sym := endcom; DevCPM.Get(ch) END
+    | "+": sym := plus; DevCPM.Get(ch)
+    | "-": sym := minus; DevCPM.Get(ch)
+    | "E": Identifier(sym);
+        IF name = "END" THEN sym := end
+        ELSIF name = "ELSE" THEN sym := else
+        ELSIF name = "ELSIF" THEN sym := elsif
+        END
+    | "I": Identifier(sym); IF name = "IF" THEN sym := if END
+    | "N": Identifier(sym); IF name = "NEW" THEN sym := new END
+    | "O": Identifier(sym); IF name = "OR" THEN sym := or END
+    | "T": Identifier(sym); IF name = "THEN" THEN sym := then END
+    | "A".."D", "J".."M", "P".."S", "U".."Z", "a".."z", "_": Identifier(sym)
+    | "~": sym := not; DevCPM.Get(ch)
+    ELSE
+      IF Strings.IsIdent(ch) THEN Identifier(sym) ELSE sym := null; DevCPM.Get(ch) END
+    END
+  END Get;
+
+  PROCEDURE New (IN name: DevCPT.Name; val: BOOLEAN);
+    VAR s: Selector;
+  BEGIN
+    s := scope;
+    WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
+    IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := val
+    ELSE err(1)
+    END
+  END New;
+
+  PROCEDURE Old (IN name: DevCPT.Name): Selector;
+    VAR s: Selector;
+  BEGIN
+    s := scope;
+    WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
+    IF s.next = NIL THEN
+      err(0); NEW(s.next); s.next.name := name$; s.next.val := FALSE
+    END;
+    RETURN s.next
+  END Old;
+
+  PROCEDURE Find (IN name: DevCPT.Name): Selector;
+    VAR s: Selector;
+  BEGIN
+    s := scope;
+    WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
+    RETURN s.next
+  END Find;
+
+  PROCEDURE Set* (IN name: DevCPT.Name; val: BOOLEAN);
+    VAR s: Selector;
+  BEGIN
+    s := scope;
+    WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
+    IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := val END
+  END Set;
+
+  PROCEDURE ^ Expression (VAR x: BOOLEAN);
+
+  PROCEDURE Factor (VAR x: BOOLEAN);
+  BEGIN x := FALSE;
+    IF sym = ident THEN
+      x := Old(name).val; Get(sym)
+    ELSIF sym = lpar THEN
+      Get(sym); Expression(x);
+      IF sym # rpar THEN err(23)
+      ELSE Get(sym)
+      END
+    ELSIF sym = not THEN
+      Get(sym); Factor(x); x := ~x
+    ELSE
+      err(13)
+    END
+  END Factor;
+
+  PROCEDURE Term (VAR x: BOOLEAN);
+    VAR y: BOOLEAN;
+  BEGIN
+    Factor(x);
+    WHILE sym = and DO
+      Get(sym); Factor(y); x := x & y
+    END
+  END Term;
+
+  PROCEDURE Expression (VAR x: BOOLEAN);
+    VAR y: BOOLEAN;
+  BEGIN
+    Term(x);
+    WHILE sym = or DO
+      Get(sym); Term(y); x := x OR y
+    END
+  END Expression;
+
+  PROCEDURE If (cond: BOOLEAN);
+    VAR c: Context;
+  BEGIN
+    NEW(c); c.next := top; c.alt := FALSE; c.val := cond; c.ref := 0; top := c;
+    INC(fold)
+  END If;
+
+  PROCEDURE Else;
+  BEGIN
+    IF top.alt THEN err(14) (* double ELSE *)
+    ELSE top.alt := TRUE; top.val := ~top.val;
+    END
+  END Else;
+
+  PROCEDURE End;
+    VAR i, ref: INTEGER;
+  BEGIN
+    i := 0; ref := top.ref; DEC(fold, ref + 1);
+    WHILE (top # NIL) & (i <= ref) DO top := top.next; INC(i) END;
+    IF top = NIL THEN err(51); fold := 0; If(TRUE) END
+  END End;
+
+  PROCEDURE Parse*;
+    VAR val: BOOLEAN;
+  BEGIN
+    Get(sym);
+    IF sym = new THEN
+      Get(sym);
+      IF sym = ident THEN New(name, FALSE); Get(sym)
+      ELSE err(48)
+      END
+    ELSIF sym = ident THEN
+      Get(sym);
+      IF sym = plus THEN Old(name).val := TRUE; Get(sym)
+      ELSIF sym = minus THEN Old(name).val := FALSE; Get(sym)
+      ELSE err(41)
+      END
+    ELSIF sym = if THEN
+      Get(sym); Expression(val); If(val);
+      IF sym = then THEN Get(sym)
+      ELSE err(27)
+      END
+    ELSIF sym = elsif THEN
+      IF fold <= 1 THEN err(14) END; (* ELSIF without IF *)
+      Else; Get(sym); Expression(val); If(val); INC(top.ref);
+      IF sym = then THEN Get(sym)
+      ELSE err(27)
+      END
+    ELSIF sym = else THEN
+      IF fold <= 1 THEN err(14) END; (* ELSE without IF *)
+      Else; Get(sym)
+    ELSIF sym = end THEN
+      IF fold <= 1 THEN err(14) END; (* END without IF *)
+      End; Get(sym)
+    ELSE
+      err(14)
+    END;
+    IF sym # endcom THEN err(5) ELSE DevCPM.errpos := DevCPM.curpos - 1 END
+  END Parse;
+
+  PROCEDURE Printable* (): BOOLEAN;
+    VAR c: Context;
+  BEGIN
+    c := top;
+    WHILE (c # NIL) & c.val DO c := c.next END;
+    RETURN c = NIL
+  END Printable;
+
+  PROCEDURE Check*;
+  BEGIN
+    IF fold # 1 THEN err(14) END
+  END Check;
+
+  PROCEDURE Close*;
+  BEGIN
+    ch := " "; sym := eof; name := "";
+    fold := 0; top := NIL; scope := NIL
+  END Close;
+
+  PROCEDURE Init*;
+  BEGIN
+    Close;
+    If(TRUE);
+    NEW(scope);
+    New("TRUE", TRUE);
+    New("FALSE", FALSE)
+  END Init;
+
+END DevCPR.
index 0254946eaebd3165806db33c989e8ab149395876..4d46b3f62ca4739e242b658df8627c5908f3a04f 100644 (file)
Binary files a/src/generic/Dev/Mod/CPS.odc and b/src/generic/Dev/Mod/CPS.odc differ
index 1797a6daea7243ad6e985d42520b5313a4e42300..5461907738b518d28937737892394e19b1a00c6f 100644 (file)
@@ -2,7 +2,7 @@ MODULE DswCompiler486Main;
 
   IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments,
     DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPV := DevCPV486, DevCPS,
-    DevCPH;
+    DevCPH, DevCPR;
 
   CONST
     (* compiler options: *)
@@ -28,8 +28,15 @@ MODULE DswCompiler486Main;
       next: Elem
     END;
 
+    Def = POINTER TO RECORD
+      name: DevCPT.Name;
+      val: BOOLEAN;
+      next: Def
+    END;
+
   VAR
     u: Elem;
+    d: Def;
 
   PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
     VAR i, j, len: INTEGER;
@@ -72,6 +79,12 @@ MODULE DswCompiler486Main;
       END
     END Check;
 
+    PROCEDURE Define (IN name: DevCPT.Name; val: BOOLEAN);
+      VAR def: Def;
+    BEGIN
+      NEW(def); def.name := name$; def.val := val; def.next := d; d := def
+    END Define;
+
   BEGIN
     outsym := ""; outcode := "";
     opts := defopt; opts2 := defopt2; found := FALSE;
@@ -177,6 +190,10 @@ MODULE DswCompiler486Main;
           INCL(opts, ctime)
         ELSIF p = "-no-use-time" THEN
           EXCL(opts, ctime)
+        ELSIF p = "-define+" THEN
+          Check; Define(Kernel.argv[i]$, TRUE); INC(i)
+        ELSIF p = "-define-" THEN
+          Check; Define(Kernel.argv[i]$, FALSE); INC(i)
         ELSE
           Console.WriteStr("unknown option ");
           Console.WriteStr(p); Console.WriteLn;
@@ -205,7 +222,7 @@ MODULE DswCompiler486Main;
   END InitOptions;
 
   PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN);
-    VAR ext, new: BOOLEAN; p: DevCPT.Node;
+    VAR ext, new: BOOLEAN; p: DevCPT.Node; def: Def;
   BEGIN
     DevCPM.Init(source);
     DevCPM.symList := m.insym;
@@ -218,7 +235,14 @@ MODULE DswCompiler486Main;
     DevCPT.Init(m.opts);
     DevCPB.typSize := DevCPV.TypeSize;
     DevCPT.processor := DevCPV.processor;
+    DevCPR.Init;
+    def := d;
+    WHILE def # NIL DO
+      DevCPR.Set(def.name, def.val);
+      def := def.next
+    END;
     DevCPP.Module(p);
+    DevCPR.Check;
     IF DevCPM.noerr THEN
       IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
       DevCPV.Init(m.opts); DevCPV.Allocate; DevCPT.Export(ext, new);
@@ -233,6 +257,7 @@ MODULE DswCompiler486Main;
     IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
     ELSE DevCPM.DeleteNewSym
     END;
+    DevCPR.Close;
     DevCPT.Close;
     error := ~DevCPM.noerr;
     IF error THEN
index 462e3fe7e146868b259308d9d9ba69cae120dc21..bf5bb1b69fe186c12fb0be1219f6378b9a762f68 100644 (file)
@@ -1,7 +1,8 @@
 MODULE DswCompilerCPfrontMain;
 
   IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments,
-    DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPH, DevCPV := CPfrontCPV, DevCPG := CPfrontCPG;
+    DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPH, DevCPV := CPfrontCPV, DevCPG := CPfrontCPG,
+    DevCPR;
 
   CONST
     (* compiler options: *)
@@ -28,8 +29,15 @@ MODULE DswCompilerCPfrontMain;
       next: Elem
     END;
 
+    Def = POINTER TO RECORD
+      name: DevCPT.Name;
+      val: BOOLEAN;
+      next: Def
+    END;
+
   VAR
     u: Elem;
+    d: Def;
 
   PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
     VAR i, j, len: INTEGER;
@@ -72,6 +80,12 @@ MODULE DswCompilerCPfrontMain;
       END
     END Check;
 
+    PROCEDURE Define (IN name: DevCPT.Name; val: BOOLEAN);
+      VAR def: Def;
+    BEGIN
+      NEW(def); def.name := name$; def.val := val; def.next := d; d := def
+    END Define;
+
   BEGIN
     outsym := ""; outcode := "";
     opts := defopt; opts2 := defopt2; found := FALSE;
@@ -177,6 +191,10 @@ MODULE DswCompilerCPfrontMain;
           INCL(opts, ctime)
         ELSIF p = "-no-use-time" THEN
           EXCL(opts, ctime)
+        ELSIF p = "-define+" THEN
+          Check; Define(Kernel.argv[i]$, TRUE); INC(i)
+        ELSIF p = "-define-" THEN
+          Check; Define(Kernel.argv[i]$, FALSE); INC(i)
         ELSE
           Console.WriteStr("unknown option ");
           Console.WriteStr(p); Console.WriteLn;
@@ -205,7 +223,7 @@ MODULE DswCompilerCPfrontMain;
   END InitOptions;
 
   PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN);
-    VAR ext, new: BOOLEAN; p: DevCPT.Node;
+    VAR ext, new: BOOLEAN; p: DevCPT.Node; def: Def;
   BEGIN
     DevCPG.opt := {}; (* !!! *)
     DevCPM.Init(source);
@@ -226,7 +244,14 @@ MODULE DswCompilerCPfrontMain;
     (* DevCPB.typSize := DevCPV.TypeSize; *)
     DevCPB.typSize := DevCPV.TypSize;
     DevCPT.processor := DevCPV.processor;
+    DevCPR.Init;
+    def := d;
+    WHILE def # NIL DO
+      DevCPR.Set(def.name, def.val);
+      def := def.next
+    END;
     DevCPP.Module(p);
+    DevCPR.Check;
     IF DevCPM.noerr THEN
       IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
       DevCPV.Init(m.opts); DevCPV.AdrAndSize(DevCPT.topScope); DevCPT.Export(ext, new);
@@ -252,6 +277,7 @@ MODULE DswCompilerCPfrontMain;
     IF obj IN m.opts THEN
       DevCPG.CloseFiles
     END;
+    DevCPR.Close;
     DevCPT.Close;
     error := ~DevCPM.noerr;
     IF error THEN