WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Source/DECL.ob07

 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
     This file is part of Compiler.
   IDMOD = 1; IDCONST = 2; IDTYPE = 3; IDVAR = 4; IDPROC = 5; IDSTPROC = 6; IDGUARD = 7; IDPARAM = 8; IDSYSPROC = 9;
   stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8;
   stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15;
   stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22;
-  stBITS = 23; stLSR = 24; stLENGTH = 25;
+  stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27;
   sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105;
-  sysCODE = 106; sysTYPEID = 107; sysMOVE = 108;
+  sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109;
 PROCEDURE Check*(key: INTEGER);
 VAR code: INTEGER;
 BEGIN
   IF SCAN.tLex # key THEN
     CASE key OF
-    |lxMODULE:	code := 21
+    |lxMODULE:  code := 21
-    |lxIDENT:	code := 22
+    |lxIDENT:   code := 22
-    |lxSemi:	code := 23
+    |lxSemi:    code := 23
-    |lxEND:	code := 24
+    |lxEND:     code := 24
-    |lxDot:	code := 25
+    |lxDot:     code := 25
-    |lxEQ:	code := 35
+    |lxEQ:      code := 35
-    |lxRRound:	code := 38
+    |lxRRound:  code := 38
-    |lxTO:	code := 40
+    |lxTO:      code := 40
-    |lxOF:	code := 41
+    |lxOF:      code := 41
-    |lxRCurly:	code := 51
+    |lxRCurly:  code := 51
-    |lxLRound:	code := 56
+    |lxLRound:  code := 56
-    |lxComma:	code := 61
+    |lxComma:   code := 61
-    |lxTHEN:	code := 98
+    |lxTHEN:    code := 98
     |lxRSquare: code := 109
-    |lxDO:	code := 118
+    |lxDO:      code := 118
-    |lxUNTIL:	code := 119
+    |lxUNTIL:   code := 119
-    |lxAssign:	code := 120
+    |lxAssign:  code := 120
-    |lxRETURN:	code := 124
+    |lxRETURN:  code := 124
-    |lxColon:	code := 157
+    |lxColon:   code := 157
     ELSE
     END;
     Assert2(FALSE, code)
   END
 END Check;
 END PushSysType;
 PROCEDURE StIdent;
 BEGIN
   Guard;
-  PushStProc("ABS",	 stABS);
+  PushStProc("ABS",      stABS);
-  PushStProc("ASR",	 stASR);
+  PushStProc("ASR",      stASR);
-  PushStProc("ASSERT",	 stASSERT);
+  PushStProc("ASSERT",   stASSERT);
   PushStType("BOOLEAN",  TBOOLEAN);
-  PushStType("CHAR",	 TCHAR);
+  PushStType("CHAR",     TCHAR);
-  PushStProc("CHR",	 stCHR);
+  PushStProc("CHR",      stCHR);
-  PushStProc("COPY",	 stCOPY);
+  PushStProc("COPY",     stCOPY);
-  PushStProc("DEC",	 stDEC);
+  PushStProc("DEC",      stDEC);
   PushStProc("DISPOSE",  stDISPOSE);
-  PushStProc("EXCL",	 stEXCL);
+  PushStProc("EXCL",     stEXCL);
-  PushStProc("FLOOR",	 stFLOOR);
+  PushStProc("FLOOR",    stFLOOR);
-  PushStProc("FLT",	 stFLT);
+  PushStProc("FLT",      stFLT);
-  PushStProc("INC",	 stINC);
+  PushStProc("INC",      stINC);
-  PushStProc("INCL",	 stINCL);
+  PushStProc("INCL",     stINCL);
   PushStType("INTEGER",  TINTEGER);
-  PushStProc("LEN",	 stLEN);
+  PushStProc("LEN",      stLEN);
-  PushStProc("LSL",	 stLSL);
+  PushStProc("LSL",      stLSL);
-  PushStProc("LONG",	 stLONG);
+  PushStProc("LONG",     stLONG);
   PushStType("LONGREAL", TLONGREAL);
