소스 검색

synchronized with original

Alexander Shiryaev 9 년 전
부모
커밋
8c56b2bf1d

+ 5 - 5
BlackBox/Po/Files/Graphics.Mod.txt

@@ -1,4 +1,4 @@
-MODULE Graphics;   (*NW 21.12.89 / 18.11.2013*)
+MODULE Graphics;   (*NW 21.12.89 / 18.11.201 / 8.4.2016*)
   IMPORT SYSTEM, Files, Modules, Fonts, (*Printer,*) Texts, Oberon;
 
   CONST NameLen* = 32; GraphFileId = 0FAX; LibFileId = 0FBX;
@@ -545,7 +545,7 @@ MODULE Graphics;   (*NW 21.12.89 / 18.11.2013*)
   BEGIN NEW(cap); new := cap; cap.do := CapMethod
   END NewCaption;
 
-  PROCEDURE CopyCaption(src, dst: Caption);
+  PROCEDURE CopyCaption(src, dst: Object);
     VAR ch: CHAR; R: Texts.Reader;
   BEGIN
     dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col;
@@ -556,7 +556,7 @@ MODULE Graphics;   (*NW 21.12.89 / 18.11.2013*)
     Texts.Append(T, TW.buf)
   END CopyCaption;
 
-  PROCEDURE ChangeCaption(obj: Caption; VAR M: Msg);
+  PROCEDURE ChangeCaption(obj: Object;  VAR M: Msg);
     VAR dx, x1, dy, y1, w, w1, h1, len: INTEGER;
       pos: LONGINT;
       ch: CHAR; patadr: INTEGER; fnt: Fonts.Font;
@@ -575,7 +575,7 @@ MODULE Graphics;   (*NW 21.12.89 / 18.11.2013*)
     END
   END ChangeCaption;
 
-  PROCEDURE CaptionSelectable(obj: Caption; x, y: INTEGER): BOOLEAN;
+  PROCEDURE CaptionSelectable(obj: Object; x, y: INTEGER): BOOLEAN;
   BEGIN
     RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h)
   END CaptionSelectable;
@@ -588,7 +588,7 @@ MODULE Graphics;   (*NW 21.12.89 / 18.11.2013*)
     obj(Caption).len := len; Texts.Append(T, TW.buf)
   END ReadCaption;
 
-  PROCEDURE WriteCaption(obj: Caption; cno: INTEGER; VAR W: Files.Rider; VAR C: Context);
+  PROCEDURE WriteCaption(obj: Object; cno: INTEGER; VAR W: Files.Rider; VAR C: Context);
     VAR ch: CHAR; fno: BYTE;
       TR: Texts.Reader;
   BEGIN

+ 2 - 2
BlackBox/Po/Files/Modules.Mod.txt

@@ -1,4 +1,4 @@
-MODULE Modules;  (*Link and load on RISC; NW 20.10.2013*)
+MODULE Modules;  (*Link and load on RISC; NW 20.10.2013 / 9.4.2016*)
   IMPORT SYSTEM, Files;
   CONST versionkey = 1X; MT = 12; DescSize = 80;
 
@@ -27,7 +27,7 @@ MODULE Modules;  (*Link and load on RISC; NW 20.10.2013*)
     RETURN Files.Old(filename)
   END ThisFile;
 
-  PROCEDURE error(n: INTEGER; name: ModuleName);
+  PROCEDURE error(n: INTEGER; name: ARRAY OF CHAR);
   BEGIN res := n; importing := name
   END error;
 

