DEADSOFTWARE

Исправлены опережающие объявления локальных типов-записей, добавлены модули Oberon...
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Fri, 15 Sep 2017 14:44:37 +0000 (17:44 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Fri, 15 Sep 2017 14:44:37 +0000 (17:44 +0300)
Test.obn
obn-run-tests.sh
rtl/Oberon.obn [new file with mode: 0644]
rtl/java/Args.java [new file with mode: 0644]
rtl/java/Args.obn [new file with mode: 0644]
rtl/java/Files.java
rtl/java/Launcher.java
rtl/java/SYSTEM.java
src/backends/jvm/generator-jvm.c
src/oberon.c
tests/Test27.obn [new file with mode: 0644]

index 8aea2558a93efbec45e4a9117831ef6c41a9542a..ecfde58b9f0e5fadb5eb6a9a884a62ede7a56351 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,17 +1,21 @@
 MODULE Test;
 
 TYPE
-  Elem = POINTER TO ElemDesc;
-  ElemDesc = RECORD END;
+  A = POINTER TO RECORD B : B; END;
 
-  ElemMsg = RECORD END;
-  CopyMsg = RECORD (ElemMsg) a : Elem; END;
+  B = POINTER TO RECORD x : A END;
 
-  Alien = POINTER TO RECORD (ElemDesc) END;
+VAR
+  a : A;
 
-PROCEDURE HandleAlien (VAR msg: ElemMsg);
+PROCEDURE Do;
+  TYPE
+    ListPtr = POINTER TO ListNode;
+    ListNode = RECORD next: ListPtr END;
 BEGIN
-  WITH msg: CopyMsg DO msg.a := NIL END
-END HandleAlien;
+END Do;
 
+BEGIN
+  NEW(a);
+  a.B := NIL;
 END Test.
index a5ea198e6c09ce5ef57e8f2778aa5da9de9e63af..88b5c6d36d66c0d2ce7a434b87809fa27e7a79df 100755 (executable)
@@ -99,3 +99,4 @@ makefail Test23B
 maketest Test24
 maketest Test25
 maketest Test26
+maketest Test27
diff --git a/rtl/Oberon.obn b/rtl/Oberon.obn
new file mode 100644 (file)
index 0000000..6282f4e
--- /dev/null
@@ -0,0 +1,67 @@
+MODULE Oberon;
+
+  IMPORT Args, Texts, Out;
+
+  TYPE
+    ParList* = POINTER TO ParRec;
+    ParRec* = RECORD
+      text*: Texts.Text;
+      pos*: LONGINT
+    END;
+
+  VAR
+    Log*: Texts.Text;
+    Par*: ParList;
+
+    R: Texts.Reader;
+    W: Texts.Writer;
+
+(*
+PROCEDURE GetClock* (VAR t, d: LONGINT);
+
+PROCEDURE Time* (): LONGINT;
+*)
+
+PROCEDURE PopulateParams;
+  VAR W: Texts.Writer; i: INTEGER; str: ARRAY 256 OF CHAR;
+BEGIN
+  Texts.OpenWriter(W);
+  i := 1;
+  WHILE i < Args.count DO
+    Args.GetArg(i, str); Texts.WriteString(W, str); Texts.Write(W, " ");
+    INC(i)
+  END;
+  Texts.Append(Par.text, W.buf);
+END PopulateParams;
+
+PROCEDURE GetSelection*(VAR text: Texts.Text; VAR beg, end, time: LONGINT);
+BEGIN text := NIL; beg := 0; end := 0; time := 0
+END GetSelection;
+
+(* --- Notifier for echoing to the comsole all text appended to the log. --- *)
+PROCEDURE LogNotifier(Log: Texts.Text; op: INTEGER; beg, end: LONGINT);
+  VAR ch: CHAR;
+BEGIN
+  Texts.OpenReader(R, Log, beg);
+  WHILE ~R.eot & (beg < end) DO
+    Texts.Read(R, ch);
+    IF ch = 0DX THEN Out.Ln ELSE Out.Char(ch) END;
+    INC(beg)
+  END
+END LogNotifier;
+
+PROCEDURE StubNotifier(T: Texts.Text; op: INTEGER; beg, end: LONGINT);
+BEGIN
+END StubNotifier;
+
+BEGIN
+  NEW(Par);
+  NEW(Par.text);
+  Par.text.notify := StubNotifier;
+  Par.pos := 0;
+  Texts.Open(Par.text, "");
+  PopulateParams;
+  NEW(Log);
+  Texts.Open(Log, "");
+  Log.notify := LogNotifier;
+END Oberon.
diff --git a/rtl/java/Args.java b/rtl/java/Args.java
new file mode 100644 (file)
index 0000000..9187968
--- /dev/null
@@ -0,0 +1,15 @@
+public class Args
+{
+       public static String[] args;
+       public static int[] count = new int[1];
+
+       public static void GetArg(int i, byte[][] s, int $)
+       {
+               SYSTEM.COPY(args[i], s[$]);
+       }
+
+       public static void BEGIN()
+       {
+               count[0] = args.length;
+       }
+}
diff --git a/rtl/java/Args.obn b/rtl/java/Args.obn
new file mode 100644 (file)
index 0000000..d806860
--- /dev/null
@@ -0,0 +1,10 @@
+MODULE Args;
+
+  VAR
+    count- : LONGINT;
+
+  PROCEDURE GetArg* (i : LONGINT; VAR s : ARRAY OF CHAR);
+  BEGIN
+  END GetArg;
+
+END Args.
index 5ccfa25acacc8822278fce3aa1f2039837e6fd59..9864ca57c1d7a26e4ab3981afc5b8cb13cad281e 100644 (file)
@@ -99,8 +99,9 @@ class Files
 
                try
                {
-                       filepath = File.createTempFile(SYSTEM.STRING(name), "tmp");
-                       fileregpath = new File(SYSTEM.STRING(name));
+                       String s = (name[0] == 0) ? (".TMP") : SYSTEM.STRING(name);
+                       filepath = File.createTempFile(s, "tmp");
+                       fileregpath = new File(s);
                        filedesc = new RandomAccessFile(filepath, "rw");
                }
                catch(IOException e)
index 5077fa884a1620022ba77acc0ca4f32b1d7467a2..a49e32840ddb95efb76a6b743cd5b44de52d8328 100644 (file)
@@ -10,6 +10,7 @@ class Launcher
                        NoSuchMethodException,
                        InvocationTargetException
        {
+               Args.args = args;
                Class<?> module = Class.forName(args[0]);
                Method begin = module.getMethod("BEGIN");
                begin.invoke(null);
index d3e1ae2e013e14d4fa67dd37104805b6922b36c5..e1105c0aa3abd3c9fb3c5efe2253550300cf7bb5 100644 (file)
@@ -39,6 +39,11 @@ public class SYSTEM
                v[i] = 0;
        }
 
+       public static void COPY(String x, byte[] v)
+       {
+               COPY(x.getBytes(), v);
+       }
+
        public static int STRCMP(byte[] a, byte[] b)
        {
                int i = 0;
index 91b82bf8c0465f99626d544d4f787421a15d0e23..26a0b55e829ed8ee735b5e5eecdc9bba3c31c1e4 100644 (file)
@@ -605,7 +605,7 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
                t -> postfix = jvm_get_postfix(type);
        }
 
-       if(type -> class == OBERON_TYPE_POINTER ||
+       if((type -> class == OBERON_TYPE_POINTER && type -> base -> class == OBERON_TYPE_RECORD) ||
                type -> class == OBERON_TYPE_PROCEDURE ||
                type -> class == OBERON_TYPE_RECORD ||
                type -> class == OBERON_TYPE_SYSTEM_PTR)
index 58823246bde98fb0e9ebedd171d7fe24e85659c4..04eaf8c8fd29e32e6b5318db2981e64d2a02b2cd 100644 (file)
@@ -2631,9 +2631,8 @@ oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec, oberon_scope_t *
 static void
 oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
 {
-       oberon_scope_t * modscope = ctx -> mod -> decl; 
        oberon_scope_t * oldscope = ctx -> decl;
-       ctx -> decl = modscope;
+       ctx -> decl = oldscope;
 
        if(ctx -> token == LPAREN)
        {
@@ -2674,11 +2673,11 @@ oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
        this_scope -> parent = NULL;
        this_scope -> parent_type = rec;
 
-       oberon_field_list(ctx, rec, modscope);
+       oberon_field_list(ctx, rec, oldscope);
        while(ctx -> token == SEMICOLON)
        {
                oberon_assert_token(ctx, SEMICOLON);
-               oberon_field_list(ctx, rec, modscope);
+               oberon_field_list(ctx, rec, oldscope);
        }
 
        rec -> scope = this_scope;
diff --git a/tests/Test27.obn b/tests/Test27.obn
new file mode 100644 (file)
index 0000000..00db408
--- /dev/null
@@ -0,0 +1,23 @@
+MODULE Test27;
+
+TYPE
+  A = POINTER TO RECORD B : B; END;
+
+  B = POINTER TO RECORD x : A END;
+
+VAR
+  a : A;
+
+PROCEDURE Do;
+  TYPE
+    ListPtr = POINTER TO ListNode;
+    ListNode = RECORD next: ListPtr END;
+BEGIN
+END Do;
+
+BEGIN
+  NEW(a);
+  a.B := NIL;
+END Test27.
+
+Тест опережающего объявления локальных типов.