Oberon07: some extensions

git-svn-id: svn://kolibrios.org@7107 a494cfbc-eb01-0410-851d-a64ba20cac60

programs/develop/oberon07/Docs/About1251.txt

@@ -30,7 +30,6 @@
 	передается. Сообщения компилятора выводятся на консоль (Windows,
 	KolibriOS), в терминал (Linux).
 2.	Папка Lib - библиотека модулей
-3.	Ïàïêà Source - èñõîäíûé êîä êîìïèëÿòîðà
 
 ------------------------------------------------------------------------------
 	Отличия от оригинала
@@ -45,6 +44,8 @@
 7.	Семантика DIV и MOD уточнена для отрицательных чисел
 8.	Добавлены однострочные комментарии (начинаются с пары символов "//")
 9.	Разрешен экспорт переменных типов ARRAY и RECORD (только для чтения)
+10.	Ðàçðåøåíî íàñëåäîâàíèå îò òèïà-óêàçàòåëÿ
+11.	Äîáàâëåíû ïñåâäîíèìû òèïîâ (TYPE A = B)
 
 ------------------------------------------------------------------------------
 	Особенности реализации
@@ -103,6 +104,11 @@
 		Копирует n байт памяти из Source в Dest,
 		области Source и Dest не должны перекрываться
 
+	PROCEDURE COPY(VAR Source: ëþáîé òèï; VAR Dest: ëþáîé òèï; n: INTEGER)
+		Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest.
+		Ýêâèâàëåíòíî
+		SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
+
 	PROCEDURE CODE(s: ARRAY OF CHAR)
 		Вставка машинного кода
 		s - строковая константа шестнадцатиричных цифр
@@ -198,6 +204,12 @@ Oberon-
 	LSR(x, n: INTEGER): INTEGER
 		Логический сдвиг x на n бит вправо.
 
+	MIN(a, b: INTEGER): INTEGER
+		Ìèíèìóì èç äâóõ çíà÷åíèé.
+
+	MAX(a, b: INTEGER): INTEGER
+		Ìàêñèìóì èç äâóõ çíà÷åíèé.
+
 	BITS(x: INTEGER): SET
 		Интерпретирует x как значение типа SET.
 		Выполняется на этапе компиляции.
@@ -854,3 +866,5 @@ MODULE RasterWorks -
 ------------------------------------------------------------------------------
 MODULE libimg - обертка библиотеки libimg.obj
 ------------------------------------------------------------------------------
+MODULE NetDevices - îáåðòêà äëÿ ô.74 (ðàáîòà ñ ñåòåâûìè óñòðîéñòâàìè)
+------------------------------------------------------------------------------

programs/develop/oberon07/Docs/About866.txt

@@ -30,7 +30,6 @@
 	¯¥à¥¤ ¥âáï. ‘®®¡é¥­¨ï ª®¬¯¨«ïâ®à  ¢ë¢®¤ïâáï ­  ª®­á®«ì (Windows,
 	KolibriOS), ¢ â¥à¬¨­ « (Linux).
 2.	<09> ¯ª  Lib - ¡¨¡«¨®â¥ª  ¬®¤ã«¥©
-3.	<09> ¯ª  Source - ¨á室­ë© ª®¤ ª®¬¯¨«ïâ®à 
 
 ------------------------------------------------------------------------------
 	Žâ«¨ç¨ï ®â ®à¨£¨­ « 
@@ -45,6 +44,8 @@
 7.	‘¥¬ ­â¨ª  DIV ¨ MOD ãâ®ç­¥­  ¤«ï ®âà¨æ â¥«ì­ëå ç¨á¥«
 8.	„®¡ ¢«¥­ë ®¤­®áâà®ç­ë¥ ª®¬¬¥­â à¨¨ (­ ç¨­ îâáï á ¯ àë ᨬ¢®«®¢ "//")
 9.	<09> §à¥è¥­ íªá¯®àâ ¯¥à¥¬¥­­ëå ⨯®¢ ARRAY ¨ RECORD (⮫쪮 ¤«ï ç⥭¨ï)