+ 47 - 52
BlackBox/Po/Files/ORG.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORG; (* NW  4.3.2016  code generator in Oberon-07 for RISC*)
+MODULE ORG; (* NW  15.4.2016  code generator in Oberon-07 for RISC*)
   IMPORT SYSTEM, Files, ORS, ORB;
   (*Code generator for Oberon compiler for RISC processor.
      Procedural interface to Parser OSAP; result in array "code".
@@ -578,17 +578,6 @@ MODULE ORG; (* NW  4.3.2016  code generator in Oberon-07 for RISC*)
     SetCC(x, relmap[op - ORS.eql])
   END IntRelation;
 
-  PROCEDURE SetRelation*(op: INTEGER; VAR x, y: Item);   (* x := x < y *)
-  BEGIN load(x);
-    IF (op = ORS.eql) OR (op = ORS.neq) THEN
-      IF y.mode = ORB.Const THEN Put1a(Cmp, x.r, x.r, y.a); DEC(RH)
-      ELSE load(y); Put0(Cmp, x.r, x.r, y.r); DEC(RH, 2)
-      END ;
-      SetCC(x, relmap[op - ORS.eql])
-    ELSE ORS.Mark("illegal relation") 
-    END
-  END SetRelation;
-
   PROCEDURE RealRelation*(op: INTEGER; VAR x, y: Item);   (* x := x < y *)
   BEGIN load(x);
     IF (y.mode = ORB.Const) & (y.a = 0) THEN DEC(RH)
@@ -633,43 +622,53 @@ MODULE ORG; (* NW  4.3.2016  code generator in Oberon-07 for RISC*)
   PROCEDURE StoreStruct*(VAR x, y: Item); (* x := y, frame = 0 *)
     VAR s, pc0: LONGINT;
   BEGIN loadAdr(x); loadAdr(y);
-    IF (x.type.form = ORB.Array) & (x.type.len > 0) THEN
-      IF y.type.len >= 0 THEN 
-        IF x.type.size = y.type.size THEN Put1a(Mov, RH, 0, (y.type.size+3) DIV 4)
-        ELSE ORS.Mark("different length/size, not implemented")
+    IF y.type.size # 0 THEN
+      IF x.type.form = ORB.Array THEN
+        IF y.type.len >= 0 THEN 
+          IF x.type.size = y.type.size THEN Put1a(Mov, RH, 0, (y.type.size+3) DIV 4)
+          ELSE ORS.Mark("different length/size, not implemented")
+          END
+        ELSE (*y  open array*) Put2(Ldr, RH, SP, y.a+4); s := y.type.base.size;  (*element size*)
+          pc0 := pc; Put3(BC, EQ, 0);
+          IF s = 1 THEN Put1(Add, RH, RH, 3); Put1(Asr, RH, RH, 2)
+          ELSIF s # 4 THEN Put1a(Mul, RH, RH, s DIV 4)
+          END ;
+          IF check THEN
+            Put1a(Mov, RH+1, 0, (x.type.size+3) DIV 4); Put0(Cmp, RH+1, RH, RH+1); Trap(GT, 3)
+          END ;
+          fix(pc0, pc + 5 - pc0)
         END
-      ELSE (*y is open array*)
-        Put2(Ldr, RH, SP, y.a+4); s := y.type.base.size;  (*element size*)
-        pc0 := pc; Put3(BC, EQ, 0);
-        IF s = 1 THEN Put1(Add, RH, RH, 3); Put1(Asr, RH, RH, 2)
-        ELSIF s # 4 THEN Put1a(Mul, RH, RH, s DIV 4)
-        END ;
-        IF check THEN
-          Put1a(Mov, RH+1, 0, (x.type.size+3) DIV 4); Put0(Cmp, RH+1, RH, RH+1); Trap(GT, 3)
-        END ;
-        fix(pc0, pc + 5 - pc0)
-      END
-    ELSIF x.type.form = ORB.Record THEN Put1a(Mov, RH, 0, x.type.size DIV 4)
-    ELSE ORS.Mark("inadmissible assignment")
+      ELSIF x.type.form = ORB.Record THEN Put1a(Mov, RH, 0, x.type.size DIV 4)
+      ELSE ORS.Mark("inadmissible assignment")
+      END ;
+      Put2(Ldr, RH+1, y.r, 0); Put1(Add, y.r, y.r, 4);
+      Put2(Str, RH+1, x.r, 0); Put1(Add, x.r, x.r, 4);
+      Put1(Sub, RH, RH, 1); Put3(BC, NE, -6)
     END ;
-    Put2(Ldr, RH+1, y.r, 0); Put1(Add, y.r, y.r, 4);
-    Put2(Str, RH+1, x.r, 0); Put1(Add, x.r, x.r, 4);
-    Put1(Sub, RH, RH, 1); Put3(BC, NE, -6); RH := 0
+    RH := 0
   END StoreStruct;
 
-  PROCEDURE CopyString*(VAR x, y: Item);  (*from x to y*)
-    VAR len: LONGINT;
-  BEGIN loadAdr(y); len := y.type.len;
-    IF len >= 0 THEN
-      IF x.b > len THEN ORS.Mark("string too long") END
-    ELSIF check THEN Put2(Ldr, RH, y.r, 4);  (*array length check*)
-      Put1(Cmp, RH, RH, x.b); Trap(NE, 3)
-    END ;
-    loadStringAdr(x);
-    Put2(Ldr, RH, x.r, 0); Put1(Add, x.r, x.r, 4);
-    Put2(Str, RH, y.r, 0); Put1(Add, y.r, y.r, 4);
-    Put1(Asr, RH, RH, 24); Put3(BC, NE, -6); DEC(RH, 2)
-  END CopyString;
+  PROCEDURE OpenArrayParam*(VAR x: Item);
+  BEGIN loadAdr(x);
+    IF x.type.len >= 0 THEN Put1a(Mov, RH, 0, x.type.len) ELSE Put2(Ldr, RH, SP, x.a+4+frame) END ;
+    incR
+  END OpenArrayParam;
+
+  PROCEDURE CopyString*(VAR x, y: Item);  (*from y to x*) 
+     VAR len, rl: LONGINT;
+   BEGIN len := x.type.len;
+     IF (len >= 0) & (y.type.form = ORB.String) & (y.b > len) THEN
+      ORS.Mark("string too long")
+    ELSE OpenArrayParam(x); rl := RH-1;
+      IF y.type.form = ORB.String THEN loadStringAdr(y)
+      ELSE loadAdr(y) (*open array of char*)
+      END;
+       IF check THEN Put1(Sub, rl, rl, 1); Trap(MI, 3) END;
+       Put2(Ldr, RH, y.r, 0); Put1(Add, y.r, y.r, 4);
+       Put2(Str, RH, x.r, 0); Put1(Add, x.r, x.r, 4);
+       Put1(Asr, RH, RH, 24); Put3(BC, NE,  -6);  RH := 0
+    END
+   END CopyString;
 
   (* Code generation for parameters *)
   
@@ -688,12 +687,6 @@ MODULE ORG; (* NW  4.3.2016  code generator in Oberon-07 for RISC*)
   BEGIN load(x)
   END ValueParam;
 
-  PROCEDURE OpenArrayParam*(VAR x: Item);
-  BEGIN loadAdr(x);
-    IF x.type.len >= 0 THEN Put1a(Mov, RH, 0, x.type.len) ELSE Put2(Ldr, RH, SP, x.a+4+frame) END ;
-    incR
-  END OpenArrayParam;
-
   PROCEDURE StringParam*(VAR x: Item);
   BEGIN loadStringAdr(x); Put1(Mov, RH, 0, x.b); incR  (*len*)
   END StringParam;
@@ -943,7 +936,9 @@ MODULE ORG; (* NW  4.3.2016  code generator in Oberon-07 for RISC*)
 
   PROCEDURE Len*(VAR x: Item);
   BEGIN
-    IF x.type.len >= 0 THEN x.mode := ORB.Const; x.a := x.type.len
+    IF x.type.len >= 0 THEN
+      IF x.mode = RegI THEN DEC(RH) END ;
+      x.mode := ORB.Const; x.a := x.type.len
     ELSE (*open array*) Put2(Ldr, RH, SP, x.a + 4 + frame); x.mode := Reg; x.r := RH; incR
     END 
   END Len;

+ 44 - 40
BlackBox/Po/Files/ORP.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*)
+MODULE ORP; (*N. Wirth 1.7.97 / 15.4.2016  Oberon compiler for RISC in Oberon-07*)
   IMPORT Texts, Oberon, ORS, ORB, ORG;
   (*Author: Niklaus Wirth, 2014.
     Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens),