-  PushStProc("NEW",	 stNEW);
+  PushStProc("NEW",      stNEW);
-  PushStProc("ODD",	 stODD);
+  PushStProc("ODD",      stODD);
-  PushStProc("ORD",	 stORD);
+  PushStProc("ORD",      stORD);
-  PushStProc("PACK",	 stPACK);
+  PushStProc("PACK",     stPACK);
-  PushStType("REAL",	 TREAL);
+  PushStType("REAL",     TREAL);
-  PushStProc("ROR",	 stROR);
+  PushStProc("ROR",      stROR);
-  PushStType("SET",	 TSET);
+  PushStType("SET",      TSET);
-  PushStProc("SHORT",	 stSHORT);
+  PushStProc("SHORT",    stSHORT);
-  PushStProc("UNPK",	 stUNPK);
+  PushStProc("UNPK",     stUNPK);
-  PushStProc("BITS",	 stBITS);
+  PushStProc("BITS",     stBITS);
-  PushStProc("LSR",	 stLSR);
+  PushStProc("LSR",      stLSR);
+  PushStProc("LENGTH",   stLENGTH);
+  PushStProc("MIN",      stMIN);
-  PushStProc("LENGTH",	 stLENGTH);
+  PushStProc("MAX",      stMAX);
   Guard
 END StIdent;
   res := NIL;
   cur := Unit.IdentBegin.Next(IDENT);
   WHILE (cur # NIL) & (cur.iType # IDGUARD) DO
     IF cur.Name = Name THEN
       IF (Unit # unit) & ~cur.Export THEN
-	res := NIL
+        res := NIL
       ELSE
-	res := cur
+        res := cur
       END;
       cur := NIL
     ELSE
       cur := cur.Next(IDENT)
     END
     Assert(~((Op = lxSlash) & (Ta.tType = TINTEGER)), coord, 37);
     IF Ta.tType IN TNUM THEN
       Res := Arith(a, b, Ta, Op, coord)
     ELSIF Ta.tType = TSET THEN
       CASE Op OF
-      |lxPlus:	Res := LONG(FLT(ORD(BITS(ai) + BITS(bi))))
+      |lxPlus:  Res := LONG(FLT(ORD(BITS(ai) + BITS(bi))))
       |lxMinus: Res := LONG(FLT(ORD(BITS(ai) - BITS(bi))))
-      |lxMult:	Res := LONG(FLT(ORD(BITS(ai) * BITS(bi))))
+      |lxMult:  Res := LONG(FLT(ORD(BITS(ai) * BITS(bi))))
       |lxSlash: Res := LONG(FLT(ORD(BITS(ai) / BITS(bi))))
       ELSE
       END
     ELSE
       Assert(FALSE, coord, 37)
       NextCheck(lxIDENT);
       Name := SCAN.id;
       NamePtrBase := Name;
       id := GetQIdent(Unit, Name);
       IF Unit # unit THEN
-	Assert2(id # NIL, 42);
+        Assert2(id # NIL, 42);
-	Assert2(id.iType = IDTYPE, 77);
+        Assert2(id.iType = IDTYPE, 77);
-	Coord(coord);
+        Coord(coord);
-	Next;
+        Next;
-	Res := id.T
+        Res := id.T
       ELSE
-	IF id = NIL THEN
+        IF id = NIL THEN
-	  Assert2((unit.Level = 3) & unit.typedecl, 42);
+          Assert2((unit.Level = 3) & unit.typedecl, 42);
-	  Coord(coord);
+          Coord(coord);
-	  Next;
+          Next;
-	  Res := NIL
+          Res := NIL
-	ELSE
+        ELSE
-	  Assert2(id.iType = IDTYPE, 77);
+          Assert2(id.iType = IDTYPE, 77);
-	  Coord(coord);
+          Coord(coord);
-	  Next;
+          Next;
-	  Res := id.T
+          Res := id.T
-	END
+        END
       END
     ELSE
       Assert2(FALSE, 77)
     END
   END
   END;
   WHILE cur # NIL DO
     cur.T := Tf;
     IF Rec THEN
       IF Tf.Align > Tr.Align THEN
-	Tr.Align := Tf.Align
+        Tr.Align := Tf.Align
       END;
       IF Tr.Rec = record THEN
-	cur.Offset := FieldOffset(Tf.Align, Tr.Size);
+        cur.Offset := FieldOffset(Tf.Align, Tr.Size);
-	Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
+        Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
-	Tr.Size := cur.Offset + Tf.Size
+        Tr.Size := cur.Offset + Tf.Size
       ELSIF Tr.Rec = noalign THEN
-	cur.Offset := FieldOffset(1, Tr.Size);
+        cur.Offset := FieldOffset(1, Tr.Size);
-	Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
+        Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83);
-	Tr.Size := cur.Offset + Tf.Size
+        Tr.Size := cur.Offset + Tf.Size
       ELSIF Tr.Rec = union THEN
-	IF Tf.Size > Tr.Size THEN
+        IF Tf.Size > Tr.Size THEN
-	  Tr.Size := Tf.Size
+          Tr.Size := Tf.Size
-	END;
+        END;
-	cur.Offset := 0
+        cur.Offset := 0
       END
     ELSE
       Tr.Len := Tr.Len + 4 * (ORD((Tf.tType = TRECORD) & cur.ByRef) + Dim(Tf) + ORD((Tf.tType = TLONGREAL) & ~cur.ByRef) + 1)
     END;
     cur := cur.Next(FIELD)
   res := TRUE;
   WHILE (T # NIL) & res DO
     field := GetField(T, Name);
     IF field # NIL THEN
       IF (field.Unit = unit) OR field.Export THEN
-	res := FALSE
+        res := FALSE
       END
     END;
     T := T.Base
   END
   RETURN res
 END Unique;
 PROCEDURE notrecurs(id: BOOLEAN; T: pTYPE): BOOLEAN;
   RETURN ~(id & (unit.Idents.Last(IDENT).iType = IDTYPE) & (unit.Idents.Last(IDENT).T = T) &
-	  (T.tType IN TSTRUCT))
+          (T.tType IN TSTRUCT))
 END notrecurs;
 PROCEDURE ReadFields(T: pTYPE);
       Tf:= pParseType(coord);
       Assert(Tf # NIL, coord, 42);
       Assert(notrecurs(id_T, Tf), coord, 96);
       SetFields(T, Tf, TRUE);
       IF SCAN.tLex = lxSemi THEN
-	NextCheck(lxIDENT)
+        NextCheck(lxIDENT)
       ELSE
-	Assert2(SCAN.tLex = lxEND, 86)
+        Assert2(SCAN.tLex = lxEND, 86)
       END
     ELSE
       Assert2(FALSE, 85)
     END
   END
       ProgSize := ProgSize + n;
       Assert2(ProgSize <= SCAN.maxINT - UTILS.Align(ProgSize), 93);
       ProgSize := ProgSize + UTILS.Align(ProgSize)
     ELSE
       IF cur.VarKind = 0 THEN
-	cur.Offset := curBlock.ParamSize - curBlock.VarSize - n
+        cur.Offset := curBlock.ParamSize - curBlock.VarSize - n
       ELSE
-	cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD)))
+        cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD)))
       END
     END;
     Assert2(curBlock.VarSize <= SCAN.maxINT - n, 93);
     curBlock.VarSize := curBlock.VarSize + n;
     Assert2(curBlock.VarSize <= SCAN.maxINT - UTILS.Align(curBlock.VarSize), 93);
     IF proc THEN
       PushIdent(Name, coord, IDVAR, NIL, NIL, FALSE, 0);
       INC(curBlock.ParamCount);
       fp := unit.Idents.Last(IDENT);
       IF ByRef THEN