+10.	<09> §à¥è¥­® ­ á«¥¤®¢ ­¨¥ ®â ⨯ -㪠§ â¥«ï
+11.	„®¡ ¢«¥­ë ¯á¥¢¤®­¨¬ë ⨯®¢ (TYPE A = B)
 
 ------------------------------------------------------------------------------
 	Žá®¡¥­­®á⨠ॠ«¨§ æ¨¨
@@ -103,6 +104,11 @@
 		Š®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest,
 		®¡« á⨠Source ¨ Dest ­¥ ¤®«¦­ë ¯¥à¥ªà뢠âìáï
 
+	PROCEDURE COPY(VAR Source: «î¡®© ⨯; VAR Dest: «î¡®© ⨯; n: INTEGER)
+		Š®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest.
+		<09>ª¢¨¢ «¥­â­®
+		SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
+
 	PROCEDURE CODE(s: ARRAY OF CHAR)
 		‚áâ ¢ª  ¬ è¨­­®£® ª®¤ 
 		s - áâப®¢ ï ª®­áâ ­â  è¥áâ­ ¤æ â¨à¨ç­ëå æ¨äà
@@ -198,6 +204,12 @@ Oberon-ॠ
 	LSR(x, n: INTEGER): INTEGER
 		‹®£¨ç¥áª¨© ᤢ¨£ x ­  n ¡¨â ¢¯à ¢®.
 
+	MIN(a, b: INTEGER): INTEGER
+		Œ¨­¨¬ã¬ ¨§ ¤¢ãå §­ ç¥­¨©.
+
+	MAX(a, b: INTEGER): INTEGER
+		Œ ªá¨¬ã¬ ¨§ ¤¢ãå §­ ç¥­¨©.
+
 	BITS(x: INTEGER): SET
 		ˆ­â¥à¯à¥â¨àã¥â x ª ª §­ ç¥­¨¥ ⨯  SET.
 		‚믮«­ï¥âáï ­  íâ ¯¥ ª®¬¯¨«ï樨.
@@ -854,3 +866,5 @@ MODULE RasterWorks -
 ------------------------------------------------------------------------------
 MODULE libimg - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ libimg.obj
 ------------------------------------------------------------------------------
+MODULE NetDevices - ®¡¥à⪠ ¤«ï ä.74 (à ¡®â  á á¥â¥¢ë¬¨ ãáâனá⢠¬¨)
+------------------------------------------------------------------------------

programs/develop/oberon07/Lib/KolibriOS/API.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -166,6 +166,11 @@ BEGIN
   p1 := sysfunc1(-1)
 END ExitProcess;
 
+PROCEDURE ExitThread*(p1: INTEGER);
+BEGIN
+  p1 := sysfunc1(-1)
+END ExitThread;
+
 PROCEDURE OutChar(c: CHAR);
 VAR res: INTEGER;
 BEGIN

programs/develop/oberon07/Lib/KolibriOS/HOST.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -41,40 +41,6 @@ VAR
 
   fsize, sec*, dsec*: INTEGER;
 
-PROCEDURE [stdcall] sysfunc1(arg1: INTEGER): INTEGER;
-BEGIN
-  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
-  sys.CODE("CD40");             (* int     40h              *)
-  sys.CODE("C9");               (* leave                    *)
-  sys.CODE("C20400");           (* ret     04h              *)
-  RETURN 0
-END sysfunc1;
-
-PROCEDURE [stdcall] sysfunc2(arg1, arg2: INTEGER): INTEGER;
-BEGIN
-  sys.CODE("53");               (* push    ebx              *)
-  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
-  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
-  sys.CODE("CD40");             (* int     40h              *)
-  sys.CODE("5B");               (* pop     ebx              *)
-  sys.CODE("C9");               (* leave                    *)
-  sys.CODE("C20800");           (* ret     08h              *)
-  RETURN 0
-END sysfunc2;
-
-PROCEDURE [stdcall] sysfunc3(arg1, arg2, arg3: INTEGER): INTEGER;
-BEGIN
-  sys.CODE("53");               (* push    ebx              *)
-  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
-  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
-  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
-  sys.CODE("CD40");             (* int     40h              *)
-  sys.CODE("5B");               (* pop     ebx              *)
-  sys.CODE("C9");               (* leave                    *)
-  sys.CODE("C20C00");           (* ret     0Ch              *)
-  RETURN 0
-END sysfunc3;
-
 PROCEDURE [stdcall] sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
 BEGIN
   sys.CODE("53");               (* push    ebx              *)