@@ -169,9 +169,11 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
       IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN
         p0 := t0.dsc; p1 := t1.dsc;
         WHILE p0 # NIL DO
-          IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) & (ORD(p0.rdo) = ORD(p1.rdo)) THEN
-            IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par)) END ;
-            p0 := p0.next; p1 := p1.next
+          IF (p0.class = p1.class) &  (p0.rdo = p1.rdo) &
+            ((p0.type = p1.type) OR
+            (p0.type.form = ORB.Array) & (p1.type.form = ORB.Array) & (p0.type.len = p1.type.len) & (p0.type.base = p1.type.base) OR
+            (p0.type.form = ORB.Proc) & (p1.type.form = ORB.Proc) & EqualSignatures(p0.type, p1.type))
+          THEN p0 := p0.next; p1 := p1.next
           ELSE p0 := NIL; com := FALSE
           END
         END
@@ -180,16 +182,14 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
       RETURN com
     END EqualSignatures;
   
-  BEGIN (*Compatible Types*)
+  BEGIN (*check for assignment compatibility*)
     RETURN (t0 = t1)
-      OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & 
-        ((t0.len = t1.len)  OR (t1.len = -1)) & CompTypes(t0.base, t1.base, varpar)
-      OR (t0.form = ORB.Pointer) & (t1.form = ORB.Pointer) & IsExtension(t0.base, t1.base)
-      OR (t0.form = ORB.Record) & (t1.form = ORB.Record) & IsExtension(t0, t1)
-      OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
-      OR (t0.form IN {ORB.Pointer, ORB.Proc}) & (t1.form = ORB.NilTyp)
-      OR (t0.form = ORB.NilTyp) & (t1.form IN {ORB.Pointer, ORB.Proc})
-      OR ~varpar & (t0.form = ORB.Int) & (t1.form = ORB.Int)
+      OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & (t0.len = t1.len) & (t0.base = t1.base)
+      OR (t0.form = ORB.Record) & (t1.form = ORB.Record)  & IsExtension(t0, t1)
+      OR ~varpar &
+        ((t0.form = ORB.Pointer) & (t1.form = ORB.Pointer)  & IsExtension(t0.base, t1.base)
+        OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
+        OR (t0.form IN {ORB.Pointer, ORB.Proc}) & (t1.form = ORB.NilTyp))
   END CompTypes;
 
   PROCEDURE Parameter(par: ORB.Object);