-	fp.VarKind := paramvar
+        fp.VarKind := paramvar
       ELSE
-	fp.VarKind := param
+        fp.VarKind := param
       END
     END;
     Next;
     IF SCAN.tLex = lxComma THEN
       NextCheck(lxIDENT)
       Next;
       Tf := FormalType(coord);
       Assert(Dim(Tf) <= X86.ADIM, coord, 110);
       SetFields(T, Tf, FALSE);
       IF proc THEN
-	SetVars(Tf)
+        SetVars(Tf)
       END;
       cont := FALSE
     ELSE
       Assert2(FALSE, 85)
     END
   IF (SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxVAR) THEN
     break := FALSE;
     REPEAT
       Section(T);
       IF SCAN.tLex = lxSemi THEN
-	Next
+        Next
       ELSE
-	break := TRUE
+        break := TRUE
       END
     UNTIL break
   END
 END ParamType;
     IF SCAN.tLex = lxLRound THEN
       NextCoord(coord2);
       Check(lxIDENT);
       nov.Base := IdType(coord);
       Assert(nov.Base # NIL, coord, 42);
+      IF (nov.Base.tType = TPOINTER) & (nov.Base.Base.tType = TRECORD) THEN
+          nov.Base := nov.Base.Base
+      END;
       Assert(nov.Base.tType = TRECORD, coord, 80);
       Assert(notrecurs(TRUE, nov.Base), coord, 96);
       nov.Size := nov.Base.Size;
       nov.Align := nov.Base.Align;
       Check(lxRRound);
       IdentDef;
       PushIdent(Name, coord, IDTYPE, NIL, NIL, Export, 0);
       last := unit.Idents.Last(IDENT);
       Check(lxEQ);
       Next;
+      IF SCAN.tLex = lxIDENT THEN
+        last.T := ParseType(coord)
+      ELSE
-      NEW(NewType);
+        NEW(NewType);
-      MemErr(NewType = NIL);
+        MemErr(NewType = NIL);
-      last.T := NewType;
+        last.T := NewType;
-      T := StructType(FALSE, NewType);
+        T := StructType(FALSE, NewType)
+      END;
       Check(lxSemi);
       Next
     END
   END;
   LinkPtr;
     Next;
     WHILE SCAN.tLex = lxIDENT DO
       IdentDef;
       PushIdent(Name, coord, IDVAR, NIL, NIL, Export, 0);
       IF SCAN.tLex = lxComma THEN
-	NextCheck(lxIDENT)
+        NextCheck(lxIDENT)
       ELSIF SCAN.tLex = lxColon THEN
-	NextCoord(coord);
+        NextCoord(coord);
-	T := ParseType(coord);
+        T := ParseType(coord);
-	Assert(T # NIL, coord, 42);
+        Assert(T # NIL, coord, 42);
-	SetVars(T);
+        SetVars(T);
-	Check(lxSemi);
+        Check(lxSemi);
-	Next
+        Next
       ELSE
-	Assert2(FALSE, 85)
+        Assert2(FALSE, 85)
       END
     END
   END;
   WHILE SCAN.tLex = lxPROCEDURE DO
     NextCoord(coord);
     id := unit.Idents.Last(IDENT);
     addproc;
     id.Proc := curproc;
     IF id.Export & main THEN
       IF Platform IN {1, 6} THEN
-	curproc.used := TRUE;
+        curproc.used := TRUE;
-	Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133)
+        Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133)
       END;
       X86.ProcExport(id.Number, Name, X86.NewLabel())
     END;
     id.Parent := curBlock;
     curBlock := id;
       UTILS.UnitLine(UnitNumber, SCAN.coord.line);
       NextCoord(coord);
       Expr(e);
       Assert(AssComp(e, curBlock.T.Base, FALSE), coord, 125);
       IF e.eType = eVAR THEN
-	X86.Load(e.T.tType)
+        X86.Load(e.T.tType)
       END
     ELSE
       Assert2(SCAN.tLex # lxRETURN, 123)
     END;
     Check(lxEND);
     IF u = NIL THEN
       self := unit;
       SCAN.Backup(unit.scanner);
       COPY(name.Name, FName);
       IF ~((~self.Std & pReadModule(Path, FName, UTILS.Ext)) OR pReadModule(Std, FName, UTILS.Ext)) THEN
-	IF FName = "SYSTEM" THEN
+        IF FName = "SYSTEM" THEN
-	  unit := sys;
+          unit := sys;
-	  self.sys := TRUE
+          self.sys := TRUE
-	ELSE
+        ELSE
-	  Assert(FALSE, namecoord, 32)
+          Assert(FALSE, namecoord, 32)
-	END
+        END
       END;
       SCAN.Recover(self.scanner);
       u := unit;
       unit := self;
       UTILS.SetFile(unit.File)
   cond := 0;
   WHILE cond # 4 DO
     Next;
     CASE cond OF
     |0: Check(lxIDENT);
-	name := SCAN.id;
+        name := SCAN.id;
-	Coord(coord);
+        Coord(coord);
-	Coord(namecoord);
+        Coord(namecoord);
-	alias := name;
+        alias := name;
-	cond := 1
+        cond := 1
     |1: CASE SCAN.tLex OF
-	|lxComma:  AddUnit(0)
+        |lxComma:  AddUnit(0)
-	|lxSemi:   AddUnit(4); Next
+        |lxSemi:   AddUnit(4); Next
-	|lxAssign: cond := 2
+        |lxAssign: cond := 2
-	ELSE
+        ELSE
-	  Assert2(FALSE, 28)
+          Assert2(FALSE, 28)
-	END
+        END
     |2: Check(lxIDENT);
-	name := SCAN.id;
+        name := SCAN.id;
-	Coord(namecoord);
+        Coord(namecoord);
-	cond := 3
+        cond := 3
     |3: CASE SCAN.tLex OF
-	|lxComma: AddUnit(0)
+        |lxComma: AddUnit(0)
-	|lxSemi:  AddUnit(4); Next
+        |lxSemi:  AddUnit(4); Next
-	ELSE
+        ELSE
-	  Assert2(FALSE, 29)
+          Assert2(FALSE, 29)
-	END
+        END
     ELSE
     END
   END
 END ImportList;
 PROCEDURE Pseudo;
 VAR temp: UNIT;
 BEGIN
   temp := unit;
   Header(SCAN.AddNode("SYSTEM"));
-  PushSysProc("ADR",	 sysADR);
+  PushSysProc("ADR",     sysADR);
-  PushSysProc("SIZE",	 sysSIZE);
+  PushSysProc("SIZE",    sysSIZE);
   PushSysProc("TYPEID",  sysTYPEID);
-  PushSysProc("GET",	 sysGET);
+  PushSysProc("GET",     sysGET);
-  PushSysProc("PUT",	 sysPUT);
+  PushSysProc("PUT",     sysPUT);
-  PushSysProc("CODE",	 sysCODE);
+  PushSysProc("CODE",    sysCODE);
-  PushSysProc("MOVE",	 sysMOVE);
+  PushSysProc("MOVE",    sysMOVE);
+  PushSysProc("COPY",    sysCOPY);
-  PushSysProc("INF",	 sysINF);
+  PushSysProc("INF",     sysINF);
   PushSysType("CARD16",  TCARD16);
   sys := unit;
   unit := temp
 END Pseudo;
     proc.used := TRUE;
     cur := proc.Procs.First(IDENT);
     WHILE cur # NIL DO
       p := cur.Proc(Proc);
       IF ~p.used THEN
-	ProcHandling(p)
+        ProcHandling(p)
       END;
       cur := cur.Next(IDENT)
     END;
   END ProcHandling;

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/DECL.ob07 @ 7596 – Rev 6613 → 7107