@@ -122,7 +88,7 @@ END GetProcAdr;
 PROCEDURE Time*(VAR sec, dsec: INTEGER);
 VAR t: INTEGER;
 BEGIN
-  t := sysfunc2(26, 9);
+  t := API.sysfunc2(26, 9);
   sec := t DIV 100;
   dsec := t MOD 100
 END Time;
@@ -139,7 +105,7 @@ VAR Lib: INTEGER;
 
 BEGIN
   Time(sec, dsec);
-  Lib := sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
+  Lib := API.sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
   IF Lib # 0 THEN
     GetProc(sys.ADR(con_init),         "con_init");
     GetProc(sys.ADR(con_exit),         "con_exit");
@@ -155,7 +121,7 @@ BEGIN
   IF con_exit # NIL THEN
     con_exit(FALSE)
   END;
-  n := sysfunc1(-1)
+  API.ExitProcess(0)
 END ExitProcess;
 
 PROCEDURE GetCommandLine*(): INTEGER;
@@ -173,7 +139,7 @@ BEGIN
 END GetName;
 
 PROCEDURE malloc*(size: INTEGER): INTEGER;
-  RETURN sysfunc3(68, 12, size)
+  RETURN API.sysfunc3(68, 12, size)
 END malloc;
 
 PROCEDURE CloseFile*(hObject: INTEGER);

programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07

@@ -0,0 +1,107 @@
+(*
+    Copyright 2017 Anton Krotov
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE NetDevices;
+
+IMPORT sys := SYSTEM, K := KOSAPI;
+
+
+CONST
+
+  //net devices types
+
+  LOOPBACK*	   = 0;
+  ETH*		   = 1;
+  SLIP* 	   = 2;
+
+  //Link status
+
+  LINK_DOWN*	   = 0;
+  LINK_UNKNOWN*    = 1;
+  LINK_FD*	   = 2; //full duplex flag
+  LINK_10M*	   = 4;
+  LINK_100M*	   = 8;
+  LINK_1G*	   = 12;
+
+
+TYPE
+
+  DEVICENAME* = ARRAY 64 OF CHAR;
+
+
+PROCEDURE Number* (): INTEGER;
+  RETURN K.sysfunc2(74, -1)
+END Number;
+
+
+PROCEDURE Type* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256)
+END Type;
+
+
+PROCEDURE Name* (num: INTEGER; VAR name: DEVICENAME): BOOLEAN;
+VAR err: BOOLEAN;
+BEGIN
+  err := K.sysfunc3(74, num * 256 + 1, sys.ADR(name[0])) = -1;
+  IF err THEN
+    name := ""
+  END
+  RETURN ~err
+END Name;
+
+
+PROCEDURE Reset* (num: INTEGER): BOOLEAN;
+  RETURN K.sysfunc2(74, num * 256 + 2) # -1
+END Reset;
+
+
+PROCEDURE Stop* (num: INTEGER): BOOLEAN;
+  RETURN K.sysfunc2(74, num * 256 + 3) # -1
+END Stop;
+
+
+PROCEDURE Pointer* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 4)
+END Pointer;
+
+
+PROCEDURE SentPackets* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 6)
+END SentPackets;
+
+
+PROCEDURE ReceivedPackets* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 7)
+END ReceivedPackets;
+
+
+PROCEDURE SentBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
+  RETURN K.sysfunc22(74, num * 256 + 8, hValue)
+END SentBytes;
+
+
+PROCEDURE ReceivedBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
+  RETURN K.sysfunc22(74, num * 256 + 9, hValue)
+END ReceivedBytes;
+
+
+PROCEDURE LinkStatus* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 10)
+END LinkStatus;
+
+
+END NetDevices.

programs/develop/oberon07/Lib/KolibriOS/RTL.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -28,6 +28,7 @@ TYPE
 VAR
 
   SelfName, rtab: INTEGER; CloseProc: PROC;
+  init: BOOLEAN;
 
 PROCEDURE [stdcall] _halt*(n: INTEGER);
 BEGIN