@@ -203,16 +203,16 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
           IF ~par.rdo THEN CheckReadOnly(x) END ;
           ORG.VarParam(x, par.type)
         END
-      ELSIF ~varpar & (par.type.form = ORB.Int) & (x.type.form = ORB.Int) THEN
-        ORG.ValueParam(x) 
-      ELSIF (x.type.form = ORB.String) & (x.b = 2) & (par.class = ORB.Var) & (par.type.form = ORB.Char) THEN
-        ORG.StrToChar(x); ORG.ValueParam(x)
       ELSIF (x.type.form = ORB.Array) & (par.type.form = ORB.Array) &
-          (x.type.base.form = par.type.base.form) & (par.type.len < 0) THEN
-        ORG.OpenArrayParam(x);
+          (x.type.base = par.type.base) & (par.type.len < 0) THEN
+        ORG.OpenArrayParam(x)
       ELSIF (x.type.form = ORB.String) & varpar & par.rdo & (par.type.form = ORB.Array) & 
           (par.type.base.form = ORB.Char) & (par.type.len < 0) THEN ORG.StringParam(x)
-      ELSIF (par.type.form = ORB.Array) & (par.type.base.form = ORB.Int) & (par.type.size = x.type.size) THEN
+      ELSIF ~varpar & (par.type.form = ORB.Int) & (x.type.form = ORB.Int) THEN ORG.ValueParam(x)  (*BYTE*)
+      ELSIF (x.type.form = ORB.String) & (x.b = 2) & (par.class = ORB.Var) & (par.type.form = ORB.Char) THEN
+        ORG.StrToChar(x); ORG.ValueParam(x)
+      ELSIF (par.type.form = ORB.Array) & (par.type.base = ORB.byteType) & 
+          (par.type.len > 0) & (par.type.size = x.type.size) THEN
         ORG.VarParam(x, par.type)
       ELSE ORS.Mark("incompatible parameters")
       END
@@ -384,17 +384,20 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
   BEGIN SimpleExpression(x);
     IF (sym >= ORS.eql) & (sym <= ORS.geq) THEN
       rel := sym; ORS.Get(sym); SimpleExpression(y); xf := x.type.form; yf := y.type.form;
-      IF CompTypes(x.type, y.type, FALSE) OR
-          (xf = ORB.Pointer) & (yf = ORB.Pointer) & IsExtension(y.type.base, x.type.base) THEN
+      IF x.type = y.type THEN
         IF (xf IN {ORB.Char, ORB.Int}) THEN ORG.IntRelation(rel, x, y)
         ELSIF xf = ORB.Real THEN ORG.RealRelation(rel, x, y)
-        ELSIF xf = ORB.Set THEN ORG.SetRelation(rel, x, y)
-        ELSIF (xf IN {ORB.Pointer, ORB.Proc, ORB.NilTyp, ORB.Bool}) THEN
+        ELSIF (xf IN {ORB.Set, ORB.Pointer, ORB.Proc, ORB.NilTyp, ORB.Bool}) THEN
           IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
-        ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) OR (xf = ORB.String) THEN
-          ORG.StringRelation(rel, x, y)
+        ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char)  THEN ORG.StringRelation(rel, x, y)
         ELSE ORS.Mark("illegal comparison")
         END
+      ELSIF (xf IN {ORB.Pointer, ORB.Proc}) & (yf = ORB.NilTyp)
+          OR (yf IN {ORB.Pointer, ORB.Proc}) & (xf = ORB.NilTyp) THEN
+        IF rel <= ORS.neq THEN ORG.IntRelation(rel, x,  y) ELSE ORS.Mark("only = or #") END
+      ELSIF (xf = ORB.Pointer) & (yf = ORB.Pointer) &
+          (IsExtension(x.type.base, y.type.base) OR IsExtension(y.type.base, x.type.base)) THEN
+        IF rel <= ORS.neq THEN ORG.IntRelation(rel,  x, y) ELSE ORS.Mark("only = or #") END
       ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) &
             ((yf = ORB.String) OR (yf = ORB.Array) & (y.type.base.form = ORB.Char))
           OR (yf = ORB.Array) & (y.type.base.form = ORB.Char) & (xf = ORB.String) THEN
@@ -403,14 +406,12 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
         ORG.StrToChar(y); ORG.IntRelation(rel, x, y)
       ELSIF (yf = ORB.Char) & (xf = ORB.String) & (x.b = 2) THEN
         ORG.StrToChar(x); ORG.IntRelation(rel, x, y)
+      ELSIF (xf = ORB.Int) & (yf = ORB.Int) THEN ORG.IntRelation(rel,  x, y)  (*BYTE*)
       ELSE ORS.Mark("illegal comparison")
       END ;
       x.type := ORB.boolType
     ELSIF sym = ORS.in THEN
-      ORS.Get(sym); SimpleExpression(y);
-      IF (x.type.form = ORB.Int) & (y.type.form = ORB.Set) THEN ORG.In(x, y)
-      ELSE ORS.Mark("illegal operands of IN")
-      END ;
+      ORS.Get(sym); CheckInt(x); SimpleExpression(y); CheckSet(y); ORG.In(x, y) ;
       x.type := ORB.boolType
     ELSIF sym = ORS.is THEN
       ORS.Get(sym); qualident(obj); TypeTest(x, obj.type, FALSE) ;
@@ -493,14 +494,16 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
         ELSE selector(x);
           IF sym = ORS.becomes THEN (*assignment*)
             ORS.Get(sym); CheckReadOnly(x); expression(y);
-            IF CompTypes(x.type, y.type, FALSE) OR (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN
+            IF CompTypes(x.type, y.type, FALSE) THEN
               IF (x.type.form <= ORB.Pointer) OR (x.type.form = ORB.Proc) THEN ORG.Store(x, y)
-              ELSIF y.type.size # 0 THEN ORG.StoreStruct(x, y)
+              ELSE ORG.StoreStruct(x, y)
               END
+            ELSIF (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN ORG.Store(x, y)  (*BYTE*)
             ELSIF (x.type.form = ORB.Char) & (y.type.form = ORB.String) & (y.b = 2) THEN
               ORG.StrToChar(y); ORG.Store(x, y)
-            ELSIF (x.type.form = ORB.Array) & (x.type.base.form = ORB.Char) & 
-                (y.type.form = ORB.String) THEN ORG.CopyString(y, x)
+            ELSIF (x.type.form = ORB.Array) & (x.type.base.form = ORB.Char) & ( (y.type.form = ORB.String)
+                 OR (y.type.form = ORB.Array) & (y.type.base.form = ORB.Char) & (y.type.len = -1))  THEN
+              ORG.CopyString(x, y)
             ELSE ORS.Mark("illegal assignment")
             END
           ELSIF sym = ORS.eql THEN ORS.Mark("should be :="); ORS.Get(sym); expression(y)
@@ -608,14 +611,14 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
   BEGIN NEW(typ); typ.form := ORB.NoTyp;
     expression(x);
     IF (x.mode = ORB.Const) & (x.type.form = ORB.Int) & (x.a >= 0) THEN len := x.a
-    ELSE len := 0; ORS.Mark("not a valid length")
+    ELSE len := 1; ORS.Mark("not a valid length")
     END ;
     IF sym = ORS.of THEN ORS.Get(sym); Type(typ.base);
       IF (typ.base.form = ORB.Array) & (typ.base.len < 0) THEN ORS.Mark("dyn array not allowed") END
     ELSIF sym = ORS.comma THEN ORS.Get(sym); ArrayType(typ.base)
     ELSE ORS.Mark("missing OF"); typ.base := ORB.intType
     END ;
-    typ.size := (len * typ.base.size + 3) DIV 4 * 4 ;
+    typ.size := (len * typ.base.size + 3) DIV 4 * 4;
     typ.form := ORB.Array; typ.len := len; type := typ
   END ArrayType;
 
@@ -696,9 +699,10 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
       ptype.nofpar := nofpar; parblksize := size;
       IF sym = ORS.colon THEN  (*function*)
         ORS.Get(sym);
-        IF sym = ORS.ident THEN qualident(obj);
-          IF (obj.class = ORB.Typ) & (obj.type.form IN {ORB.Byte .. ORB.Pointer, ORB.Proc}) THEN ptype.base := obj.type
-          ELSE ORS.Mark("illegal function type")
+        IF sym = ORS.ident THEN
+          qualident(obj); ptype.base := obj.type;
+          IF ~((obj.class = ORB.Typ) & (obj.type.form IN {ORB.Byte .. ORB.Pointer, ORB.Proc})) THEN
+            ORS.Mark("illegal function type")
           END
         ELSE ORS.Mark("type identifier expected")
         END
@@ -983,7 +987,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016  Oberon compiler for RISC in Oberon-07*
     Oberon.Collect(0)
   END Compile;
 
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  7.3.2016");
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  15..4.2016");
   Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
   NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType;
   expression := expression0; Type := Type0; FormalType := FormalType0

BIN
BlackBox/Po/Mod/Graphics.odc


BIN
BlackBox/Po/Mod/Modules2.odc


BIN
BlackBox/Po/Mod/ORG.odc


BIN
BlackBox/Po/Mod/ORG3.odc


BIN
BlackBox/Po/Mod/ORP.odc


BIN
BlackBox/Po/Mod/ORP3.odc