@@ -116,14 +117,6 @@ BEGIN
   END
 END _arrayrot;
 
-PROCEDURE Min(a, b: INTEGER): INTEGER;
-BEGIN
-  IF a > b THEN
-    a := b
-  END
-  RETURN a
-END Min;
-
 PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
 BEGIN
   sys.CODE("8B4508");     //  mov     eax, [ebp + 08h]
@@ -144,7 +137,7 @@ END _length;
 
 PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
 BEGIN
-  _savearr(Min(alen, blen), a, b);
+  _savearr(MIN(alen, blen), a, b);
   IF blen > alen THEN
     sys.PUT(b + alen, 0X)
   END
@@ -153,7 +146,7 @@ END _strcopy;
 PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
 VAR i: INTEGER; Res: BOOLEAN;
 BEGIN
-  i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));
+  i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
   IF i = 0 THEN
     i := _length(a) - _length(b)
   END;
@@ -252,7 +245,8 @@ BEGIN
     Int(code, int);
     StrAppend(int)
   END;
-  API.DebugMsg(sys.ADR(msg), SelfName)
+  API.DebugMsg(sys.ADR(msg), SelfName);
+  API.ExitThread(0)
 END _assrt;
 
 PROCEDURE [stdcall] _close*;
@@ -264,11 +258,14 @@ END _close;
 
 PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
 BEGIN
+  IF ~init THEN
     API.zeromem(gsize, gadr);
+    init := TRUE;
     API.init(esp);
     SelfName := self;
     rtab := rec;
     CloseProc := NIL
+  END
 END _init;
 
 PROCEDURE SetClose*(proc: PROC);

programs/develop/oberon07/Lib/Linux32/API.ob07

@@ -1,4 +1,4 @@
-(*
+(*
     Copyright 2016 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
@@ -103,6 +103,11 @@ BEGIN
   exit(code)
 END ExitProcess;
 
+PROCEDURE ExitThread* (code: INTEGER);
+BEGIN
+  exit(code)
+END ExitThread;
+
 PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER);
 VAR H: INTEGER;
 BEGIN

programs/develop/oberon07/Lib/Linux32/RTL.ob07

@@ -1,5 +1,5 @@
-(*
+(*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -28,6 +28,7 @@ TYPE
 VAR
 
   SelfName, rtab: INTEGER; CloseProc: PROC;
+  init: BOOLEAN;
 
 PROCEDURE [stdcall] _halt*(n: INTEGER);
 BEGIN
@@ -116,14 +117,6 @@ BEGIN
   END
 END _arrayrot;
 
-PROCEDURE Min(a, b: INTEGER): INTEGER;
-BEGIN
-  IF a > b THEN
-    a := b
-  END
-  RETURN a
-END Min;
-
 PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
 BEGIN
   sys.CODE("8B4508");     //  mov     eax, [ebp + 08h]
@@ -144,7 +137,7 @@ END _length;
 
 PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
 BEGIN
-  _savearr(Min(alen, blen), a, b);
+  _savearr(MIN(alen, blen), a, b);
   IF blen > alen THEN
     sys.PUT(b + alen, 0X)
   END
@@ -153,7 +146,7 @@ END _strcopy;
 PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
 VAR i: INTEGER; Res: BOOLEAN;
 BEGIN
-  i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));
+  i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
   IF i = 0 THEN
     i := _length(a) - _length(b)
   END;
@@ -252,7 +245,8 @@ BEGIN
     Int(code, int);
     StrAppend(int)
   END;
-  API.DebugMsg(sys.ADR(msg), SelfName)
+  API.DebugMsg(sys.ADR(msg), SelfName);
+  API.ExitThread(0)
 END _assrt;
 
 PROCEDURE [stdcall] _close*;
@@ -264,11 +258,14 @@ END _close;
 
 PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
 BEGIN
+  IF ~init THEN
     API.zeromem(gsize, gadr);
+    init := TRUE;
     API.init(esp);
     SelfName := self;
     rtab := rec;
-  CloseProc := NIL;
+    CloseProc := NIL
+  END
 END _init;
 
 PROCEDURE SetClose*(proc: PROC);

programs/develop/oberon07/Lib/Windows32/API.ob07

@@ -1,5 +1,5 @@
-(*
+(*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -25,6 +25,8 @@ VAR
   Free*: PROCEDURE [winapi] (hMem: INTEGER): INTEGER;
   MessageBoxA*: PROCEDURE [winapi] (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
   ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
+  ExitThread*: PROCEDURE [winapi] (code: INTEGER);
+  GetCurrentThreadId*: PROCEDURE [winapi] (): INTEGER;
   strncmp*: PROCEDURE [cdecl] (a, b, n: INTEGER): INTEGER;
 
   GetProcAddress*: PROCEDURE [winapi] (hModule, name: INTEGER): INTEGER;
@@ -62,6 +64,8 @@ BEGIN
 
   lib := LoadLibraryA(sys.ADR("kernel32.dll"));
   GetProc("ExitProcess", lib, sys.ADR(ExitProcess));
+  GetProc("ExitThread", lib, sys.ADR(ExitThread));
+  GetProc("GetCurrentThreadId", lib, sys.ADR(GetCurrentThreadId));
   GetProc("GlobalAlloc", lib, sys.ADR(Alloc));
   GetProc("GlobalFree", lib, sys.ADR(Free));
 

programs/develop/oberon07/Lib/Windows32/HOST.ob07

@@ -1,5 +1,5 @@
-(*
+(*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -49,7 +49,6 @@ VAR
   ReadFile, WriteFile: PROCEDURE [winapi] (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped: INTEGER): INTEGER;
   GetCommandLine*: PROCEDURE [winapi] (): INTEGER;
   GetTickCount: PROCEDURE [winapi] (): INTEGER;
-  Alloc: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER;
   ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
   SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
 
@@ -112,7 +111,7 @@ BEGIN
 END Time;
 
 PROCEDURE malloc*(size: INTEGER): INTEGER;
-  RETURN Alloc(64, size)
+  RETURN API.Alloc(64, size)
 END malloc;
 
 PROCEDURE init*;
@@ -128,9 +127,8 @@ BEGIN
   GetProc("ReadFile", lib, sys.ADR(ReadFile));
   GetProc("WriteFile", lib, sys.ADR(WriteFile));
   GetProc("GetCommandLineA", lib, sys.ADR(GetCommandLine));
-  GetProc("ExitProcess", lib, sys.ADR(ExitProcess));
-  GetProc("GlobalAlloc", lib, sys.ADR(Alloc));
   GetProc("SetFilePointer", lib, sys.ADR(SetFilePointer));
+  ExitProcess := API.ExitProcess;
   hConsoleOutput := GetStdHandle(-11)
 END init;
 

programs/develop/oberon07/Lib/Windows32/RTL.ob07

@@ -1,5 +1,5 @@
-(*
+(*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
@@ -28,6 +28,8 @@ TYPE
 VAR
 
   SelfName, rtab: INTEGER; CloseProc: PROC;
+  init: BOOLEAN;
+  main_thread_id: INTEGER;
 
 PROCEDURE [stdcall] _halt*(n: INTEGER);
 BEGIN
@@ -116,14 +118,6 @@ BEGIN
   END
 END _arrayrot;
 
-PROCEDURE Min(a, b: INTEGER): INTEGER;
-BEGIN
-  IF a > b THEN
-    a := b
-  END
-  RETURN a
-END Min;
-
 PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
 BEGIN
   sys.CODE("8B4508");     //  mov     eax, [ebp + 08h]
@@ -144,7 +138,7 @@ END _length;
 
 PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
 BEGIN
-  _savearr(Min(alen, blen), a, b);
+  _savearr(MIN(alen, blen), a, b);
   IF blen > alen THEN
     sys.PUT(b + alen, 0X)
   END
@@ -153,7 +147,7 @@ END _strcopy;
 PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
 VAR i: INTEGER; Res: BOOLEAN;
 BEGIN
-  i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));
+  i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
   IF i = 0 THEN
     i := _length(a) - _length(b)
   END;
@@ -252,7 +246,11 @@ BEGIN
     Int(code, int);
     StrAppend(int)
   END;
-  API.DebugMsg(sys.ADR(msg), SelfName)
+  IF API.GetCurrentThreadId() = main_thread_id THEN
+    API.ExitProcess(0)
+  ELSE
+    API.ExitThread(0)
+  END
 END _assrt;
 
 PROCEDURE [stdcall] _close*;
@@ -264,11 +262,15 @@ END _close;
 
 PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
 BEGIN
+  IF ~init THEN
     API.zeromem(gsize, gadr);
+    init := TRUE;
     API.init(esp);
+    main_thread_id := API.GetCurrentThreadId();
     SelfName := self;
     rtab := rec;
-  CloseProc := NIL;
+    CloseProc := NIL
+  END
 END _init;
 
 PROCEDURE SetClose*(proc: PROC);

programs/develop/oberon07/Source/Compiler.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This file is part of Compiler.
 
@@ -52,10 +52,10 @@ CONST
   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;
 
 TYPE
 
@@ -394,7 +394,9 @@ BEGIN
       IntType(b.T, coord);
       IF b.eType = eCONST THEN
         Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53);
+        IF a.eType = eCONST THEN
           Assert(a.Value <= b.Value, coord, 54)
+        END
       END;
       Load(b)
     ELSE
@@ -615,6 +617,32 @@ BEGIN
     Str(e1);
     e.T := inttype;
     X86.StFunc(X86.stLENGTH)
+  |stMIN, stMAX:
+    pExpr(e1);
+    IntType(e1.T, coord);
+    Load(e1);
+    Check(lxComma);
+    NextCoord(coord);
+    pExpr(e2);
+    IntType(e2.T, coord);
+    Load(e2);
+    IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN
+      a := FLOOR(e1.Value);
+      b := FLOOR(e2.Value);
+      CASE func OF
+      |stMIN: a := MIN(a, b)
+      |stMAX: a := MAX(a, b)
+      ELSE
+      END;
+      e.Value := LONG(FLT(a));
+      e.eType := eCONST
+    END;
+    IF func = stMIN THEN
+      X86.StFunc(X86.stMIN)
+    ELSE
+      X86.StFunc(X86.stMAX)
+    END;
+    e.T := inttype
   |sysADR:
     Assert((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxSTRING) OR (SCAN.tLex = lxCHX), coord, 43);
     IF SCAN.tLex = lxIDENT THEN
@@ -1636,12 +1664,29 @@ BEGIN
     Expr(e1);
     IntType(e1.T, coord);
     Load(e1);
+  |sysCOPY:
+    begcall := X86.current;
+    Designator(e1);
+    Assert(e1.eType = eVAR, coord, 63);
+    Check(lxComma);
+    X86.PushCall(begcall);
+    X86.Param;
+    NextCoord(coord);
+    Designator(e1);
+    Assert(e1.eType = eVAR, coord, 63);
+    Assert(~e1.Read, coord, 115);
+    Check(lxComma);
+    X86.EndCall;
+    NextCoord(coord);
+    Expr(e1);
+    IntType(e1.T, coord);
+    Load(e1);
   ELSE
     Assert(FALSE, coord2, 132)
   END;
   Check(lxRRound);
   Next;
-  IF proc = sysMOVE THEN
+  IF (proc = sysMOVE) OR (proc = sysCOPY) THEN
     X86.StProc(X86.sysMOVE)
   END
 END StProc;
@@ -1678,7 +1723,7 @@ BEGIN
       IF s.Len = 1 THEN
         X86.Mono(s.Number)
       END;
-      X86.PushConst(UTILS.min(s.Len + 1, e1.T.Len))
+      X86.PushConst(MIN(s.Len + 1, e1.T.Len))
     END;
     X86.Save(e1.T.tType)
   ELSIF e1.eType = ePROC THEN

programs/develop/oberon07/Source/DECL.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This file is part of Compiler.
 
@@ -43,10 +43,10 @@ CONST
   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;
 
   TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; TNIL = 8;
   TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
@@ -417,6 +417,8 @@ BEGIN
   PushStProc("BITS",     stBITS);
   PushStProc("LSR",      stLSR);
   PushStProc("LENGTH",   stLENGTH);
+  PushStProc("MIN",      stMIN);
+  PushStProc("MAX",      stMAX);
   Guard
 END StIdent;
 
@@ -1054,6 +1056,9 @@ BEGIN
       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;
@@ -1194,10 +1199,16 @@ BEGIN
       last := unit.Idents.Last(IDENT);
       Check(lxEQ);
       Next;
+
+      IF SCAN.tLex = lxIDENT THEN
+        last.T := ParseType(coord)
+      ELSE
         NEW(NewType);
         MemErr(NewType = NIL);
         last.T := NewType;
-      T := StructType(FALSE, NewType);
+        T := StructType(FALSE, NewType)
+      END;
+
       Check(lxSemi);
       Next
     END
@@ -1416,6 +1427,7 @@ BEGIN
   PushSysProc("PUT",     sysPUT);
   PushSysProc("CODE",    sysCODE);
   PushSysProc("MOVE",    sysMOVE);
+  PushSysProc("COPY",    sysCOPY);
   PushSysProc("INF",     sysINF);
   PushSysType("CARD16",  TCARD16);
   sys := unit;

programs/develop/oberon07/Source/ERRORS.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This file is part of Compiler.
 
@@ -200,7 +200,7 @@ BEGIN
   | 77: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ "
   | 78: str := "¤«¨­  ⨯ -¬ áᨢ  ¤®«¦­  ¡ëâì ¡®«ìè¥ ­ã«ï"
   | 79: str := "®¦¨¤ «®áì 'OF' ¨«¨ ','"
-  | 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨"
+  | 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨ ¨«¨ ⨯ -㪠§ â¥«ï"
   | 81: str := "¡ §®¢ë© ⨯ ⨯ -㪠§ â¥«ï ¤®«¦¥­ ¡ëâì § ¯¨áìî"
   | 82: str := "⨯ १ã«ìâ â  ¯à®æ¥¤ãàë ­¥ ¬®¦¥â ¡ëâì § ¯¨áìî ¨«¨ ¬ áᨢ®¬"
   | 83: str := "à §¬¥à ⨯  ᫨誮¬ ¢¥«¨ª"

programs/develop/oberon07/Source/UTILS.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This file is part of Compiler.
 
@@ -28,7 +28,7 @@ CONST
   Ext* = ".ob07";
   MAX_PATH = 1024;
   MAX_PARAM = 1024;
-  Date* = 1451606400; (* 2016-01-01 *)
+  Date* = 1509580800;  (* 2017-11-02 *)
 
 TYPE
 
@@ -199,14 +199,6 @@ BEGIN
   Line := newLine
 END UnitLine;
 
-PROCEDURE min*(a, b: INTEGER): INTEGER;
-BEGIN
-  IF a > b THEN
-    a := b
-  END
-  RETURN a
-END min;
-
 PROCEDURE Align*(n: INTEGER): INTEGER;
   RETURN (4 - n MOD 4) MOD 4
 END Align;

programs/develop/oberon07/Source/X86.ob07

@@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2017 Anton Krotov
 
     This file is part of Compiler.
 
@@ -36,7 +36,7 @@ CONST
   stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19;
   stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24;
   stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29;
-  stLENGTH* = 30;
+  stLENGTH* = 30; stMIN* = 31; stMAX* = 32;
 
   sysMOVE* = 108;
 
@@ -1232,7 +1232,9 @@ BEGIN
   |stASR:    PopECX; OutCode("58D3F8"); PushEAX
   |stLSL:    PopECX; OutCode("58D3E0"); PushEAX
   |stLSR:    PopECX; OutCode("58D3E8"); PushEAX
-  |stORD:    PopEDX; OutCode("85D274036A015A"); PushEDX
+  |stORD:    PopEDX; OutCode("85D274036A015A"); PushEDX;
+  |stMIN:    PopEDX; OutCode("3914247E025852");
+  |stMAX:    PopEDX; OutCode("3B14247E025852");
   |stLENGTH: CallRTL(_length); PushEAX
   ELSE
   END
@@ -1269,12 +1271,12 @@ BEGIN
   |TCHAR, TBOOLEAN:
     IF lastcmd.tcmd = ECMD THEN
       del;
-      OutCode("33D28A");
+      OutCode("0FB6");
       IntByte("55", "95", offset);
       PushEDX
     ELSE
       PopEDX;
-      OutCode("33C98A0A");
+      OutCode("0FB60A");
       PushECX
     END
   |TLONGREAL: