update

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

programs/develop/oberon07/Docs/About1251.txt

@@ -17,6 +17,7 @@ UTF-8
       "kos" - KolibriOS
       "obj" - KolibriOS DLL
       "elfexe" - Linux ELF-EXEC
+      "elfso"  - Linux ELF-SO
   4) необязательные параметры-ключи
       -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб)
       -base <address> адрес загрузки исполняемого файла в килобайтах
@@ -144,10 +145,10 @@ UTF-8
                 до 32 бит, для записи байтов использовать SYSTEM.PUT8,
                 для WCHAR -- SYSTEM.PUT16
 
-        PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
+        PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
                 Память[a] := младшие 8 бит (x)
 
-        PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
+        PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
                 Память[a] := младшие 16 бит (x)
 
         PROCEDURE MOVE(Source, Dest, n: INTEGER)
@@ -358,8 +359,8 @@ Oberon-
   Все программы неявно используют модуль RTL. Компилятор транслирует
 некоторые операции (проверка и охрана типа, сравнение строк, сообщения об
 ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не
-следует явно вызывать эти процедуры, за исключением процедуры SetDll,
+следует явно вызывать эти процедуры, за исключением процедур SetDll и SetFini
-если приложение компилируется как Windows DLL:
+если приложение компилируется как Windows DLL или Linux SO, соответственно:
 
         PROCEDURE SetDll
             (process_detach, thread_detach, thread_attach: DLL_ENTRY);
@@ -372,8 +373,15 @@ SetDll
 - создании нового потока (thread_attach)
 - уничтожении потока (thread_detach)
 
-Для прочих типов приложений, вызов процедуры SetDll не влияет на
+
+        PROCEDURE SetFini (ProcFini: PROC);
+        где TYPE PROC = PROCEDURE (* без параметров *)
+
+SetFini назначает процедуру ProcFini вызываемой при выгрузке so-библиотеки.
+
+Для прочих типов приложений, вызов процедур SetDll и SetFini не влияет на
 поведение программы.
+
   Сообщения об ошибках времени выполнения выводятся в диалоговых окнах
 (Windows), в терминал (Linux), на доску отладки (KolibriOS).
 
@@ -396,5 +404,3 @@ SetDll
 
 Эта процедура должна быть вызвана перед использованием DLL.
 Процедура всегда возвращает 1.
-
-  Для Linux, генерация динамических библиотек не реализована.

programs/develop/oberon07/Docs/About866.txt

@@ -17,6 +17,7 @@ UTF-8
       "kos" - KolibriOS
       "obj" - KolibriOS DLL
       "elfexe" - Linux ELF-EXEC
+      "elfso"  - Linux ELF-SO
   4) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
       -stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡)
       -base <address>  ¤à¥á § £à㧪¨ ¨á¯®«­ï¥¬®£® ä ©«  ¢ ª¨«®¡ ©â å
@@ -144,10 +145,10 @@ UTF-8
                 ¤® 32 ¡¨â, ¤«ï § ¯¨á¨ ¡ ©â®¢ ¨á¯®«ì§®¢ âì SYSTEM.PUT8,
                 ¤«ï WCHAR -- SYSTEM.PUT16
 
-        PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
+        PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
                 <20> ¬ïâì[a] := ¬« ¤è¨¥ 8 ¡¨â (x)
 
-        PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
+        PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
                 <20> ¬ïâì[a] := ¬« ¤è¨¥ 16 ¡¨â (x)
 
         PROCEDURE MOVE(Source, Dest, n: INTEGER)
@@ -358,8 +359,8 @@ Oberon-ॠ
   ‚ᥠ¯à®£à ¬¬ë ­¥ï¢­® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. Š®¬¯¨«ïâ®à â࠭᫨àã¥â
 ­¥ª®â®àë¥ ®¯¥à æ¨¨ (¯à®¢¥àª  ¨ ®åà ­  ⨯ , áà ¢­¥­¨¥ áâப, á®®¡é¥­¨ï ®¡
 ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. <20>¥
-á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãàë SetDll,
+á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãà SetDll ¨ SetFini
-¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL:
+¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL ¨«¨ Linux SO, ᮮ⢥âá⢥­­®:
 
         PROCEDURE SetDll
             (process_detach, thread_detach, thread_attach: DLL_ENTRY);
@@ -372,8 +373,15 @@ SetDll
 - ᮧ¤ ­¨¨ ­®¢®£® ¯®â®ª  (thread_attach)
 - ã­¨ç⮦¥­¨¨ ¯®â®ª  (thread_detach)
 
-„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨©, ¢ë§®¢ ¯à®æ¥¤ãàë SetDll ­¥ ¢«¨ï¥â ­ 
+
+        PROCEDURE SetFini (ProcFini: PROC);
+        £¤¥ TYPE PROC = PROCEDURE (* ¡¥§ ¯ à ¬¥â஢ *)
+
+SetFini ­ §­ ç ¥â ¯à®æ¥¤ãàã ProcFini ¢ë§ë¢ ¥¬®© ¯à¨ ¢ë£à㧪¥ so-¡¨¡«¨®â¥ª¨.
+
+„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨©, ¢ë§®¢ ¯à®æ¥¤ãà SetDll ¨ SetFini ­¥ ¢«¨ï¥â ­ 
 ¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë.
+
   ‘®®¡é¥­¨ï ®¡ ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª­ å
 (Windows), ¢ â¥à¬¨­ « (Linux), ­  ¤®áªã ®â« ¤ª¨ (KolibriOS).
 
@@ -396,5 +404,3 @@ SetDll
 
 <EFBFBD>â  ¯à®æ¥¤ãà  ¤®«¦­  ¡ëâì ¢ë§¢ ­  ¯¥à¥¤ ¨á¯®«ì§®¢ ­¨¥¬ DLL.
 <EFBFBD>à®æ¥¤ãà  ¢á¥£¤  ¢®§¢à é ¥â 1.
-
-  „«ï Linux, £¥­¥à æ¨ï ¤¨­ ¬¨ç¥áª¨å ¡¨¡«¨®â¥ª ­¥ ॠ«¨§®¢ ­ .

programs/develop/oberon07/Docs/KOSLib1251.txt

@@ -98,8 +98,8 @@ MODULE Math -
 
 	CONST
 
-		pi = 3.141592653589793D+00
+		pi = 3.141592653589793E+00
-		e  = 2.718281828459045D+00
+		e  = 2.718281828459045E+00
 
 
 	PROCEDURE IsNan(x: REAL): BOOLEAN
@@ -153,13 +153,13 @@ MODULE Math -
 	PROCEDURE tanh(x: REAL): REAL
 		ãèïåðáîëè÷åñêèé òàíãåíñ x
 
-	PROCEDURE arcsinh(x: REAL): REAL
+	PROCEDURE arsinh(x: REAL): REAL
 		îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x
 
-	PROCEDURE arccosh(x: REAL): REAL
+	PROCEDURE arcosh(x: REAL): REAL
 		îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x
 
-	PROCEDURE arctanh(x: REAL): REAL
+	PROCEDURE artanh(x: REAL): REAL
 		îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x
 
 	PROCEDURE round(x: REAL): REAL
@@ -181,6 +181,9 @@ MODULE Math -
 		åñëè x < 0 âîçâðàùàåò -1
 		åñëè x = 0 âîçâðàùàåò 0
 
+	PROCEDURE fact(n: INTEGER): REAL
+		ôàêòîðèàë n
+
 ------------------------------------------------------------------------------
 MODULE Debug - âûâîä íà äîñêó îòëàäêè
 	Èíòåðôåéñ êàê ìîäóëü Out
@@ -337,7 +340,7 @@ MODULE DateTime -
 	PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
 		âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ
 		Year, Month, Day, Hour, Min, Sec;
-		ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5
+		ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5
 
 	PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
 				Hour, Min, Sec: INTEGER): BOOLEAN

programs/develop/oberon07/Docs/KOSLib866.txt

@@ -98,8 +98,8 @@ MODULE Math -
 
 	CONST
 
-                pi = 3.141592653589793D+00
+		pi = 3.141592653589793E+00
-                e  = 2.718281828459045D+00
+		e  = 2.718281828459045E+00
 
 
 	PROCEDURE IsNan(x: REAL): BOOLEAN
@@ -153,13 +153,13 @@ MODULE Math -
 	PROCEDURE tanh(x: REAL): REAL
 		£¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x
 
-        PROCEDURE arcsinh(x: REAL): REAL
+	PROCEDURE arsinh(x: REAL): REAL
 		®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x
 
-        PROCEDURE arccosh(x: REAL): REAL
+	PROCEDURE arcosh(x: REAL): REAL
 		®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x
 
-        PROCEDURE arctanh(x: REAL): REAL
+	PROCEDURE artanh(x: REAL): REAL
 		®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x
 
 	PROCEDURE round(x: REAL): REAL
@@ -181,6 +181,9 @@ MODULE Math -
 		¥á«¨ x < 0 ¢®§¢à é ¥â -1
 		¥á«¨ x = 0 ¢®§¢à é ¥â 0
 
+	PROCEDURE fact(n: INTEGER): REAL
+		ä ªâ®à¨ « n
+
 ------------------------------------------------------------------------------
 MODULE Debug - ¢ë¢®¤ ­  ¤®áªã ®â« ¤ª¨
 	ˆ­â¥àä¥©á ª ª ¬®¤ã«ì Out
@@ -337,7 +340,7 @@ MODULE DateTime -
 	PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
 		¢®§¢à é ¥â ¤ âã, ¯®«ã祭­ãî ¨§ ª®¬¯®­¥­â®¢
 		Year, Month, Day, Hour, Min, Sec;
-                ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0D5
+		¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0E5
 
 	PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
 				Hour, Min, Sec: INTEGER): BOOLEAN

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

@@ -1,5 +1,5 @@
 (*
-    Copyright 2013, 2014, 2018 Anton Krotov
+    Copyright 2013, 2014, 2018, 2019 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
@@ -251,58 +251,45 @@ END arctan;
 
 
 PROCEDURE sinh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
+    x := exp(x)
-        res := 0.0
+    RETURN (x - 1.0 / x) * 0.5
-    ELSE
-        res := (exp(x) - exp(-x)) / 2.0
-    END
-    RETURN res
 END sinh;
 
 
 PROCEDURE cosh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
+    x := exp(x)
-        res := 1.0
+    RETURN (x + 1.0 / x) * 0.5
-    ELSE
-        res := (exp(x) + exp(-x)) / 2.0
-    END
-    RETURN res
 END cosh;
 
 
 PROCEDURE tanh* (x: REAL): REAL;
-VAR
-    res: REAL;
-
 BEGIN
-    IF IsZero(x) THEN
+    IF x > 15.0 THEN
-        res := 0.0
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
     ELSE
-        res := sinh(x) / cosh(x)
+        x := exp(2.0 * x);
+        x := (x - 1.0) / (x + 1.0)
     END
-    RETURN res
+
+    RETURN x
 END tanh;
 
 
-PROCEDURE arcsinh* (x: REAL): REAL;
+PROCEDURE arsinh* (x: REAL): REAL;
-    RETURN ln(x + sqrt((x * x) + 1.0))
+    RETURN ln(x + sqrt(x * x + 1.0))
-END arcsinh;
+END arsinh;
 
 
-PROCEDURE arccosh* (x: REAL): REAL;
+PROCEDURE arcosh* (x: REAL): REAL;
-    RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
+    RETURN ln(x + sqrt(x * x - 1.0))
-END arccosh;
+END arcosh;
 
 
-PROCEDURE arctanh* (x: REAL): REAL;
+PROCEDURE artanh* (x: REAL): REAL;
 VAR
     res: REAL;
 
@@ -315,7 +302,7 @@ BEGIN
         res := 0.5 * ln((1.0 + x) / (1.0 - x))
     END
     RETURN res
-END arctanh;
+END artanh;
 
 
 PROCEDURE floor* (x: REAL): REAL;
@@ -374,8 +361,24 @@ BEGIN
     ELSE
         res := 0
     END
+
     RETURN res
 END sgn;
 
 
+PROCEDURE fact* (n: INTEGER): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    res := 1.0;
+    WHILE n > 1 DO
+        res := res * FLT(n);
+        DEC(n)
+    END
+
+    RETURN res
+END fact;
+
+
 END Math.

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

@@ -1,4 +1,4 @@
-(*
+(*
     Copyright 2017 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify

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

@@ -22,11 +22,13 @@ CONST
     DLL_PROCESS_DETACH  = 0;
 
     SIZE_OF_DWORD = 4;
+    MAX_SET = 31;
 
 
 TYPE
 
     DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
+    PROC       = PROCEDURE;
 
 
 VAR
@@ -40,6 +42,8 @@ VAR
         thread_attach: DLL_ENTRY
     END;
 
+    fini: PROC;
+
 
 PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
 BEGIN
@@ -107,18 +111,12 @@ BEGIN
 END _arrcpy;
 
 
-PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
 BEGIN
     _move(MIN(len_dst, len_src) * chr_size, src, dst)
 END _strcpy;
 
 
-PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
-    _move(MIN(len_dst, len_src) * chr_size, src, dst)
-END _strcpy2;
-
-
 PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
 VAR
     i, n, k: INTEGER;
@@ -137,32 +135,29 @@ BEGIN
 END _rot;
 
 
-PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
+PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-VAR
-    res: INTEGER;
-
 BEGIN
-    IF (a <= b) & (a <= 31) & (b >= 0) THEN
+    IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
-        IF b > 31 THEN
+        IF b > MAX_SET THEN
-            b := 31
+            b := MAX_SET
         END;
         IF a < 0 THEN
             a := 0
         END;
-        res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
+        a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
     ELSE
-        res := 0
+        a := 0
     END
 
-    RETURN res
+    RETURN a
-END _set2;
-
-
-PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-    RETURN _set2(a, b)
 END _set;
 
 
+PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
+    RETURN _set(b, a)
+END _set2;
+
+
 PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
 BEGIN
     SYSTEM.CODE(
@@ -185,7 +180,7 @@ BEGIN
 END divmod;
 
 
-PROCEDURE div_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 
@@ -196,10 +191,10 @@ BEGIN
     END
 
     RETURN div
-END div_;
+END _div2;
 
 
-PROCEDURE mod_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 
@@ -210,29 +205,19 @@ BEGIN
     END
 
     RETURN mod
-END mod_;
+END _mod2;
 
 
 PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
-    RETURN div_(a, b)
+    RETURN _div2(a, b)
 END _div;
 
 
-PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
-    RETURN div_(a, b)
-END _div2;
-
-
 PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
-    RETURN mod_(a, b)
+    RETURN _mod2(a, b)
 END _mod;
 
 
-PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
-    RETURN mod_(a, b)
-END _mod2;
-
-
 PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
 BEGIN
     ptr := API._NEW(size);
@@ -251,50 +236,6 @@ BEGIN
 END _dispose;
 
 
-PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: CHAR;
-    res:  INTEGER;
-
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a);
-        SYSTEM.GET(b, B); INC(b);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmp;
-
-
-PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: WCHAR;
-    res:  INTEGER;
-
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a, 2);
-        SYSTEM.GET(b, B); INC(b, 2);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmpw;
-
-
 PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
 BEGIN
     SYSTEM.CODE(
@@ -345,16 +286,71 @@ BEGIN
 END _lengthw;
 
 
+PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: CHAR;
+    res: INTEGER;
+
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a);
+        SYSTEM.GET(b, B); INC(b);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmp;
+
+
+PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: WCHAR;
+    res: INTEGER;
+
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a, 2);
+        SYSTEM.GET(b, B); INC(b, 2);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmpw;
+
+
 PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
 VAR
     res:  INTEGER;
     bRes: BOOLEAN;
+    c:    CHAR;
 
 BEGIN
 
     res := strncmp(str1, str2, MIN(len1, len2));
-    IF res = 0 THEN
+    IF res = minint THEN
-        res := _length(len1, str1) - _length(len2, str2)
+        IF len1 > len2 THEN
+            SYSTEM.GET(str1 + len2, c);
+            res := ORD(c)
+        ELSIF len1 < len2 THEN
+            SYSTEM.GET(str2 + len1, c);
+            res := -ORD(c)
+        ELSE
+            res := 0
+        END
     END;
 
     CASE op OF
@@ -370,21 +366,25 @@ BEGIN
 END _strcmp;
 
 
-PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmp(op, len2, str2, len1, str1)
-END _strcmp2;
-
-
 PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
 VAR
     res:  INTEGER;
     bRes: BOOLEAN;
+    c:    WCHAR;
 
 BEGIN
 
     res := strncmpw(str1, str2, MIN(len1, len2));
-    IF res = 0 THEN
+    IF res = minint THEN
-        res := _lengthw(len1, str1) - _lengthw(len2, str2)
+        IF len1 > len2 THEN
+            SYSTEM.GET(str1 + len2 * 2, c);
+            res := ORD(c)
+        ELSIF len1 < len2 THEN
+            SYSTEM.GET(str2 + len1 * 2, c);
+            res := -ORD(c)
+        ELSE
+            res := 0
+        END
     END;
 
     CASE op OF
@@ -400,11 +400,6 @@ BEGIN
 END _strcmpw;
 
 
-PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmpw(op, len2, str2, len1, str1)
-END _strcmpw2;
-
-
 PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
 VAR
     c: CHAR;
@@ -470,14 +465,14 @@ BEGIN
 END append;
 
 
-PROCEDURE [stdcall] _error* (module, err: INTEGER);
+PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
 VAR
     s, temp: ARRAY 1024 OF CHAR;
 
 BEGIN
 
     s := "";
-    CASE err MOD 16 OF
+    CASE err OF
     | 1: append(s, "assertion failure")
     | 2: append(s, "NIL dereference")
     | 3: append(s, "division by zero")
@@ -494,7 +489,7 @@ BEGIN
     append(s, API.eol);
 
     append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
-    append(s, "line: ");     IntToStr(LSR(err, 4), temp);  append(s, temp);
+    append(s, "line: ");   IntToStr(line, temp);     append(s, temp);
 
     API.DebugMsg(SYSTEM.ADR(s[0]), name);
 
@@ -502,69 +497,42 @@ BEGIN
 END _error;
 
 
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
 BEGIN
-    (* r IS t0 *)
+    SYSTEM.GET(t0 + t1 + types, t0)
-
+    RETURN t0 MOD 2
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-
-    RETURN t1 = t0
 END _isrec;
 
 
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-VAR
-    t1: INTEGER;
-
 BEGIN
-    (* p IS t0 *)
-
     IF p # 0 THEN
-        DEC(p, SIZE_OF_DWORD);
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
-        SYSTEM.GET(p, t1);
+        SYSTEM.GET(t0 + p + types, p)
-        WHILE (t1 # 0) & (t1 # t0) DO
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-        END
-    ELSE
-        t1 := -1
     END
 
-    RETURN t1 = t0
+    RETURN p MOD 2
 END _is;
 
 
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
 BEGIN
-    (* r:t1 IS t0 *)
+    SYSTEM.GET(t0 + t1 + types, t0)
-
+    RETURN t0 MOD 2
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-
-    RETURN t1 = t0
 END _guardrec;
 
 
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
-VAR
-    t1:  INTEGER;
-
 BEGIN
-    (* p IS t0 *)
     SYSTEM.GET(p, p);
     IF p # 0 THEN
-        DEC(p, SIZE_OF_DWORD);
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
-        SYSTEM.GET(p, t1);
+        SYSTEM.GET(t0 + p + types, p)
-        WHILE (t1 # t0) & (t1 # 0) DO
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-        END
     ELSE
-        t1 := t0
+        p := 1
     END
 
-    RETURN t1 = t0
+    RETURN p MOD 2
 END _guard;
 
 
@@ -613,18 +581,50 @@ BEGIN
 END _exit;
 
 
-PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
+PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
+VAR
+    t0, t1, i, j: INTEGER;
+
 BEGIN
     SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
     API.init(param, code);
 
-    types := _types;
+    types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
+    ASSERT(types # 0);
+    FOR i := 0 TO tcount - 1 DO
+        FOR j := 0 TO tcount - 1 DO
+            t0 := i; t1 := j;
+
+            WHILE (t1 # 0) & (t1 # t0) DO
+                SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
     name  := modname;
 
     dll.process_detach := NIL;
     dll.thread_detach  := NIL;
     dll.thread_attach  := NIL;
+
+    fini := NIL
 END _init;
 
 
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    IF fini # NIL THEN
+        fini
+    END
+END _sofinit;
+
+
+PROCEDURE SetFini* (ProcFini: PROC);
+BEGIN
+    fini := ProcFini
+END SetFini;
+
+
 END RTL.

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

@@ -1,4 +1,4 @@
-(*
+(*
     Copyright 2016 Anton Krotov
 
     This program is free software: you can redistribute it and/or modify

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

@@ -38,16 +38,6 @@ VAR
     clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
 
 
-PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER;
-    RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1)
-END dlopen;
-
-
-PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER;
-    RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0]))
-END dlsym;
-
-
 PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
 VAR
     i, len, ptr: INTEGER;

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

@@ -22,11 +22,13 @@ CONST
     DLL_PROCESS_DETACH  = 0;
 
     SIZE_OF_DWORD = 4;
+    MAX_SET = 31;
 
 
 TYPE
 
     DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
+    PROC       = PROCEDURE;
 
 
 VAR
@@ -40,6 +42,8 @@ VAR
         thread_attach: DLL_ENTRY
     END;
 
+    fini: PROC;
+
 
 PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
 BEGIN
@@ -107,18 +111,12 @@ BEGIN
 END _arrcpy;
 
 
-PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
 BEGIN
     _move(MIN(len_dst, len_src) * chr_size, src, dst)
 END _strcpy;
 
 
-PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
-    _move(MIN(len_dst, len_src) * chr_size, src, dst)
-END _strcpy2;
-
-
 PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
 VAR
     i, n, k: INTEGER;
@@ -137,32 +135,29 @@ BEGIN
 END _rot;
 
 
-PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
+PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-VAR
-    res: INTEGER;
-
 BEGIN
-    IF (a <= b) & (a <= 31) & (b >= 0) THEN
+    IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
-        IF b > 31 THEN
+        IF b > MAX_SET THEN
-            b := 31
+            b := MAX_SET
         END;
         IF a < 0 THEN
             a := 0
         END;
-        res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
+        a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
     ELSE
-        res := 0
+        a := 0
     END
 
-    RETURN res
+    RETURN a
-END _set2;
-
-
-PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-    RETURN _set2(a, b)
 END _set;
 
 
+PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
+    RETURN _set(b, a)
+END _set2;
+
+
 PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
 BEGIN
     SYSTEM.CODE(
@@ -185,7 +180,7 @@ BEGIN
 END divmod;
 
 
-PROCEDURE div_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 
@@ -196,10 +191,10 @@ BEGIN
     END
 
     RETURN div
-END div_;
+END _div2;
 
 
-PROCEDURE mod_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 
@@ -210,29 +205,19 @@ BEGIN
     END
 
     RETURN mod
-END mod_;
+END _mod2;
 
 
 PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
-    RETURN div_(a, b)
+    RETURN _div2(a, b)
 END _div;
 
 
-PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
-    RETURN div_(a, b)
-END _div2;
-
-
 PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
-    RETURN mod_(a, b)
+    RETURN _mod2(a, b)
 END _mod;
 
 
-PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
-    RETURN mod_(a, b)
-END _mod2;
-
-
 PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
 BEGIN
     ptr := API._NEW(size);
@@ -251,50 +236,6 @@ BEGIN
 END _dispose;
 
 
-PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: CHAR;
-    res:  INTEGER;
-
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a);
-        SYSTEM.GET(b, B); INC(b);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmp;
-
-
-PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: WCHAR;
-    res:  INTEGER;
-
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a, 2);
-        SYSTEM.GET(b, B); INC(b, 2);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmpw;
-
-
 PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
 BEGIN
     SYSTEM.CODE(
@@ -345,16 +286,71 @@ BEGIN
 END _lengthw;
 
 
+PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: CHAR;
+    res: INTEGER;
+
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a);
+        SYSTEM.GET(b, B); INC(b);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmp;
+
+
+PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: WCHAR;
+    res: INTEGER;
+
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a, 2);
+        SYSTEM.GET(b, B); INC(b, 2);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmpw;
+
+
 PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
 VAR
     res:  INTEGER;
     bRes: BOOLEAN;
+    c:    CHAR;
 
 BEGIN
 
     res := strncmp(str1, str2, MIN(len1, len2));
-    IF res = 0 THEN
+    IF res = minint THEN
-        res := _length(len1, str1) - _length(len2, str2)
+        IF len1 > len2 THEN
+            SYSTEM.GET(str1 + len2, c);
+            res := ORD(c)
+        ELSIF len1 < len2 THEN
+            SYSTEM.GET(str2 + len1, c);
+            res := -ORD(c)
+        ELSE
+            res := 0
+        END
     END;
 
     CASE op OF
@@ -370,21 +366,25 @@ BEGIN
 END _strcmp;
 
 
-PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmp(op, len2, str2, len1, str1)
-END _strcmp2;
-
-
 PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
 VAR
     res:  INTEGER;
     bRes: BOOLEAN;
+    c:    WCHAR;
 
 BEGIN
 
     res := strncmpw(str1, str2, MIN(len1, len2));
-    IF res = 0 THEN
+    IF res = minint THEN
-        res := _lengthw(len1, str1) - _lengthw(len2, str2)
+        IF len1 > len2 THEN
+            SYSTEM.GET(str1 + len2 * 2, c);
+            res := ORD(c)
+        ELSIF len1 < len2 THEN
+            SYSTEM.GET(str2 + len1 * 2, c);
+            res := -ORD(c)
+        ELSE
+            res := 0
+        END
     END;
 
     CASE op OF
@@ -400,11 +400,6 @@ BEGIN
 END _strcmpw;
 
 
-PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmpw(op, len2, str2, len1, str1)
-END _strcmpw2;
-
-
 PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
 VAR
     c: CHAR;
@@ -470,14 +465,14 @@ BEGIN
 END append;
 
 
-PROCEDURE [stdcall] _error* (module, err: INTEGER);
+PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
 VAR
     s, temp: ARRAY 1024 OF CHAR;
 
 BEGIN
 
     s := "";
-    CASE err MOD 16 OF
+    CASE err OF
     | 1: append(s, "assertion failure")
     | 2: append(s, "NIL dereference")
     | 3: append(s, "division by zero")
@@ -494,7 +489,7 @@ BEGIN
     append(s, API.eol);
 
     append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
-    append(s, "line: ");     IntToStr(LSR(err, 4), temp);  append(s, temp);
+    append(s, "line: ");   IntToStr(line, temp);     append(s, temp);
 
     API.DebugMsg(SYSTEM.ADR(s[0]), name);
 
@@ -502,69 +497,42 @@ BEGIN
 END _error;
 
 
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
 BEGIN
-    (* r IS t0 *)
+    SYSTEM.GET(t0 + t1 + types, t0)
-
+    RETURN t0 MOD 2
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-
-    RETURN t1 = t0
 END _isrec;
 
 
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-VAR
-    t1: INTEGER;
-
 BEGIN
-    (* p IS t0 *)
-
     IF p # 0 THEN
-        DEC(p, SIZE_OF_DWORD);
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
-        SYSTEM.GET(p, t1);
+        SYSTEM.GET(t0 + p + types, p)
-        WHILE (t1 # 0) & (t1 # t0) DO
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-        END
-    ELSE
-        t1 := -1
     END
 
-    RETURN t1 = t0
+    RETURN p MOD 2
 END _is;
 
 
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
 BEGIN
-    (* r:t1 IS t0 *)
+    SYSTEM.GET(t0 + t1 + types, t0)
-
+    RETURN t0 MOD 2
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-
-    RETURN t1 = t0
 END _guardrec;
 
 
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
-VAR
-    t1:  INTEGER;
-
 BEGIN
-    (* p IS t0 *)
     SYSTEM.GET(p, p);
     IF p # 0 THEN
-        DEC(p, SIZE_OF_DWORD);
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
-        SYSTEM.GET(p, t1);
+        SYSTEM.GET(t0 + p + types, p)
-        WHILE (t1 # t0) & (t1 # 0) DO
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-        END
     ELSE
-        t1 := t0
+        p := 1
     END
 
-    RETURN t1 = t0
+    RETURN p MOD 2
 END _guard;
 
 
@@ -613,18 +581,50 @@ BEGIN
 END _exit;
 
 
-PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
+PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
+VAR
+    t0, t1, i, j: INTEGER;
+
 BEGIN
     SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
     API.init(param, code);
 
-    types := _types;
+    types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
+    ASSERT(types # 0);
+    FOR i := 0 TO tcount - 1 DO
+        FOR j := 0 TO tcount - 1 DO
+            t0 := i; t1 := j;
+
+            WHILE (t1 # 0) & (t1 # t0) DO
+                SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
     name  := modname;
 
     dll.process_detach := NIL;
     dll.thread_detach  := NIL;
     dll.thread_attach  := NIL;
+
+    fini := NIL
 END _init;
 
 
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    IF fini # NIL THEN
+        fini
+    END
+END _sofinit;
+
+
+PROCEDURE SetFini* (ProcFini: PROC);
+BEGIN
+    fini := ProcFini
+END SetFini;
+
+
 END RTL.

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

@@ -13,12 +13,14 @@ VAR
 
     eol*:  ARRAY 3 OF CHAR;
     base*: INTEGER;
+    heap:  INTEGER;
 
 
 PROCEDURE [windows-, "kernel32.dll", "ExitProcess"]    ExitProcess (code: INTEGER);
 PROCEDURE [windows-, "kernel32.dll", "ExitThread"]     ExitThread (code: INTEGER);
-PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"]  Alloc (uFlags, dwBytes: INTEGER): INTEGER;
+PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER;
-PROCEDURE [windows-, "kernel32.dll", "GlobalFree"]   Free (hMem: INTEGER): INTEGER;
+PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"]      HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
+PROCEDURE [windows-, "kernel32.dll", "HeapFree"]       HeapFree(hHeap, dwFlags, lpMem: INTEGER);
 
 PROCEDURE [windows-, "user32.dll", "MessageBoxA"]      MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
 
@@ -30,19 +32,22 @@ END DebugMsg;
 
 
 PROCEDURE _NEW* (size: INTEGER): INTEGER;
-    RETURN Alloc(64, size)
+    RETURN HeapAlloc(heap, 8, size)
 END _NEW;
 
 
 PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
-    RETURN Free(p)
+BEGIN
+    HeapFree(heap, 0, p)
+    RETURN 0
 END _DISPOSE;
 
 
 PROCEDURE init* (reserved, code: INTEGER);
 BEGIN
     eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
-    base := code - 4096
+    base := code - 4096;
+    heap := GetProcessHeap()
 END init;
 
 

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

@@ -22,11 +22,13 @@ CONST
     DLL_PROCESS_DETACH  = 0;
 
     SIZE_OF_DWORD = 4;
+    MAX_SET = 31;
 
 
 TYPE
 
     DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
+    PROC       = PROCEDURE;
 
 
 VAR
@@ -40,6 +42,8 @@ VAR
         thread_attach: DLL_ENTRY
     END;
 
+    fini: PROC;
+
 
 PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
 BEGIN
@@ -107,18 +111,12 @@ BEGIN
 END _arrcpy;
 
 
-PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
 BEGIN
     _move(MIN(len_dst, len_src) * chr_size, src, dst)
 END _strcpy;
 
 
-PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
-    _move(MIN(len_dst, len_src) * chr_size, src, dst)
-END _strcpy2;
-
-
 PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
 VAR
     i, n, k: INTEGER;
@@ -137,32 +135,29 @@ BEGIN
 END _rot;
 
 
-PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
+PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-VAR
-    res: INTEGER;
-
 BEGIN
-    IF (a <= b) & (a <= 31) & (b >= 0) THEN
+    IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
-        IF b > 31 THEN
+        IF b > MAX_SET THEN
-            b := 31
+            b := MAX_SET
         END;
         IF a < 0 THEN
             a := 0
         END;
-        res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
+        a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
     ELSE
-        res := 0
+        a := 0
     END
 
-    RETURN res
+    RETURN a
-END _set2;
-
-
-PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-    RETURN _set2(a, b)
 END _set;
 
 
+PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
+    RETURN _set(b, a)
+END _set2;
+
+
 PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
 BEGIN
     SYSTEM.CODE(
@@ -185,7 +180,7 @@ BEGIN
 END divmod;
 
 
-PROCEDURE div_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 
@@ -196,10 +191,10 @@ BEGIN
     END
 
     RETURN div
-END div_;
+END _div2;
 
 
-PROCEDURE mod_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 
@@ -210,29 +205,19 @@ BEGIN
     END
 
     RETURN mod
-END mod_;
+END _mod2;
 
 
 PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
-    RETURN div_(a, b)
+    RETURN _div2(a, b)
 END _div;
 
 
-PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
-    RETURN div_(a, b)
-END _div2;
-
-
 PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
-    RETURN mod_(a, b)
+    RETURN _mod2(a, b)
 END _mod;
 
 
-PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
-    RETURN mod_(a, b)
-END _mod2;
-
-
 PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
 BEGIN
     ptr := API._NEW(size);
@@ -251,50 +236,6 @@ BEGIN
 END _dispose;
 
 
-PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: CHAR;
-    res:  INTEGER;
-
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a);
-        SYSTEM.GET(b, B); INC(b);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmp;
-
-
-PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: WCHAR;
-    res:  INTEGER;
-
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a, 2);
-        SYSTEM.GET(b, B); INC(b, 2);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmpw;
-
-
 PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
 BEGIN
     SYSTEM.CODE(
@@ -345,16 +286,71 @@ BEGIN
 END _lengthw;
 
 
+PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: CHAR;
+    res: INTEGER;
+
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a);
+        SYSTEM.GET(b, B); INC(b);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmp;
+
+
+PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: WCHAR;
+    res: INTEGER;
+
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a, 2);
+        SYSTEM.GET(b, B); INC(b, 2);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmpw;
+
+
 PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
 VAR
     res:  INTEGER;
     bRes: BOOLEAN;
+    c:    CHAR;
 
 BEGIN
 
     res := strncmp(str1, str2, MIN(len1, len2));
-    IF res = 0 THEN
+    IF res = minint THEN
-        res := _length(len1, str1) - _length(len2, str2)
+        IF len1 > len2 THEN
+            SYSTEM.GET(str1 + len2, c);
+            res := ORD(c)
+        ELSIF len1 < len2 THEN
+            SYSTEM.GET(str2 + len1, c);
+            res := -ORD(c)
+        ELSE
+            res := 0
+        END
     END;
 
     CASE op OF
@@ -370,21 +366,25 @@ BEGIN
 END _strcmp;
 
 
-PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmp(op, len2, str2, len1, str1)
-END _strcmp2;
-
-
 PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
 VAR
     res:  INTEGER;
     bRes: BOOLEAN;
+    c:    WCHAR;
 
 BEGIN
 
     res := strncmpw(str1, str2, MIN(len1, len2));
-    IF res = 0 THEN
+    IF res = minint THEN
-        res := _lengthw(len1, str1) - _lengthw(len2, str2)
+        IF len1 > len2 THEN
+            SYSTEM.GET(str1 + len2 * 2, c);
+            res := ORD(c)
+        ELSIF len1 < len2 THEN
+            SYSTEM.GET(str2 + len1 * 2, c);
+            res := -ORD(c)
+        ELSE
+            res := 0
+        END
     END;
 
     CASE op OF
@@ -400,11 +400,6 @@ BEGIN
 END _strcmpw;
 
 
-PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmpw(op, len2, str2, len1, str1)
-END _strcmpw2;
-
-
 PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
 VAR
     c: CHAR;
@@ -470,14 +465,14 @@ BEGIN
 END append;
 
 
-PROCEDURE [stdcall] _error* (module, err: INTEGER);
+PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
 VAR
     s, temp: ARRAY 1024 OF CHAR;
 
 BEGIN
 
     s := "";
-    CASE err MOD 16 OF
+    CASE err OF
     | 1: append(s, "assertion failure")
     | 2: append(s, "NIL dereference")
     | 3: append(s, "division by zero")
@@ -494,7 +489,7 @@ BEGIN
     append(s, API.eol);
 
     append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
-    append(s, "line: ");     IntToStr(LSR(err, 4), temp);  append(s, temp);
+    append(s, "line: ");   IntToStr(line, temp);     append(s, temp);
 
     API.DebugMsg(SYSTEM.ADR(s[0]), name);
 
@@ -502,69 +497,42 @@ BEGIN
 END _error;
 
 
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
 BEGIN
-    (* r IS t0 *)
+    SYSTEM.GET(t0 + t1 + types, t0)
-
+    RETURN t0 MOD 2
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-
-    RETURN t1 = t0
 END _isrec;
 
 
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-VAR
-    t1: INTEGER;
-
 BEGIN
-    (* p IS t0 *)
-
     IF p # 0 THEN
-        DEC(p, SIZE_OF_DWORD);
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
-        SYSTEM.GET(p, t1);
+        SYSTEM.GET(t0 + p + types, p)
-        WHILE (t1 # 0) & (t1 # t0) DO
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-        END
-    ELSE
-        t1 := -1
     END
 
-    RETURN t1 = t0
+    RETURN p MOD 2
 END _is;
 
 
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
 BEGIN
-    (* r:t1 IS t0 *)
+    SYSTEM.GET(t0 + t1 + types, t0)
-
+    RETURN t0 MOD 2
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-
-    RETURN t1 = t0
 END _guardrec;
 
 
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
-VAR
-    t1:  INTEGER;
-
 BEGIN
-    (* p IS t0 *)
     SYSTEM.GET(p, p);
     IF p # 0 THEN
-        DEC(p, SIZE_OF_DWORD);
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
-        SYSTEM.GET(p, t1);
+        SYSTEM.GET(t0 + p + types, p)
-        WHILE (t1 # t0) & (t1 # 0) DO
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-        END
     ELSE
-        t1 := t0
+        p := 1
     END
 
-    RETURN t1 = t0
+    RETURN p MOD 2
 END _guard;
 
 
@@ -613,18 +581,50 @@ BEGIN
 END _exit;
 
 
-PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
+PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
+VAR
+    t0, t1, i, j: INTEGER;
+
 BEGIN
     SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
     API.init(param, code);
 
-    types := _types;
+    types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
+    ASSERT(types # 0);
+    FOR i := 0 TO tcount - 1 DO
+        FOR j := 0 TO tcount - 1 DO
+            t0 := i; t1 := j;
+
+            WHILE (t1 # 0) & (t1 # t0) DO
+                SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
     name  := modname;
 
     dll.process_detach := NIL;
     dll.thread_detach  := NIL;
     dll.thread_attach  := NIL;
+
+    fini := NIL
 END _init;
 
 
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    IF fini # NIL THEN
+        fini
+    END
+END _sofinit;
+
+
+PROCEDURE SetFini* (ProcFini: PROC);
+BEGIN
+    fini := ProcFini
+END SetFini;
+
+
 END RTL.

programs/develop/oberon07/Source/ARITH.ob07

@@ -7,7 +7,7 @@
 
 MODULE ARITH;
 
-IMPORT AVLTREES, STRINGS, MACHINE, UTILS;
+IMPORT AVLTREES, STRINGS, UTILS;
 
 
 CONST
@@ -53,10 +53,7 @@ BEGIN
     ELSIF v.typ = tWCHAR THEN
         res := v.int
     ELSIF v.typ = tSET THEN
-        res := ORD(v.set);
+        res := UTILS.Long(ORD(v.set))
-        IF MACHINE._64to32 THEN
-            res := MACHINE.Int32To64(res)
-        END
     ELSIF v.typ = tBOOLEAN THEN
         res := ORD(v.bool)
     END
@@ -88,13 +85,13 @@ VAR
 BEGIN
     error := FALSE;
 
-    IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN
+    IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN
         error := TRUE
     ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN
         error := TRUE
     ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN
         error := TRUE
-    ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN
+    ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN
         error := TRUE
     END
 
@@ -172,7 +169,7 @@ BEGIN
             n := i
         END;
 
-        IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN
+        IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
             error := 2
         ELSE
             value := value * 16 + d;
@@ -181,9 +178,7 @@ BEGIN
 
     END;
 
-    IF MACHINE._64to32 THEN
+    value := UTILS.Long(value);
-        value := MACHINE.Int32To64(value);
-    END;
 
     IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
         error := 3
@@ -471,58 +466,53 @@ END mulInt;
 
 
 PROCEDURE _ASR (x, n: INTEGER): INTEGER;
-BEGIN
+    RETURN ASR(UTILS.Long(x), n)
-    IF MACHINE._64to32 THEN
-        x := MACHINE.Int32To64(x)
-    END
-
-    RETURN ASR(x, n)
 END _ASR;
 
 
 PROCEDURE _LSR (x, n: INTEGER): INTEGER;
-BEGIN
+    RETURN UTILS.Long(LSR(UTILS.Short(x), n))
-    IF MACHINE._64to32 THEN
-        x := MACHINE.Int64To32(x);
-        x := LSR(x, n);
-        x := MACHINE.Int32To64(x)
-    ELSE
-        x := LSR(x, n)
-    END
-
-    RETURN x
 END _LSR;
 
 
 PROCEDURE _LSL (x, n: INTEGER): INTEGER;
-BEGIN
+    RETURN UTILS.Long(LSL(x, n))
-    x := LSL(x, n);
-    IF MACHINE._64to32 THEN
-        x := MACHINE.Int32To64(x)
-    END
-
-    RETURN x
 END _LSL;
 
 
 PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
 BEGIN
-    x := MACHINE.Int64To32(x);
+    x := UTILS.Short(x);
     x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
-    RETURN MACHINE.Int32To64(x)
+    RETURN UTILS.Long(x)
 END _ROR1_32;
 
 
+PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
+BEGIN
+    x := x MOD 65536;
+    x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
+    RETURN UTILS.Long(x)
+END _ROR1_16;
+
+
 PROCEDURE _ROR (x, n: INTEGER): INTEGER;
 BEGIN
-    IF MACHINE._64to32 THEN
+
+    CASE UTILS.bit_diff OF
+    |0: x := ROR(x, n)
+    |16, 48:
+        n := n MOD 16;
+        WHILE n > 0 DO
+            x := _ROR1_16(x);
+            DEC(n)
+        END
+    |32:
         n := n MOD 32;
         WHILE n > 0 DO
             x := _ROR1_32(x);
             DEC(n)
         END
-    ELSE
-        x := ROR(x, n)
     END
 
     RETURN x
@@ -587,11 +577,7 @@ BEGIN
     CASE v.typ OF
     |tCHAR, tWCHAR:
     |tBOOLEAN: v.int := ORD(v.bool)
-    |tSET:
+    |tSET:     v.int := UTILS.Long(ORD(v.set))
-        v.int := ORD(v.set);
-        IF MACHINE._64to32 THEN
-            v.int := MACHINE.Int32To64(v.int)
-        END
     END;
     v.typ := tINTEGER
 END ord;
@@ -787,7 +773,7 @@ BEGIN
 
     |"I":
         IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
-            IF range(v, 0, MACHINE.target.maxSet) THEN
+            IF range(v, 0, UTILS.target.maxSet) THEN
                 res := v.int IN v2.set
             ELSE
                 error := 2

programs/develop/oberon07/Source/AVLTREES.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 

programs/develop/oberon07/Source/BIN.ob07

@@ -7,7 +7,7 @@
 
 MODULE BIN;
 
-IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS;
+IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;
 
 
 CONST
@@ -138,7 +138,10 @@ BEGIN
     END;
 
     IF UTILS.bit_depth = 64 THEN
-        x := MACHINE.Int32To64(x)
+        x := LSL(x, 16);
+        x := LSL(x, 16);
+        x := ASR(x, 16);
+        x := ASR(x, 16)
     END
 
     RETURN x
@@ -151,7 +154,7 @@ VAR
 
 BEGIN
     FOR i := 0 TO 3 DO
-        CHL.SetByte(array, idx + i, MACHINE.Byte(x, i))
+        CHL.SetByte(array, idx + i, UTILS.Byte(x, i))
     END
 END put32le;
 
@@ -162,7 +165,7 @@ VAR
 
 BEGIN
     FOR i := 0 TO 3 DO
-        CHL.PushByte(program.data, MACHINE.Byte(x, i))
+        CHL.PushByte(program.data, UTILS.Byte(x, i))
     END
 END PutData32LE;
 
@@ -173,7 +176,7 @@ VAR
 
 BEGIN
     FOR i := 0 TO 7 DO
-        CHL.PushByte(program.data, MACHINE.Byte(x, i))
+        CHL.PushByte(program.data, UTILS.Byte(x, i))
     END
 END PutData64LE;
 
@@ -203,7 +206,7 @@ VAR
 
 BEGIN
     FOR i := 0 TO 3 DO
-        CHL.PushByte(program.code, MACHINE.Byte(x, i))
+        CHL.PushByte(program.code, UTILS.Byte(x, i))
     END
 END PutCode32LE;
 
@@ -217,7 +220,6 @@ END SetLabel;
 PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
 VAR
     imp: IMPRT;
-    i:   INTEGER;
 
 BEGIN
     CHL.PushByte(program.import, 0);
@@ -228,16 +230,9 @@ BEGIN
     END;
 
     NEW(imp);
-    imp.nameoffs := CHL.Length(program.import);
+    imp.nameoffs := CHL.PushStr(program.import, name);
     imp.label := label;
-    LISTS.push(program.imp_list, imp);
+    LISTS.push(program.imp_list, imp)
-
-    i := 0;
-    WHILE name[i] # 0X DO
-        CHL.PushByte(program.import, ORD(name[i]));
-        INC(i)
-    END;
-    CHL.PushByte(program.import, 0)
 END Import;
 
 
@@ -262,19 +257,11 @@ END less;
 PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
 VAR
     exp, cur: EXPRT;
-    i: INTEGER;
 
 BEGIN
     NEW(exp);
-    exp.nameoffs := CHL.Length(program.export);
     exp.label := CHL.GetInt(program.labels, label);
-
+    exp.nameoffs := CHL.PushStr(program.export, name);
-    i := 0;
-    WHILE name[i] # 0X DO
-        CHL.PushByte(program.export, ORD(name[i]));
-        INC(i)
-    END;
-    CHL.PushByte(program.export, 0);
 
     cur := program.exp_list.first(EXPRT);
     WHILE (cur # NIL) & less(program.export, cur, exp) DO
@@ -389,7 +376,7 @@ BEGIN
         array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
     END;
 
-    idx := idx + k
+    INC(idx, k)
 END InitArray;
 
 

programs/develop/oberon07/Source/CHUNKLISTS.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
@@ -118,6 +118,41 @@ BEGIN
 END PushByte;
 
 
+PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER;
+VAR
+    i, res: INTEGER;
+
+BEGIN
+    res := list.length;
+    i := 0;
+    REPEAT
+        PushByte(list, ORD(str[i]));
+        INC(i)
+    UNTIL str[i - 1] = 0X
+
+    RETURN res
+END PushStr;
+
+
+PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN;
+VAR
+    i:   INTEGER;
+    res: BOOLEAN;
+
+BEGIN
+    res := FALSE;
+    i := 0;
+    WHILE (pos < list.length) & (i < LEN(str)) & ~res DO
+        str[i] := CHR(GetByte(list, pos));
+        res := str[i] = 0X;
+        INC(pos);
+        INC(i)
+    END
+
+    RETURN res
+END GetStr;
+
+
 PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST);
 VAR
     chunk: BYTECHUNK;

programs/develop/oberon07/Source/COLLECTIONS.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 

programs/develop/oberon07/Source/CONSOLE.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
@@ -23,22 +23,32 @@ BEGIN
 END String;
 
 
-PROCEDURE Int* (n: INTEGER);
+PROCEDURE Int* (x: INTEGER);
 VAR
-    s: ARRAY 32 OF CHAR;
+    s: ARRAY 24 OF CHAR;
 
 BEGIN
-    STRINGS.IntToStr(n, s);
+    STRINGS.IntToStr(x, s);
     String(s)
 END Int;
 
 
-PROCEDURE Int2* (n: INTEGER);
+PROCEDURE Hex* (x, n: INTEGER);
+VAR
+    s: ARRAY 24 OF CHAR;
+
 BEGIN
-    IF n < 10 THEN
+    STRINGS.IntToHex(x, s, n);
+    String(s)
+END Hex;
+
+
+PROCEDURE Int2* (x: INTEGER);
+BEGIN
+    IF x < 10 THEN
         String("0")
     END;
-    Int(n)
+    Int(x)
 END Int2;
 
 
@@ -55,16 +65,16 @@ BEGIN
 END StringLn;
 
 
-PROCEDURE IntLn* (n: INTEGER);
+PROCEDURE IntLn* (x: INTEGER);
 BEGIN
-    Int(n);
+    Int(x);
     Ln
 END IntLn;
 
 
-PROCEDURE Int2Ln* (n: INTEGER);
+PROCEDURE Int2Ln* (x: INTEGER);
 BEGIN
-    Int2(n);
+    Int2(x);
     Ln
 END Int2Ln;
 

programs/develop/oberon07/Source/CONSTANTS.ob07

@@ -9,8 +9,8 @@ MODULE CONSTANTS;
 
 CONST
 
-    vMajor* = 0;
+    vMajor* = 1;
-    vMinor* = 98;
+    vMinor* = 0;
 
     FILE_EXT* = ".ob07";
     RTL_NAME* = "RTL";
@@ -26,7 +26,10 @@ CONST
     Target_iGUI64*     =  7;
     Target_iDLL64*     =  8;
     Target_iELF32*     =  9;
-    Target_iELF64*     = 10;
+    Target_iELFSO32*   = 10;
+    Target_iELF64*     = 11;
+    Target_iELFSO64*   = 12;
+    Target_iMSP430*    = 13;
 
     Target_sConsole*   = "console";
     Target_sGUI*       = "gui";
@@ -37,7 +40,10 @@ CONST
     Target_sGUI64*     = "gui64";
     Target_sDLL64*     = "dll64";
     Target_sELF32*     = "elfexe";
+    Target_sELFSO32*   = "elfso";
     Target_sELF64*     = "elfexe64";
+    Target_sELFSO64*   = "elfso64";
+    Target_sMSP430*    = "msp430";
 
 
 END CONSTANTS.

programs/develop/oberon07/Source/Compiler.ob07

@@ -7,7 +7,7 @@
 
 MODULE Compiler;
 
-IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER;
+IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430;
 
 
 PROCEDURE Target (s: ARRAY OF CHAR): INTEGER;
@@ -33,8 +33,14 @@ BEGIN
         res := mConst.Target_iDLL64
     ELSIF s = mConst.Target_sELF32 THEN
         res := mConst.Target_iELF32
+    ELSIF s = mConst.Target_sELFSO32 THEN
+        res := mConst.Target_iELFSO32
     ELSIF s = mConst.Target_sELF64 THEN
         res := mConst.Target_iELF64
+    ELSIF s = mConst.Target_sELFSO64 THEN
+        res := mConst.Target_iELFSO64
+    ELSIF s = mConst.Target_sMSP430 THEN
+        res := mConst.Target_iMSP430
     ELSE
         res := 0
     END
@@ -43,7 +49,7 @@ BEGIN
 END Target;
 
 
-PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET);
+PROCEDURE keys (VAR options: PROG.OPTIONS);
 VAR
     param: PARS.PATH;
     i, j:  INTEGER;
@@ -51,8 +57,10 @@ VAR
     value: INTEGER;
     minor,
     major: INTEGER;
+    checking: SET;
 
 BEGIN
+    checking := options.checking;
     end := FALSE;
     i := 4;
     REPEAT
@@ -62,7 +70,7 @@ BEGIN
             INC(i);
             UTILS.GetArg(i, param);
             IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
-                StackSize := value
+                options.stack := value
             END;
             IF param[0] = "-" THEN
                 DEC(i)
@@ -72,7 +80,27 @@ BEGIN
             INC(i);
             UTILS.GetArg(i, param);
             IF STRINGS.StrToInt(param, value) THEN
-                BaseAddress := ((value DIV 64) * 64) * 1024
+                options.base := ((value DIV 64) * 64) * 1024
+            END;
+            IF param[0] = "-" THEN
+                DEC(i)
+            END
+
+        ELSIF param = "-ram" THEN
+            INC(i);
+            UTILS.GetArg(i, param);
+            IF STRINGS.StrToInt(param, value) THEN
+                options.ram := value
+            END;
+            IF param[0] = "-" THEN
+                DEC(i)
+            END
+
+        ELSIF param = "-rom" THEN
+            INC(i);
+            UTILS.GetArg(i, param);
+            IF STRINGS.StrToInt(param, value) THEN
+                options.rom := value
             END;
             IF param[0] = "-" THEN
                 DEC(i)
@@ -109,32 +137,34 @@ BEGIN
                     END;
 
                     INC(j)
-                END
+                END;
+
             END
 
         ELSIF param = "-ver" THEN
             INC(i);
             UTILS.GetArg(i, param);
             IF STRINGS.StrToVer(param, major, minor) THEN
-                Version := major * 65536 + minor
+                options.version := major * 65536 + minor
             END;
             IF param[0] = "-" THEN
                 DEC(i)
             END
 
         ELSIF param = "-pic" THEN
-            pic := TRUE
+            options.pic := TRUE
 
         ELSIF param = "" THEN
             end := TRUE
 
         ELSE
-            ERRORS.error3("bad parameter: ", param, "")
+            ERRORS.BadParam(param)
         END;
 
         INC(i)
-    UNTIL end
+    UNTIL end;
 
+    options.checking := checking
 END keys;
 
 
@@ -149,38 +179,34 @@ VAR
     outname:    PARS.PATH;
     param:      PARS.PATH;
     temp:       PARS.PATH;
-
     target:     INTEGER;
-
+    bit_depth:  INTEGER;
     time:       INTEGER;
-
+    options:    PROG.OPTIONS;
-    StackSize,
-    Version,
-    BaseAdr:    INTEGER;
-    pic:        BOOLEAN;
-    checking:   SET;
-
-    bits64: BOOLEAN;
 
 BEGIN
-    StackSize := 2;
+    options.stack := 2;
-    Version := 65536;
+    options.version := 65536;
-    pic := FALSE;
+    options.pic := FALSE;
-    checking := ST.chkALL;
+    options.checking := ST.chkALL;
 
     PATHS.GetCurrentDirectory(app_path);
     lib_path := app_path;
 
     UTILS.GetArg(1, inname);
 
+    C.Ln;
+    C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
+        C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
+    C.StringLn("Copyright (c) 2018-2019, Anton Krotov");
+
     IF inname = "" THEN
-        C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
+        C.Ln;
-            C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln;
         C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln;
         IF UTILS.bit_depth = 64 THEN
-            C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln;
+            C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln;
         ELSIF UTILS.bit_depth = 32 THEN
-            C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln;
+            C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln;
         END;
         C.StringLn("optional settings:"); C.Ln;
         C.StringLn("  -stk <size>            set size of stack in megabytes"); C.Ln;
@@ -188,14 +214,17 @@ BEGIN
         C.StringLn('  -ver <major.minor>     set version of program'); C.Ln;
         C.StringLn('  -nochk <"ptibcwra">    disable runtime checking (pointers, types, indexes,');
         C.StringLn('                         BYTE, CHR, WCHR)'); C.Ln;
+        C.StringLn("  -ram <size>            set size of RAM in bytes (MSP430)"); C.Ln;
+        C.StringLn("  -rom <size>            set size of ROM in bytes (MSP430)"); C.Ln;
         UTILS.Exit(0)
     END;
 
     PATHS.split(inname, path, modname, ext);
 
     IF ext # mConst.FILE_EXT THEN
-        ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
+        ERRORS.Error(207)
     END;
+
     IF PATHS.isRelative(path) THEN
         PATHS.RelPath(app_path, path, temp);
         path := temp
@@ -203,7 +232,7 @@ BEGIN
 
     UTILS.GetArg(2, outname);
     IF outname = "" THEN
-        ERRORS.error1("not enough parameters")
+        ERRORS.Error(205)
     END;
     IF PATHS.isRelative(outname) THEN
         PATHS.RelPath(app_path, outname, temp);
@@ -212,59 +241,70 @@ BEGIN
 
     UTILS.GetArg(3, param);
     IF param = "" THEN
-        ERRORS.error1("not enough parameters")
+        ERRORS.Error(205)
     END;
 
     target := Target(param);
 
     IF target = 0 THEN
-        ERRORS.error1("bad parameter <target>")
+        ERRORS.Error(206)
     END;
 
-    bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
+    CASE target OF
-
+    |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
-    IF bits64 THEN
+        bit_depth := 64
-        IF UTILS.bit_depth = 32 THEN
+    |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
-            ERRORS.error1("bad parameter <target>")
+     mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32:
-        END;
+        bit_depth := 32
-        PARS.init(64, target)
+    |mConst.Target_iMSP430:
-    ELSE
+        bit_depth := 16;
-        PARS.init(32, target)
+        options.ram := MSP430.minRAM;
+        options.rom := MSP430.minROM
     END;
 
-    PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64};
+    IF UTILS.bit_depth < bit_depth THEN
-    PARS.program.obj := target = mConst.Target_iObject;
+        ERRORS.Error(206)
+    END;
 
     STRINGS.append(lib_path, "lib");
     STRINGS.append(lib_path, UTILS.slash);
 
-    IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
+    CASE target OF
+    |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL:
         IF target = mConst.Target_iDLL THEN
-            BaseAdr := 10000000H
+            options.base := 10000000H
         ELSE
-            BaseAdr := 400000H
+            options.base := 400000H
         END;
         STRINGS.append(lib_path, "Windows32")
 
-    ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN
+    |mConst.Target_iKolibri, mConst.Target_iObject:
         STRINGS.append(lib_path, "KolibriOS")
 
-    ELSIF target = mConst.Target_iELF32 THEN
+    |mConst.Target_iELF32, mConst.Target_iELFSO32:
         STRINGS.append(lib_path, "Linux32")
 
-    ELSIF target = mConst.Target_iELF64 THEN
+    |mConst.Target_iELF64, mConst.Target_iELFSO64:
         STRINGS.append(lib_path, "Linux64")
 
-    ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
+    |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64:
         STRINGS.append(lib_path, "Windows64")
 
+    |mConst.Target_iMSP430:
+        STRINGS.append(lib_path, "MSP430")
+
     END;
 
     STRINGS.append(lib_path, UTILS.slash);
 
-    keys(StackSize, BaseAdr, Version, pic, checking);
+    keys(options);
 
-    ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking);
+    PARS.init(bit_depth, target, options);
+
+    PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject};
+    PARS.program.obj := target = mConst.Target_iObject;
+
+    ST.compile(path, lib_path, modname, outname, target, options);
 
     time := UTILS.GetTickCount() - UTILS.time;
 

programs/develop/oberon07/Source/ELF.ob07

@@ -7,7 +7,7 @@
 
 MODULE ELF;
 
-IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS;
+IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS;
 
 
 CONST
@@ -68,9 +68,35 @@ TYPE
 
     END;
 
+
+    Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM)
+
+        d_tag, d_val: INTEGER
+
+    END;
+
+
+    Elf32_Sym = POINTER TO RECORD (LISTS.ITEM)
+
+        name, value, size: INTEGER;
+        info, other: CHAR;
+        shndx: WCHAR
+
+    END;
+
+
     FILE = WR.FILE;
 
 
+VAR
+
+    dynamic: LISTS.LIST;
+    strtab:  CHL.BYTELIST;
+    symtab:  LISTS.LIST;
+
+    hashtab, bucket, chain: CHL.INTLIST;
+
+
 PROCEDURE align (n, _align: INTEGER): INTEGER;
 BEGIN
     IF n MOD _align # 0 THEN
@@ -136,7 +162,75 @@ BEGIN
 END fixup;
 
 
-PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN);
+PROCEDURE NewDyn (tag, val: INTEGER);
+VAR
+    dyn: Elf32_Dyn;
+
+BEGIN
+    NEW(dyn);
+    dyn.d_tag := tag;
+    dyn.d_val := val;
+    LISTS.push(dynamic, dyn)
+END NewDyn;
+
+
+PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR);
+VAR
+    sym: Elf32_Sym;
+
+BEGIN
+    NEW(sym);
+    sym.name := name;
+    sym.value := value;
+    sym.size := size;
+    sym.info := info;
+    sym.other := other;
+    sym.shndx := shndx;
+
+    LISTS.push(symtab, sym)
+END NewSym;
+
+
+PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER;
+VAR
+    i, h: INTEGER;
+    g: SET;
+
+BEGIN
+    h := 0;
+    i := 0;
+    WHILE name[i] # 0X DO
+        h := h * 16 + ORD(name[i]);
+        g := BITS(h) * {28..31};
+        h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
+        INC(i)
+    END
+
+    RETURN h
+END HashStr;
+
+
+PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
+VAR
+    symi, hi, k: INTEGER;
+
+BEGIN
+    FOR symi := 0 TO symCount - 1 DO
+        CHL.SetInt(chain, symi, 0);
+        hi := CHL.GetInt(hashtab, symi) MOD symCount;
+        IF CHL.GetInt(bucket, hi) # 0 THEN
+            k := symi;
+            WHILE CHL.GetInt(chain, k) # 0 DO
+                k := CHL.GetInt(chain, k)
+            END;
+            CHL.SetInt(chain, k, CHL.GetInt(bucket, hi))
+        END;
+        CHL.SetInt(bucket, hi, symi)
+    END
+END MakeHash;
+
+
+PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN);
 CONST
     interp  =  0;
     dyn     =  1;
@@ -145,33 +239,67 @@ CONST
     data    =  4;
     bss     =  5;
 
+    linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2";
+    linuxInterpreter32 = "/lib/ld-linux.so.2";
+
+    exeBaseAddress32 = 8048000H;
+    exeBaseAddress64 = 400000H;
+    dllBaseAddress = 0;
+
+    DT_NULL = 0;
+    DT_NEEDED = 1;
+    DT_HASH = 4;
+    DT_STRTAB = 5;
+    DT_SYMTAB = 6;
+    DT_RELA = 7;
+    DT_RELASZ = 8;
+    DT_RELAENT = 9;
+    DT_STRSZ = 10;
+    DT_SYMENT = 11;
+    DT_INIT = 12;
+    DT_FINI = 13;
+    DT_SONAME = 14;
+    DT_REL = 17;
+    DT_RELSZ = 18;
+    DT_RELENT = 19;
+
 VAR
     ehdr: Elf32_Ehdr;
     phdr: ARRAY 16 OF Elf32_Phdr;
 
-    i, LoadAdr, offset, pad, VA: INTEGER;
+    i, BaseAdr, offset, pad, VA, symCount: INTEGER;
 
     SizeOf: RECORD header, code, data, bss: INTEGER END;
 
+    Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END;
+
     File: FILE;
 
-    str: ARRAY 40 OF CHAR; lstr: INTEGER;
+    Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
-    Dyn: ARRAY 350 OF BYTE;
+
+    item: LISTS.ITEM;
+
+    Name: ARRAY 2048 OF CHAR;
 
 BEGIN
-    IF amd64 THEN
+    dynamic := LISTS.create(NIL);
-        str := "/lib64/ld-linux-x86-64.so.2"
+    symtab  := LISTS.create(NIL);
-    ELSE
+    strtab  := CHL.CreateByteList();
-        str := "/lib/ld-linux.so.2"
-    END;
-    lstr := LENGTH(str);
 
     IF amd64 THEN
-        LoadAdr := 400000H
+        BaseAdr := exeBaseAddress64;
+        Interpreter := linuxInterpreter64
     ELSE
-        LoadAdr := 08048000H
+        BaseAdr := exeBaseAddress32;
+        Interpreter := linuxInterpreter32
     END;
 
+    IF so THEN
+        BaseAdr := dllBaseAddress
+    END;
+
+    lenInterpreter := LENGTH(Interpreter) + 1;
+
     SizeOf.code := CHL.Length(program.code);
     SizeOf.data := CHL.Length(program.data);
     SizeOf.bss  := program.bss;
@@ -192,7 +320,12 @@ BEGIN
         ehdr.e_ident[i] := 0
     END;
 
-    ehdr.e_type := WCHR(ET_EXEC);
+    IF so THEN
+        ehdr.e_type := WCHR(ET_DYN)
+    ELSE
+        ehdr.e_type := WCHR(ET_EXEC)
+    END;
+
     ehdr.e_version := 1;
     ehdr.e_shoff := 0;
     ehdr.e_flags := 0;
@@ -218,24 +351,92 @@ BEGIN
 
     phdr[interp].p_type := 3;
     phdr[interp].p_offset := SizeOf.header;
-    phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset;
+    phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
-    phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset;
+    phdr[interp].p_paddr := phdr[interp].p_vaddr;
-    phdr[interp].p_filesz := lstr + 1;
+    phdr[interp].p_filesz := lenInterpreter;
-    phdr[interp].p_memsz := lstr + 1;
+    phdr[interp].p_memsz := lenInterpreter;
     phdr[interp].p_flags := PF_R;
     phdr[interp].p_align := 1;
 
     phdr[dyn].p_type := 2;
     phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
-    phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset;
+    phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
-    phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset;
+    phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
-    IF amd64 THEN
+
-        phdr[dyn].p_filesz := 0A0H;
+    hashtab := CHL.CreateIntList();
-        phdr[dyn].p_memsz  := 0A0H
+
-    ELSE
+    CHL.PushInt(hashtab, HashStr(""));
-        phdr[dyn].p_filesz := 50H;
+    NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
-        phdr[dyn].p_memsz  := 50H
+    CHL.PushInt(hashtab, HashStr("dlopen"));
+    NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
+    CHL.PushInt(hashtab, HashStr("dlsym"));
+    NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
+
+    IF so THEN
+        item := program.exp_list.first;
+        WHILE item # NIL DO
+            ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
+            CHL.PushInt(hashtab, HashStr(Name));
+            NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
+            item := item.next
         END;
+        ASSERT(CHL.GetStr(program.data, program.modname, Name))
+    END;
+
+    symCount := LISTS.count(symtab);
+
+    bucket  := CHL.CreateIntList();
+    chain   := CHL.CreateIntList();
+
+    FOR i := 1 TO symCount DO
+        CHL.PushInt(bucket, 0);
+        CHL.PushInt(chain, 0)
+    END;
+
+    MakeHash(bucket, chain, symCount);
+
+    NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2"));
+    NewDyn(DT_STRTAB, 0);
+    NewDyn(DT_STRSZ, CHL.Length(strtab));
+    NewDyn(DT_SYMTAB, 0);
+
+    IF amd64 THEN
+        NewDyn(DT_SYMENT, 24);
+        NewDyn(DT_RELA, 0);
+        NewDyn(DT_RELASZ, 48);
+        NewDyn(DT_RELAENT, 24)
+    ELSE
+        NewDyn(DT_SYMENT, 16);
+        NewDyn(DT_REL, 0);
+        NewDyn(DT_RELSZ, 16);
+        NewDyn(DT_RELENT, 8)
+    END;
+
+    NewDyn(DT_HASH, 0);
+
+    IF so THEN
+        NewDyn(DT_SONAME, CHL.PushStr(strtab, Name));
+        NewDyn(DT_INIT, 0);
+        NewDyn(DT_FINI, 0)
+    END;
+
+    NewDyn(DT_NULL, 0);
+
+    Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64));
+    Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64));
+    Offset.hash   := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
+    Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
+
+    Offset.dyn := phdr[dyn].p_offset;
+
+    item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr;
+    item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr;
+    item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr;
+    item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash   + Offset.dyn + BaseAdr;
+
+    phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
+    phdr[dyn].p_memsz  := phdr[dyn].p_filesz;
+
     phdr[dyn].p_flags := PF_R;
     phdr[dyn].p_align := 1;
 
@@ -243,20 +444,15 @@ BEGIN
 
     phdr[header].p_type := 1;
     phdr[header].p_offset := offset;
-    phdr[header].p_vaddr := LoadAdr;
+    phdr[header].p_vaddr := BaseAdr;
-    phdr[header].p_paddr := LoadAdr;
+    phdr[header].p_paddr := BaseAdr;
-    IF amd64 THEN
+    phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz;
-        phdr[header].p_filesz := 305H;
+    phdr[header].p_memsz  := phdr[header].p_filesz;
-        phdr[header].p_memsz  := 305H
-    ELSE
-        phdr[header].p_filesz := 1D0H;
-        phdr[header].p_memsz  := 1D0H
-    END;
     phdr[header].p_flags := PF_R + PF_W;
     phdr[header].p_align := 1000H;
 
     offset := offset + phdr[header].p_filesz;
-    VA := LoadAdr + offset + 1000H;           
+    VA := BaseAdr + offset + 1000H;
 
     phdr[text].p_type := 1;
     phdr[text].p_offset := offset;
@@ -270,7 +466,7 @@ BEGIN
     ehdr.e_entry := phdr[text].p_vaddr;
 
     offset := offset + phdr[text].p_filesz;
-    VA := LoadAdr + offset + 2000H;
+    VA := BaseAdr + offset + 2000H;
     pad := (16 - VA MOD 16) MOD 16;
 
     phdr[data].p_type := 1;
@@ -283,7 +479,7 @@ BEGIN
     phdr[data].p_align := 1000H;
 
     offset := offset + phdr[data].p_filesz;
-    VA := LoadAdr + offset + 3000H;
+    VA := BaseAdr + offset + 3000H;
 
     phdr[bss].p_type := 1;
     phdr[bss].p_offset := offset;
@@ -294,7 +490,20 @@ BEGIN
     phdr[bss].p_flags := PF_R + PF_W;
     phdr[bss].p_align := 1000H;
 
-    fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
+    fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
+
+    item := symtab.first;
+    WHILE item # NIL DO
+        IF item(Elf32_Sym).value # 0 THEN
+            INC(item(Elf32_Sym).value, ehdr.e_entry)
+        END;
+        item := item.next
+    END;
+
+    IF so THEN
+        item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry;
+        item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
+    END;
 
     File := WR.Create(FileName);
 
@@ -340,34 +549,94 @@ BEGIN
         WritePH(File, phdr[bss])
     END;
 
-    FOR i := 0 TO lstr DO
+    FOR i := 0 TO lenInterpreter - 1 DO
-        WR.WriteByte(File, ORD(str[i]))
+        WR.WriteByte(File, ORD(Interpreter[i]))
     END;
 
     i := 0;
     IF amd64 THEN
-        BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000");
+        item := dynamic.first;
-        BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000");
+        WHILE item # NIL DO
-        BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000");
+            WR.Write64LE(File, item(Elf32_Dyn).d_tag);
-        BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000");
+            WR.Write64LE(File, item(Elf32_Dyn).d_val);
-        BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000");
+            item := item.next
-        BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000");
-        BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000");
-        BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000");
-        BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000");
-        BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69");
-        BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000")
-    ELSE
-        BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408");
-        BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000");
-        BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000");
-        BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000");
-        BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000");
-        BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32");
-        BIN.InitArray(Dyn, i, "000000000000000000")
         END;
 
-    WR.Write(File, Dyn, i);
+        item := symtab.first;
+        WHILE item # NIL DO
+            WR.Write32LE(File, item(Elf32_Sym).name);
+            WR.WriteByte(File, ORD(item(Elf32_Sym).info));
+            WR.WriteByte(File, ORD(item(Elf32_Sym).other));
+            Write16(File, item(Elf32_Sym).shndx);
+            WR.Write64LE(File, item(Elf32_Sym).value);
+            WR.Write64LE(File, item(Elf32_Sym).size);
+            item := item.next
+        END;
+
+        WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16);
+        WR.Write32LE(File, 1);
+        WR.Write32LE(File, 1);
+        WR.Write64LE(File, 0);
+        WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
+        WR.Write32LE(File, 1);
+        WR.Write32LE(File, 2);
+        WR.Write64LE(File, 0);
+
+        WR.Write32LE(File, symCount);
+        WR.Write32LE(File, symCount);
+
+        FOR i := 0 TO symCount - 1 DO
+            WR.Write32LE(File, CHL.GetInt(bucket, i))
+        END;
+
+        FOR i := 0 TO symCount - 1 DO
+            WR.Write32LE(File, CHL.GetInt(chain, i))
+        END;
+
+        CHL.WriteToFile(File, strtab);
+        WR.Write64LE(File, 0);
+        WR.Write64LE(File, 0)
+
+    ELSE
+        item := dynamic.first;
+        WHILE item # NIL DO
+            WR.Write32LE(File, item(Elf32_Dyn).d_tag);
+            WR.Write32LE(File, item(Elf32_Dyn).d_val);
+            item := item.next
+        END;
+
+        item := symtab.first;
+        WHILE item # NIL DO
+            WR.Write32LE(File, item(Elf32_Sym).name);
+            WR.Write32LE(File, item(Elf32_Sym).value);
+            WR.Write32LE(File, item(Elf32_Sym).size);
+            WR.WriteByte(File, ORD(item(Elf32_Sym).info));
+            WR.WriteByte(File, ORD(item(Elf32_Sym).other));
+            Write16(File, item(Elf32_Sym).shndx);
+            item := item.next
+        END;
+
+        WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
+        WR.Write32LE(File, 00000101H);
+        WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4);
+        WR.Write32LE(File, 00000201H);
+
+        WR.Write32LE(File, symCount);
+        WR.Write32LE(File, symCount);
+
+        FOR i := 0 TO symCount - 1 DO
+            WR.Write32LE(File, CHL.GetInt(bucket, i))
+        END;
+
+        FOR i := 0 TO symCount - 1 DO
+            WR.Write32LE(File, CHL.GetInt(chain, i))
+        END;
+
+        CHL.WriteToFile(File, strtab);
+        WR.Write32LE(File, 0);
+        WR.Write32LE(File, 0)
+
+    END;
 
     CHL.WriteToFile(File, program.code);
     WHILE pad > 0 DO

programs/develop/oberon07/Source/ERRORS.ob07

@@ -7,25 +7,35 @@
 
 MODULE ERRORS;
 
-IMPORT C := CONSOLE, UTILS;
+IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS;
 
 
-PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
+PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
 BEGIN
     IF hint = 0 THEN
-        C.String("  hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(")");
+        C.String("  hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
-        C.String(" variable '"); C.String(name); C.StringLn("' never used")
+        C.String("variable '"); C.String(name); C.StringLn("' never used")
     END
-END hintmsg;
+END HintMsg;
 
 
-PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
+PROCEDURE WarningMsg* (line, col, warning: INTEGER);
+BEGIN
+    C.String("  warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
+    CASE warning OF
+    |0: C.StringLn("passing a string value as a fixed array")
+    |1: C.StringLn("endless FOR loop")
+    END
+END WarningMsg;
+
+
+PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
 VAR
     str: ARRAY 80 OF CHAR;
 
 BEGIN
     C.Ln;
-    C.String("  error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
+    C.String("  error  ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
 
     CASE errno OF
     |  1: str := "missing 'H' or 'X'"
@@ -36,6 +46,7 @@ BEGIN
     |  6: str := "identifier too long"
     |  7: str := "number too long"
     |  8..12: str := "number too large"
+    | 13: str := "real numbers not supported"
 
     | 21: str := "'MODULE' expected"
     | 22: str := "identifier expected"
@@ -79,7 +90,7 @@ BEGIN
     | 60: str := "identifier does not match procedure name"
     | 61: str := "illegally marked identifier"
     | 62: str := "expression should be constant"
-    | 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected"
+    | 63: str := "not enough RAM"
     | 64: str := "'(' expected"
     | 65: str := "',' expected"
     | 66: str := "incompatible parameter"
@@ -126,46 +137,81 @@ BEGIN
     |107: str := "too large parameter of CHR"
     |108: str := "a variable or a procedure expected"
     |109: str := "expression should be constant"
-    |110: str := "'noalign' expected"
+
     |111: str := "record [noalign] cannot have a base type"
     |112: str := "record [noalign] cannot be a base type"
     |113: str := "result type of procedure should not be REAL"
     |114: str := "identifiers 'lib_init' and 'version' are reserved"
     |115: str := "recursive constant definition"
     |116: str := "procedure too deep nested"
-    |117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected"
+
-    |118: str := "this flag for Windows only"
-    |119: str := "this flag for Linux only"
     |120: str := "too many formal parameters"
+
+    |122: str := "negative divisor"
+    |123: str := "illegal flag"
+    |124: str := "unknown flag"
+    |125: str := "flag not supported"
     END;
     C.StringLn(str);
     C.String("  file:  ");  C.StringLn(fname);
     UTILS.Exit(1)
-END errormsg;
+END ErrorMsg;
 
 
-PROCEDURE error1* (s1: ARRAY OF CHAR);
+PROCEDURE Error1 (s1: ARRAY OF CHAR);
 BEGIN
     C.Ln;
     C.StringLn(s1);
     UTILS.Exit(1)
-END error1;
+END Error1;
 
 
-PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR);
+PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
 BEGIN
     C.Ln;
     C.String(s1); C.String(s2); C.StringLn(s3);
     UTILS.Exit(1)
-END error3;
+END Error3;
 
 
-PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR);
+PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR);
 BEGIN
     C.Ln;
     C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
     UTILS.Exit(1)
-END error5;
+END Error5;
+
+
+PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
+BEGIN
+    Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found")
+END WrongRTL;
+
+
+PROCEDURE BadParam* (param: ARRAY OF CHAR);
+BEGIN
+    Error3("bad parameter: ", param, "")
+END BadParam;
+
+
+PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR);
+BEGIN
+    Error5("file ", Path, Name, Ext, " not found")
+END FileNotFound;
+
+
+PROCEDURE Error* (n: INTEGER);
+BEGIN
+    CASE n OF
+    |201: Error1("writing file error")
+    |202: Error1("too many relocations")
+    |203: Error1("size of program is too large")
+    |204: Error1("size of global variables is too large")
+    |205: Error1("not enough parameters")
+    |206: Error1("bad parameter <target>")
+    |207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
+    END
+END Error;
 
 
 END ERRORS.

programs/develop/oberon07/Source/FILES.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 

programs/develop/oberon07/Source/KOS.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 

programs/develop/oberon07/Source/LISTS.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
@@ -168,6 +168,24 @@ BEGIN
 END count;
 
 
+PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM;
+VAR
+    item: ITEM;
+
+BEGIN
+    ASSERT(list # NIL);
+    ASSERT(idx >= 0);
+
+    item := list.first;
+    WHILE (item # NIL) & (idx > 0) DO
+        item := item.next;
+        DEC(idx)
+    END
+
+    RETURN item
+END getidx;
+
+
 PROCEDURE create* (list: LIST): LIST;
 BEGIN
     IF list = NIL THEN

programs/develop/oberon07/Source/MSCOFF.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
@@ -136,7 +136,7 @@ VAR
     PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
     BEGIN
         IF NumberOfRelocations >= 65536 THEN
-            ERRORS.error1("too many relocations")
+            ERRORS.Error(202)
         END;
         section.NumberOfRelocations := WCHR(NumberOfRelocations)
     END SetNumberOfRelocations;

programs/develop/oberon07/Source/MSP430RTL.ob07

@@ -0,0 +1,677 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE MSP430RTL;
+
+
+CONST
+
+    _mul*      =  0;
+    _divmod*   =  1;
+    _lsl*      =  2;
+    _asr*      =  3;
+    _ror*      =  4;
+    _lsr*      =  5;
+    _in*       =  6;
+    _in2*      =  7;
+    _set1*     =  8;
+    _incl*     =  9;
+    _excl*     = 10;
+    _move*     = 11;
+    _set*      = 12;
+    _arrcpy*   = 13;
+    _rot*      = 14;
+    _strcmp*   = 15;
+    _error*    = 16;
+    _is*       = 17;
+    _guard*    = 18;
+    _guardrec* = 19;
+    _length*   = 20;
+    _new*      = 21;
+
+
+    HP = 14;
+
+    LenIV* = 32;
+
+    iv          = 10000H - LenIV * 2;
+    sp          = iv - 2;
+    empty_proc* = sp - 2;
+    free_size   = empty_proc - 2;
+    free_adr    = free_size - 2;
+    bits        = free_adr - 272;
+    bits_offs   = bits - 32;
+    DataSize*   = iv - bits_offs;
+    types       = bits_offs - 2;
+
+    IntVectorSize* = LenIV * 2 + DataSize;
+
+    VarSize*  = 4;
+
+
+TYPE
+
+    EMITPROC = PROCEDURE (n: INTEGER);
+
+
+VAR
+
+    ram*, trap*, int*: INTEGER;
+
+    rtl*: ARRAY 22 OF
+              RECORD
+                  label*: INTEGER;
+                  used:   BOOLEAN
+              END;
+
+    Label, Word, Call: EMITPROC;
+
+
+PROCEDURE Gen*;
+
+
+    PROCEDURE Word1 (word: INTEGER);
+    BEGIN
+        Word(word)
+    END Word1;
+
+
+    PROCEDURE Word2 (word1, word2: INTEGER);
+    BEGIN
+        Word1(word1);
+        Word1(word2)
+    END Word2;
+
+
+    PROCEDURE Word3 (word1, word2, word3: INTEGER);
+    BEGIN
+        Word1(word1);
+        Word1(word2);
+        Word1(word3)
+    END Word3;
+
+
+BEGIN
+    (* _lsl (n, x: INTEGER): INTEGER *)
+    IF rtl[_lsl].used THEN
+        Label(rtl[_lsl].label);
+        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
+        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
+        Word2(0F035H, 15);            (*  AND  #15, R5             *)
+        Word1(2400H + 3);             (*  JZ   L1                  *)
+                                      (*  L2:                      *)
+        Word1(5404H);                 (*  ADD  R4, R4              *)
+        Word1(8315H);                 (*  SUB  #1, R5              *)
+        Word1(2000H + 400H - 3);      (*  JNZ  L2                  *)
+                                      (*  L1:                      *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _asr (n, x: INTEGER): INTEGER *)
+    IF rtl[_asr].used THEN
+        Label(rtl[_asr].label);
+        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
+        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
+        Word2(0F035H, 15);            (*  AND  #15, R5             *)
+        Word1(2400H + 3);             (*  JZ   L1                  *)
+                                      (*  L2:                      *)
+        Word1(1104H);                 (*  RRA  R4                  *)
+        Word1(8315H);                 (*  SUB  #1, R5              *)
+        Word1(2000H + 400H - 3);      (*  JNZ  L2                  *)
+                                      (*  L1:                      *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _ror (n, x: INTEGER): INTEGER *)
+    IF rtl[_ror].used THEN
+        Label(rtl[_ror].label);
+        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
+        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
+        Word2(0F035H, 15);            (*  AND  #15, R5             *)
+        Word1(2400H + 5);             (*  JZ   L1                  *)
+        Word1(4406H);                 (*  MOV  R4, R6              *)
+                                      (*  L2:                      *)
+        Word1(1006H);                 (*  RRC  R6                  *)
+        Word1(1004H);                 (*  RRC  R4                  *)
+        Word1(8315H);                 (*  SUB  #1, R5              *)
+        Word1(2000H + 400H - 4);      (*  JNZ  L2                  *)
+                                      (*  L1:                      *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _lsr (n, x: INTEGER): INTEGER *)
+    IF rtl[_lsr].used THEN
+        Label(rtl[_lsr].label);
+        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- n  *)
+        Word2(4114H, 4);              (*  MOV  4(SP), R4; R4 <- x  *)
+        Word2(0F035H, 15);            (*  AND  #15, R5             *)
+        Word1(2400H + 4);             (*  JZ   L1                  *)
+                                      (*  L2:                      *)
+        Word1(0C312H);                (*  BIC  #1, SR              *)
+        Word1(1004H);                 (*  RRC  R4                  *)
+        Word1(8315H);                 (*  SUB  #1, R5              *)
+        Word1(2000H + 400H - 4);      (*  JNZ  L2                  *)
+                                      (*  L1:                      *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _set (b, a: INTEGER): SET *)
+    IF rtl[_set].used THEN
+        Label(rtl[_set].label);
+        Word2(4114H, 2);              (*  MOV  2(SP), R4; R4 <- b  *)
+        Word2(4115H, 4);              (*  MOV  4(SP), R5; R5 <- a  *)
+        Word1(9504H);                 (*  CMP  R5, R4              *)
+        Word1(3800H + 24);            (*  JL   L1                  *)
+        Word2(9035H, 16);             (*  CMP  #16, R5             *)
+        Word1(3400H + 21);            (*  JGE  L1                  *)
+        Word1(9304H);                 (*  CMP  #0, R4              *)
+        Word1(3800H + 19);            (*  JL   L1                  *)
+        Word2(9034H, 16);             (*  CMP  #16, R4             *)
+        Word1(3800H + 2);             (*  JL   L2                  *)
+        Word2(4034H, 15);             (*  MOV  #15, R4             *)
+                                      (*  L2:                      *)
+        Word1(9305H);                 (*  CMP  #0, R5              *)
+        Word1(3400H + 1);             (*  JGE  L3                  *)
+        Word1(4305H);                 (*  MOV  #0, R5              *)
+                                      (*  L3:                      *)
+        Word1(8504H);                 (*  SUB  R5, R4              *)
+        Word1(5404H);                 (*  ADD  R4, R4              *)
+        Word2(5034H, bits_offs);      (*  ADD  bits_offs, R4       *)
+        Word1(4424H);                 (*  MOV  @R4, R4             *)
+        Word1(5505H);                 (*  ADD  R5, R5              *)
+        Word1(5405H);                 (*  ADD  R4, R5              *)
+        Word2(5035H, bits);           (*  ADD  bits, R5            *)
+        Word1(4524H);                 (*  MOV  @R5, R4             *)
+        Word1(4130H);                 (*  MOV  @SP+, PC            *)
+                                      (*  L1:                      *)
+        Word1(4304H);                 (*  MOV  #0, R4              *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _set1 (a: INTEGER): SET *)
+    IF rtl[_set1].used THEN
+        Label(rtl[_set1].label);
+        Word2(4114H, 2);              (*  MOV  2(SP), R4; R4 <- a  *)
+        Word2(0B034H, 0FFF0H);        (*  BIT  #0FFF0H, R4         *)
+        Word1(2000H + 5);             (*  JNZ  L1                  *)
+        Word1(5404H);                 (*  ADD  R4, R4              *)
+        Word2(5034H, bits);           (*  ADD  bits, R4            *)
+        Word1(4424H);                 (*  MOV  @R4, R4             *)
+        Word1(4130H);                 (*  MOV  @SP+, PC            *)
+                                      (*  L1:                      *)
+        Word1(4304H);                 (*  MOV  #0, R4              *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _in2 (i, s: INTEGER): BOOLEAN *)
+    IF rtl[_in2].used THEN
+        Label(rtl[_in2].label);
+        Word2(4114H, 2);               (*  MOV  2(SP), R4; R4 <- i  *)
+        Word1(5404H);                  (*  ADD  R4, R4              *)
+        Word2(5034H, bits);            (*  ADD  bits, R4            *)
+        Word1(4424H);                  (*  MOV  @R4, R4             *)
+        Word2(0F114H, 4);              (*  AND  4(SP), R4           *)
+        Word1(2400H + 1);              (*  JZ   L1                  *)
+        Word1(4314H);                  (*  MOV  #1, R4              *)
+                                       (*  L1:                      *)
+        Word1(4130H)                   (*  RET                      *)
+    END;
+
+    (* _in (s, i: INTEGER): BOOLEAN *)
+    IF rtl[_in].used THEN
+        Label(rtl[_in].label);
+        Word2(4114H, 4);               (*  MOV  4(SP), R4; R4 <- i  *)
+        Word2(0B034H, 0FFF0H);         (*  BIT  #0FFF0H, R4         *)
+        Word1(2000H + 9);              (*  JNZ  L2                  *)
+        Word1(5404H);                  (*  ADD  R4, R4              *)
+        Word2(5034H, bits);            (*  ADD  bits, R4            *)
+        Word1(4424H);                  (*  MOV  @R4, R4             *)
+        Word2(0F114H, 2);              (*  AND  2(SP), R4           *)
+        Word1(2400H + 3);              (*  JZ   L1                  *)
+        Word1(4314H);                  (*  MOV  #1, R4              *)
+        Word1(4130H);                  (*  MOV  @SP+, PC            *)
+                                       (*  L2:                      *)
+        Word1(4304H);                  (*  MOV  #0, R4              *)
+                                       (*  L1:                      *)
+        Word1(4130H)                   (*  RET                      *)
+    END;
+
+    (* _incl (VAR s: SET; i: INTEGER) *)
+    IF rtl[_incl].used THEN
+        Label(rtl[_incl].label);
+        Word2(4114H, 4);          (*  MOV  4(SP), R4; R4 <- i  *)
+        Word2(0B034H, 0FFF0H);    (*  BIT  #0FFF0H, R4         *)
+        Word1(2000H + 8);         (*  JNZ  L1                  *)
+        Word1(5404H);             (*  ADD  R4, R4              *)
+        Word2(5034H, bits);       (*  ADD  bits, R4            *)
+        Word1(4424H);             (*  MOV  @R4, R4             *)
+        Word2(4115H, 2);          (*  MOV  2(SP), R5; R5 <- @s *)
+        Word2(0D485H, 0);         (*  BIS  R4, 0(R5)           *)
+                                  (*  L1:                      *)
+        Word1(4130H)              (*  RET                      *)
+    END;
+
+    (* _excl (VAR s: SET; i: INTEGER) *)
+    IF rtl[_excl].used THEN
+        Label(rtl[_excl].label);
+        Word2(4114H, 4);          (*  MOV  4(SP), R4; R4 <- i  *)
+        Word2(0B034H, 0FFF0H);    (*  BIT  #0FFF0H, R4         *)
+        Word1(2000H + 8);         (*  JNZ  L1                  *)
+        Word1(5404H);             (*  ADD  R4, R4              *)
+        Word2(5034H, bits);       (*  ADD  bits, R4            *)
+        Word1(4424H);             (*  MOV  @R4, R4             *)
+        Word2(4115H, 2);          (*  MOV  2(SP), R5; R5 <- @s *)
+        Word2(0C485H, 0);         (*  BIC  R4, 0(R5)           *)
+                                  (*  L1:                      *)
+        Word1(4130H)              (*  RET                      *)
+    END;
+
+    (* _rot (len, adr: INTEGER) *)
+    IF rtl[_rot].used THEN
+        Label(rtl[_rot].label);
+        Word2(4114H, 2);              (*  MOV    2(SP), R4; R4 <- len   *)
+        Word2(4115H, 4);              (*  MOV    4(SP), R5; R5 <- adr   *)
+        Word1(8314H);                 (*  SUB    #1, R4                 *)
+        Word1(5404H);                 (*  ADD    R4, R4                 *)
+        Word1(1225H);                 (*  PUSH   @R5                    *)
+        Word1(4406H);                 (*  MOV    R4, R6                 *)
+                                      (*  L1:                           *)
+        Word3(4595H, 2, 0);           (*  MOV    2(R5), 0(R5)           *)
+        Word1(5325H);                 (*  ADD    #2, R5                 *)
+        Word1(8326H);                 (*  SUB    #2, R6                 *)
+        Word1(2000H + 400H - 6);      (*  JNZ    L1                     *)
+        Word2(41B5H, 0);              (*  MOV    @SP+, 0(R5)            *)
+        Word1(4130H)                  (*  RET                           *)
+    END;
+
+    (* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *)
+    IF rtl[_divmod].used THEN
+        Label(rtl[_divmod].label);
+        Word2(4115H, 4);              (*  MOV  4(SP), R5; R5 <- a  *)
+        Word1(4304H);                 (*  MOV  #0, R4              *)
+                                      (*  L1:                      *)
+        Word2(4116H, 2);              (*  MOV  2(SP), R6; R6 <- b  *)
+        Word1(9605H);                 (*  CMP  R6, R5              *)
+        Word1(3800H + 17);            (*  JL   L3                  *)
+        Word1(4327H);                 (*  MOV  #2, R7              *)
+        Word1(5606H);                 (*  ADD  R6, R6              *)
+                                      (*  L4:                      *)
+        Word1(9306H);                 (*  CMP  #0, R6              *)
+        Word1(2400H + 6);             (*  JZ   L2                  *)
+        Word1(3800H + 5);             (*  JL   L2                  *)
+        Word1(9605H);                 (*  CMP  R6, R5              *)
+        Word1(3800H + 3);             (*  JL   L2                  *)
+        Word1(5606H);                 (*  ADD  R6, R6              *)
+        Word1(5707H);                 (*  ADD  R7, R7              *)
+        Word1(3C00H + 400H - 8);      (*  JMP  L4                  *)
+                                      (*  L2:                      *)
+        Word1(0C312H);                (*  BIC  #1, SR              *)
+        Word1(1006H);                 (*  RRC  R6                  *)
+        Word1(0C312H);                (*  BIC  #1, SR              *)
+        Word1(1007H);                 (*  RRC  R7                  *)
+        Word1(8605H);                 (*  SUB  R6, R5              *)
+        Word1(5704H);                 (*  ADD  R7, R4              *)
+        Word1(3C00H + 400H - 21);     (*  JMP  L1                  *)
+                                      (*  L3:                      *)
+        (*----------- (a < 0) --------------*)
+                                      (*  L1:                      *)
+        Word1(9305H);                 (*  CMP  #0, R5              *)
+        Word1(3400H + 23);            (*  JGE  L3                  *)
+        Word2(4116H, 2);              (*  MOV  2(SP), R6; R6 <- b  *)
+        Word1(4327H);                 (*  MOV  #2, R7              *)
+        Word1(5606H);                 (*  ADD  R6, R6              *)
+        Word1(0E335H);                (*  XOR  #-1, R5             *)
+        Word1(5315H);                 (*  ADD  #1,  R5             *)
+                                      (*  L4:                      *)
+        Word1(9306H);                 (*  CMP  #0, R6              *)
+        Word1(2400H + 6);             (*  JZ   L2                  *)
+        Word1(3800H + 5);             (*  JL   L2                  *)
+        Word1(9605H);                 (*  CMP  R6, R5              *)
+        Word1(3800H + 3);             (*  JL   L2                  *)
+        Word1(5606H);                 (*  ADD  R6, R6              *)
+        Word1(5707H);                 (*  ADD  R7, R7              *)
+        Word1(3C00H + 400H - 8);      (*  JMP  L4                  *)
+                                      (*  L2:                      *)
+        Word1(0E335H);                (*  XOR  #-1, R5             *)
+        Word1(5315H);                 (*  ADD  #1,  R5             *)
+        Word1(0C312H);                (*  BIC  #1, SR              *)
+        Word1(1006H);                 (*  RRC  R6                  *)
+        Word1(0C312H);                (*  BIC  #1, SR              *)
+        Word1(1007H);                 (*  RRC  R7                  *)
+        Word1(5605H);                 (*  ADD  R6, R5              *)
+        Word1(8704H);                 (*  SUB  R7, R4              *)
+        Word1(3C00H + 400H - 25);     (*  JMP  L1                  *)
+                                      (*  L3:                      *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _mul (a, b: INTEGER): INTEGER *)
+    IF rtl[_mul].used THEN
+        Label(rtl[_mul].label);
+        Word2(4115H, 2);              (*  MOV  2(SP), R5; R5 <- a  *)
+        Word2(4116H, 4);              (*  MOV  4(SP), R6; R6 <- b  *)
+        Word1(4304H);                 (*  MOV  #0, R4; res := 0    *)
+        Word1(9306H);                 (*  CMP  #0, R6              *)
+        Word1(2400H + 7);             (*  JZ   L1                  *)
+                                      (*  L2:                      *)
+        Word1(0B316H);                (*  BIT  #1, R6              *)
+        Word1(2400H + 1);             (*  JZ   L3                  *)
+        Word1(5504H);                 (*  ADD  R5, R4              *)
+                                      (*  L3:                      *)
+        Word1(5505H);                 (*  ADD  R5, R5              *)
+        Word1(0C312H);                (*  BIC  #1, SR              *)
+        Word1(1006H);                 (*  RRC  R6                  *)
+        Word1(2000H + 400H - 7);      (*  JNZ  L2                  *)
+                                      (*  L1:                      *)
+        Word1(4130H)                  (*  RET                      *)
+    END;
+
+    (* _error (module, err, line: INTEGER) *)
+    IF rtl[_error].used THEN
+        Label(rtl[_error].label);
+        Word1(0C232H);               (*  BIC   #8, SR; DINT                 *)
+        Word1(4303H);                (*  MOV   R3, R3; NOP                  *)
+        Word2(4114H, 2);             (*  MOV   2(SP), R4; R4 <- module      *)
+        Word2(4115H, 4);             (*  MOV   4(SP), R5; R5 <- err         *)
+        Word2(4116H, 6);             (*  MOV   6(SP), R6; R6 <- line        *)
+        Word2(4211H, sp);            (*  MOV   sp(SR), SP                   *)
+        Word1(1206H);                (*  PUSH  R6                           *)
+        Word1(1204H);                (*  PUSH  R4                           *)
+        Word1(1205H);                (*  PUSH  R5                           *)
+        Word2(4214H, trap);          (*  MOV   trap(SR), R4                 *)
+        Word1(9304H);                (*  TST   R4                           *)
+        Word1(2400H + 1);            (*  JZ    L                            *)
+        Word1(1284H);                (*  CALL  R4                           *)
+                                     (*  L:                                 *)
+        Word2(04032H, 0F0H)          (*  MOV   CPUOFF+OSCOFF+SCG0+SCG1, SR  *)
+    END;
+
+    (* _new (t, size: INTEGER; VAR ptr: INTEGER) *)
+    IF rtl[_new].used THEN
+        Label(rtl[_new].label);
+        Word1(1202H);                  (*  PUSH SR            *)
+        Word1(4302H);                  (*  MOV  #0, SR        *)
+        Word1(4303H);                  (*  NOP                *)
+        Word1(4104H);                  (*  MOV  SP, R4        *)
+        Word2(8034H, 16);              (*  SUB  #16, R4       *)
+        Word1(4005H + 100H * HP);      (*  MOV  HP, R5        *)
+        Word2(5115H, 6);               (*  ADD  6(SP), R5     *)
+        Word1(9504H);                  (*  CMP  R5, R4        *)
+        Word2(4114H, 8);               (*  MOV  8(SP), R4     *)
+        Word1(3800H + 12);             (*  JL   L1            *)
+        Word3(4190H + HP, 4, 0);       (*  MOV  4(SP), 0(HP)  *)
+        Word1(5320H + HP);             (*  ADD  #2, HP        *)
+        Word2(4084H + 100H * HP, 0);   (*  MOV  HP, 0(R4)     *)
+                                       (*  L3                 *)
+        Word2(4380H + HP, 0);          (*  MOV  #0, 0(HP)     *)
+        Word1(5320H + HP);             (*  ADD  #2, HP        *)
+        Word1(9500H + HP);             (*  CMP  R5, HP        *)
+        Word1(3800H + 400H - 5);       (*  JL   L3            *)
+        Word1(3C00H + 2);              (*  JMP  L2            *)
+                                       (*  L1                 *)
+        Word2(4384H, 0);               (*  MOV  #0, 0(R4)     *)
+                                       (*  L2                 *)
+        Word1(1300H)                   (*  RETI               *)
+    END;
+
+    (* _guardrec (t0, t1: INTEGER): INTEGER *)
+    IF rtl[_guardrec].used THEN
+        Label(rtl[_guardrec].label);
+        Word2(4114H, 2);              (*  MOV  2(SP), R4; R4 <- t0  *)
+        Word2(4115H, 4);              (*  MOV  4(SP), R5; R5 <- t1  *)
+        Word2(4036H, types);          (*  MOV  #types, R6           *)
+                                      (*  L3:                       *)
+        Word1(9305H);                 (*  CMP  #0, R5               *)
+        Word1(2400H + 8);             (*  JZ   L1                   *)
+        Word1(9405H);                 (*  CMP  R4, R5               *)
+        Word1(2400H + 10);            (*  JZ   L2                   *)
+        Word1(5505H);                 (*  ADD  R5, R5               *)
+        Word1(0E335H);                (*  XOR  #-1, R5              *)
+        Word1(5315H);                 (*  ADD  #1, R5               *)
+        Word1(5605H);                 (*  ADD  R6, R5               *)
+        Word1(4525H);                 (*  MOV  @R5, R5              *)
+        Word1(3C00H + 400H - 10);     (*  JMP  L3                   *)
+                                      (*  L1:                       *)
+        Word1(9405H);                 (*  CMP  R4, R5               *)
+        Word1(2400H + 2);             (*  JZ   L2                   *)
+        Word1(4304H);                 (*  MOV  #0, R4               *)
+        Word1(4130H);                 (*  MOV  @SP+, PC             *)
+                                      (*  L2:                       *)
+        Word1(4314H);                 (*  MOV  #1, R4               *)
+        Word1(4130H)                  (*  RET                       *)
+    END;
+
+    (* _is (t, p: INTEGER): INTEGER *)
+    IF rtl[_is].used THEN
+        Label(rtl[_is].label);
+        Word2(4114H, 4);             (*  MOV  4(SP), R4; R4 <- p  *)
+        Word2(4115H, 2);             (*  MOV  2(SP), R5; R5 <- t  *)
+        Word1(9304H);                (*  TST  R4                  *)
+        Word1(2400H + 2);            (*  JZ   L                   *)
+        Word2(4414H, -2);            (*  MOV  -2(R4), R4          *)
+                                     (*  L:                       *)
+        Word1(1204H);                (*  PUSH R4                  *)
+        Word1(1205H);                (*  PUSH R5                  *)
+        Call(rtl[_guardrec].label);  (*  CALL _guardrec           *)
+        Word1(5221H);                (*  ADD  #4, SP              *)
+        Word1(4130H)                 (*  RET                      *)
+    END;
+
+    (* _guard (t, p: INTEGER): INTEGER *)
+    IF rtl[_guard].used THEN
+        Label(rtl[_guard].label);
+        Word2(4115H, 4);             (*  MOV  4(SP), R5; R5 <- p  *)
+        Word1(4314H);                (*  MOV  #1, R4              *)
+        Word1(4525H);                (*  MOV  @R5, R5             *)
+        Word1(9305H);                (*  TST  R5                  *)
+        Word1(2400H + 9);            (*  JZ   L                   *)
+        Word2(4515H, -2);            (*  MOV  -2(R5), R5          *)
+        Word2(4114H, 2);             (*  MOV  2(SP), R4; R4 <- t  *)
+        Word1(1205H);                (*  PUSH R5                  *)
+        Word1(1204H);                (*  PUSH R4                  *)
+        Call(rtl[_guardrec].label);  (*  CALL _guardrec           *)
+        Word1(5221H);                (*  ADD  #4, SP              *)
+                                     (*  L:                       *)
+        Word1(4130H)                 (*  RET                      *)
+    END;
+
+    (* _move (bytes, dest, source: INTEGER) *)
+    IF rtl[_move].used THEN
+        Label(rtl[_move].label);
+        Word2(4116H, 2);              (*  MOV    2(SP), R6; R6 <- bytes   *)
+        Word2(4117H, 4);              (*  MOV    4(SP), R7; R7 <- dest    *)
+        Word2(4115H, 6);              (*  MOV    6(SP), R5; R5 <- source  *)
+        Word1(9306H);                 (*  CMP    #0, R6                   *)
+        Word1(3800H + 6);             (*  JL     L1                       *)
+        Word1(2400H + 5);             (*  JZ     L1                       *)
+                                      (*  L2:                             *)
+        Word2(45F7H, 0);              (*  MOV.B  @R5+, 0(R7)              *)
+        Word1(5317H);                 (*  ADD    #1, R7                   *)
+        Word1(8316H);                 (*  SUB    #1, R6                   *)
+        Word1(2000H + 400H - 5);      (*  JNZ    L2                       *)
+                                      (*  L1:                             *)
+        Word1(4130H)                  (*  RET                             *)
+    END;
+
+    (* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *)
+    IF rtl[_arrcpy].used THEN
+        Label(rtl[_arrcpy].label);
+        Word3(9191H, 8, 4);          (*  CMP  8(SP), 4(SP) *)
+        Word1(3800H + 18);           (*  JL   L1           *)
+        Word2(1211H, 12);            (*  PUSH 12(SP)       *)
+        Word2(1211H, 10);            (*  PUSH 10(SP)       *)
+        Word2(1211H, 14);            (*  PUSH 14(SP)       *)
+        Word2(1211H, 10);            (*  PUSH 10(SP)       *)
+        Call(rtl[_mul].label);       (*  CALL _mul         *)
+        Word1(5221H);                (*  ADD  #4, SP       *)
+        Word1(1204H);                (*  PUSH R4           *)
+        Call(rtl[_move].label);      (*  CALL _move        *)
+        Word2(5031H, 6);             (*  ADD  #6, SP       *)
+        Word1(4314H);                (*  MOV  #1, R4       *)
+        Word1(4130H);                (*  RET               *)
+                                     (*  L1                *)
+        Word1(4304H);                (*  MOV  #0, R4       *)
+        Word1(4130H)                 (*  RET               *)
+    END;
+
+    (* _length (len, str: INTEGER): INTEGER *)
+    IF rtl[_length].used THEN
+        Label(rtl[_length].label);
+        Word2(4116H, 2);              (*  MOV    2(SP), R6; R6 <- len  *)
+        Word2(4117H, 4);              (*  MOV    4(SP), R7; R7 <- str  *)
+        Word1(4304H);                 (*  MOV    #0, R4; res := 0      *)
+                                      (*  L2:                          *)
+        Word1(4775H);                 (*  MOV.B  @R7+, R5              *)
+        Word1(9305H);                 (*  CMP    #0, R5                *)
+        Word1(2400H + 3);             (*  JZ     L1                    *)
+        Word1(5314H);                 (*  ADD    #1, R4                *)
+        Word1(8316H);                 (*  SUB    #1, R6                *)
+        Word1(2000H + 400H - 6);      (*  JNZ    L2                    *)
+                                      (*  L1:                          *)
+        Word1(4130H)                  (*  RET                          *)
+    END;
+
+    (* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *)
+    IF rtl[_strcmp].used THEN
+        Label(rtl[_strcmp].label);
+        Word2(4116H, 4);            (*  MOV    4(SP), R6; R6 <- len2   *)
+        Word2(4117H, 8);            (*  MOV    8(SP), R7; R7 <- len1   *)
+        Word1(9607H);               (*  CMP    R6, R7                  *)
+        Word1(3400H + 1);           (*  JGE    L5                      *)
+        Word1(4706H);               (*  MOV    R7, R6                  *)
+                                    (*  L5:                            *)
+        Word1(1206H);               (*  PUSH   R6                      *)
+        Word2(4116H, 12);           (*  MOV    12(SP), R6; R6 <- str1  *)
+        Word2(4117H, 8);            (*  MOV    8(SP), R7; R7 <- str2   *)
+                                    (*  L3:                            *)
+        Word2(9381H, 0);            (*  CMP    #0, 0(SP)               *)
+        Word1(2400H + 11);          (*  JZ     L1                      *)
+        Word1(4674H);               (*  MOV.B  @R6+, R4                *)
+        Word1(4775H);               (*  MOV.B  @R7+, R5                *)
+        Word2(8391H, 0);            (*  SUB    #1, 0(SP)               *)
+        Word1(9405H);               (*  CMP    R4, R5                  *)
+        Word1(2400H + 2);           (*  JZ     L2                      *)
+        Word1(8504H);               (*  SUB    R5, R4                  *)
+        Word1(3C00H + 5);           (*  JMP    L4                      *)
+                                    (*  L2:                            *)
+        Word1(9304H);               (*  CMP    #0, R4                  *)
+        Word1(2000H + 400H - 13);   (*  JNZ    L3                      *)
+        Word1(3C00H + 2);           (*  JMP    L4                      *)
+                                    (*  L1:                            *)
+        Word2(4034H, 8000H);        (*  MOV    #8000H, R4              *)
+                                    (*  L4:                            *)
+        Word1(5321H);               (*  ADD    #2, SP                  *)
+
+        Word2(9034H, 8000H);        (*  CMP    #8000H, R4              *)
+        Word1(2000H + 18);          (*  JNZ    L6                      *)
+        Word2(4116H, 4);            (*  MOV    4(SP), R6; R6 <- len2   *)
+        Word2(4117H, 8);            (*  MOV    8(SP), R7; R7 <- len1   *)
+        Word1(9607H);               (*  CMP    R6, R7                  *)
+        Word1(2400H + 11);          (*  JZ     L7                      *)
+        Word1(3800H + 4);           (*  JL     L8                      *)
+        Word2(5116H, 10);           (*  ADD    10(SP), R6              *)
+        Word1(4664H);               (*  MOV.B  @R6, R4                 *)
+        Word1(3C00H + 7);           (*  JMP    L6                      *)
+                                    (*  L8:                            *)
+        Word2(5117H, 6);            (*  ADD    6(SP), R7               *)
+        Word1(4764H);               (*  MOV.B  @R7, R4                 *)
+        Word1(0E334H);              (*  XOR    #-1, R4                 *)
+        Word1(5314H);               (*  ADD    #1, R4                  *)
+        Word1(3C00H + 1);           (*  JMP    L6                      *)
+                                    (*  L7:                            *)
+        Word1(4304H);               (*  MOV    #0, R4                  *)
+                                    (*  L6:                            *)
+
+        Word2(5110H, 2);            (*  ADD  2(SP), PC; PC <- PC + op  *)
+
+        Word1(9304H);               (*  CMP  #0, R4  *)
+        Word1(4314H);               (*  MOV  #1, R4  *)
+        Word1(2400H + 1);           (*  JZ   L       *)
+        Word1(4304H);               (*  MOV  #0, R4  *)
+                                    (*  L            *)
+        Word1(4130H);               (*  RET          *)
+        Word1(4303H);               (*  NOP          *)
+
+        Word1(9304H);               (*  CMP  #0, R4  *)
+        Word1(4314H);               (*  MOV  #1, R4  *)
+        Word1(2000H + 1);           (*  JNZ  L       *)
+        Word1(4304H);               (*  MOV  #0, R4  *)
+                                    (*  L            *)
+        Word1(4130H);               (*  RET          *)
+        Word1(4303H);               (*  NOP          *)
+
+        Word1(9304H);               (*  CMP  #0, R4  *)
+        Word1(4314H);               (*  MOV  #1, R4  *)
+        Word1(3800H + 1);           (*  JL   L       *)
+        Word1(4304H);               (*  MOV  #0, R4  *)
+                                    (*  L            *)
+        Word1(4130H);               (*  RET          *)
+        Word1(4303H);               (*  NOP          *)
+
+        Word1(9304H);               (*  CMP  #0, R4  *)
+        Word1(4314H);               (*  MOV  #1, R4  *)
+        Word1(3800H + 2);           (*  JL   L       *)
+        Word1(2400H + 1);           (*  JZ   L       *)
+        Word1(4304H);               (*  MOV  #0, R4  *)
+                                    (*  L            *)
+        Word1(4130H);               (*  RET          *)
+
+        Word1(9304H);               (*  CMP  #0, R4  *)
+        Word1(4304H);               (*  MOV  #0, R4  *)
+        Word1(3800H + 2);           (*  JL   L       *)
+        Word1(2400H + 1);           (*  JZ   L       *)
+        Word1(4314H);               (*  MOV  #1, R4  *)
+                                    (*  L            *)
+        Word1(4130H);               (*  RET          *)
+
+        Word1(9304H);               (*  CMP  #0, R4  *)
+        Word1(4314H);               (*  MOV  #1, R4  *)
+        Word1(3400H + 1);           (*  JGE  L       *)
+        Word1(4304H);               (*  MOV  #0, R4  *)
+                                    (*  L            *)
+        Word1(4130H)                (*  RET          *)
+    END
+
+END Gen;
+
+
+PROCEDURE Set* (idx, label: INTEGER);
+BEGIN
+    rtl[idx].label := label;
+    rtl[idx].used  := FALSE
+END Set;
+
+
+PROCEDURE Used* (idx: INTEGER);
+BEGIN
+    rtl[idx].used := TRUE;
+    IF (idx = _guard) OR (idx = _is) THEN
+        rtl[_guardrec].used := TRUE
+    ELSIF idx = _arrcpy THEN
+        rtl[_move].used := TRUE;
+        rtl[_mul].used  := TRUE
+    END
+END Used;
+
+
+PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER);
+BEGIN
+    Label := pLabel;
+    Word  := pWord;
+    Call  := pCall;
+
+    IF ramSize > 2048 THEN
+        ram := 1100H
+    ELSE
+        ram := 200H
+    END;
+    trap := ram;
+    int  := trap + 2
+END Init;
+
+
+END MSP430RTL.

programs/develop/oberon07/Source/PARS.ob07

@@ -7,7 +7,7 @@
 
 MODULE PARS;
 
-IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS;
+IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
 
 
 CONST
@@ -24,6 +24,12 @@ TYPE
 
     PARSER* = POINTER TO rPARSER;
 
+    POSITION* = RECORD (SCAN.POSITION)
+
+        parser*: PARSER
+
+    END;
+
     EXPR* = RECORD
 
         obj*:         INTEGER;
@@ -37,7 +43,7 @@ TYPE
 
     STATPROC  = PROCEDURE (parser: PARSER);
     EXPRPROC  = PROCEDURE (parser: PARSER; VAR e: EXPR);
-    RETPROC   = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
+    RETPROC   = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
 
     rPARSER = RECORD (C.ITEM)
 
@@ -83,34 +89,40 @@ BEGIN
 END destroy;
 
 
-PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
+PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
 BEGIN
-    ERRORS.errormsg(parser.fname, pos.line, pos.col, errno)
+    pos.line   := parser.lex.pos.line;
+    pos.col    := parser.lex.pos.col;
+    pos.parser := parser
+END getpos;
+
+
+PROCEDURE error* (pos: POSITION; errno: INTEGER);
+BEGIN
+    ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
 END error;
 
 
-PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
+PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
 BEGIN
     IF ~condition THEN
-        error(parser, pos, errno)
+        error(pos, errno)
     END
 END check;
 
 
 PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
+VAR
+    pos: POSITION;
+
 BEGIN
     IF ~condition THEN
-        error(parser, parser.lex.pos, errno)
+        getpos(parser, pos);
+        error(pos, errno)
     END
 END check1;
 
 
-PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION);
-BEGIN
-    pos := parser.lex.pos
-END getpos;
-
-
 PROCEDURE Next* (parser: PARSER);
 VAR
     errno: INTEGER;
@@ -118,6 +130,14 @@ VAR
 BEGIN
     SCAN.Next(parser.scanner, parser.lex);
     errno := parser.lex.error;
+    IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
+        IF parser.lex.sym = SCAN.lxFLOAT THEN
+            errno := -SCAN.lxERROR13
+        ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
+            errno := -SCAN.lxERROR10
+        END
+    END;
+
     IF errno # 0 THEN
         check1(FALSE, parser, errno)
     END;
@@ -125,10 +145,10 @@ BEGIN
 END Next;
 
 
-PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION);
+PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
 BEGIN
     Next(parser);
-    pos := parser.lex.pos
+    getpos(parser, pos)
 END NextPos;
 
 
@@ -180,15 +200,12 @@ PROCEDURE ImportList (parser: PARSER);
 VAR
     name:    SCAN.IDENT;
     parser2: PARSER;
-    pos:        SCAN.POSITION;
+    pos:     POSITION;
     alias:   BOOLEAN;
     unit:    PROG.UNIT;
     ident:   PROG.IDENT;
-    units:      PROG.UNITS;
 
 BEGIN
-    units := program.units;
-
     alias := FALSE;
 
     REPEAT
@@ -199,18 +216,18 @@ BEGIN
         getpos(parser, pos);
 
         IF ~alias THEN
-            ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE);
+            ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
-            check(ident # NIL, parser, pos, 30)
+            check(ident # NIL, pos, 30)
         END;
 
         Next(parser);
 
         IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
             alias := FALSE;
-            unit := units.get(units, name);
+            unit := PROG.getUnit(program, name);
 
             IF unit # NIL THEN
-                check(unit.closed, parser, pos, 31)
+                check(unit.closed, pos, 31)
             ELSE
                 parser2 := parser.create(parser.path, parser.lib_path,
                     parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
@@ -220,9 +237,9 @@ BEGIN
                         destroy(parser2);
                         parser2 := parser.create(parser.lib_path, parser.lib_path,
                             parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
-                        check(parser2.open(parser2, name.s), parser, pos, 29)
+                        check(parser2.open(parser2, name.s), pos, 29)
                     ELSE
-                        check(FALSE, parser, pos, 29)
+                        error(pos, 29)
                     END
                 END;
 
@@ -257,7 +274,7 @@ VAR
 BEGIN
     ASSERT(parser.sym = SCAN.lxIDENT);
 
-    ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
+    ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
 
     IF ~forward THEN
         check1(ident # NIL, parser, 48)
@@ -267,7 +284,7 @@ BEGIN
         unit := ident.unit;
         ExpectSym(parser, SCAN.lxPOINT);
         ExpectSym(parser, SCAN.lxIDENT);
-        ident := unit.idents.get(unit, parser.lex.ident, FALSE);
+        ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
         check1((ident # NIL) & ident.export, parser, 48)
     END
 
@@ -312,21 +329,20 @@ BEGIN
     END;
 
     ARITH.setbool(v, bool)
-
 END strcmp;
 
 
 PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
 VAR
     e: EXPR;
-    pos: SCAN.POSITION;
+    pos: POSITION;
 
 BEGIN
     getpos(parser, pos);
     parser.constexp := TRUE;
     parser.expression(parser, e);
     parser.constexp := FALSE;
-    check(e.obj = eCONST, parser, pos, 62);
+    check(e.obj = eCONST, pos, 62);
     v := e.value
 END ConstExpression;
 
@@ -335,7 +351,7 @@ PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
 VAR
     name:   SCAN.IDENT;
     export: BOOLEAN;
-    pos:     SCAN.POSITION;
+    pos:    POSITION;
 
 BEGIN
     ASSERT(parser.sym = SCAN.lxIDENT);
@@ -355,7 +371,7 @@ BEGIN
             Next(parser)
         END;
 
-        check(rec.fields.add(rec, name, export), parser, pos, 30);
+        check(PROG.addField(rec, name, export), pos, 30);
 
         IF parser.sym = SCAN.lxCOMMA THEN
             ExpectSym(parser, SCAN.lxIDENT)
@@ -391,7 +407,7 @@ VAR
         exit := FALSE;
 
         WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
-            check1(type.params.add(type, parser.lex.ident, vPar), parser, 30);
+            check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
             Next(parser);
             IF parser.sym = SCAN.lxCOMMA THEN
                 ExpectSym(parser, SCAN.lxIDENT)
@@ -412,13 +428,13 @@ VAR
                 t1 := t0;
 
                 WHILE dim > 0 DO
-                    t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
+                    t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
                     t1.base := t0;
                     t0 := t1;
                     DEC(dim)
                 END;
 
-                type.params.set(type, t1);
+                PROG.setParams(type, t1);
                 Next(parser);
                 exit := TRUE
             ELSE
@@ -449,7 +465,7 @@ BEGIN
             ExpectSym(parser, SCAN.lxIDENT);
             ident := QIdent(parser, FALSE);
             check1(ident.typ = PROG.idTYPE, parser, 68);
-            check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69);
+            check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
             check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
             type.base := ident.type;
             Next(parser)
@@ -461,54 +477,83 @@ BEGIN
 END FormalParameters;
 
 
-PROCEDURE sysflag (parser: PARSER): INTEGER;
+PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
 VAR
-    res: INTEGER;
+    res, sf: INTEGER;
 
 BEGIN
     IF parser.lex.s = "stdcall" THEN
-        res := PROG.stdcall
+        sf := PROG.sf_stdcall
     ELSIF parser.lex.s = "stdcall64" THEN
-        res := PROG.stdcall64
+        sf := PROG.sf_stdcall64
     ELSIF parser.lex.s = "ccall" THEN
-        res := PROG.ccall
+        sf := PROG.sf_ccall
     ELSIF parser.lex.s = "ccall16" THEN
-        res := PROG.ccall16
+        sf := PROG.sf_ccall16
     ELSIF parser.lex.s = "win64" THEN
-        res := PROG.win64
+        sf := PROG.sf_win64
     ELSIF parser.lex.s = "systemv" THEN
-        res := PROG.systemv
+        sf := PROG.sf_systemv
     ELSIF parser.lex.s = "windows" THEN
+        sf := PROG.sf_windows
+    ELSIF parser.lex.s = "linux" THEN
+        sf := PROG.sf_linux
+    ELSIF parser.lex.s = "code" THEN
+        sf := PROG.sf_code
+    ELSIF parser.lex.s = "noalign" THEN
+        sf := PROG.sf_noalign
+    ELSE
+        check1(FALSE, parser, 124)
+    END;
+
+    check1(sf IN program.target.sysflags, parser, 125);
+
+    IF proc THEN
+        check1(sf IN PROG.proc_flags, parser, 123)
+    ELSE
+        check1(sf IN PROG.rec_flags, parser, 123)
+    END;
+
+    CASE sf OF
+    |PROG.sf_stdcall:
+        res := PROG.stdcall
+    |PROG.sf_stdcall64:
+        res := PROG.stdcall64
+    |PROG.sf_ccall:
+        res := PROG.ccall
+    |PROG.sf_ccall16:
+        res := PROG.ccall16
+    |PROG.sf_win64:
+        res := PROG.win64
+    |PROG.sf_systemv:
+        res := PROG.systemv
+    |PROG.sf_code:
+        res := PROG.code
+    |PROG.sf_windows:
         IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
             res := PROG.stdcall
         ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
             res := PROG.win64
-        ELSE
-            check1(FALSE, parser, 118)
         END
-    ELSIF parser.lex.s = "linux" THEN
+    |PROG.sf_linux:
-        IF program.target.sys = mConst.Target_iELF32 THEN
+        IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
             res := PROG.ccall16
-        ELSIF program.target.sys = mConst.Target_iELF64 THEN
+        ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
             res := PROG.systemv
-        ELSE
-            check1(FALSE, parser, 119)
         END
-    ELSIF parser.lex.s = "noalign" THEN
+    |PROG.sf_noalign:
         res := PROG.noalign
-    ELSE
-        res := 0
     END
 
     RETURN res
 END sysflag;
 
 
-PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
+PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
 VAR
     call: INTEGER;
     dll, proc: SCAN.LEXSTR;
-    pos:  SCAN.POSITION;
+    pos: POSITION;
 
 BEGIN
 
@@ -518,12 +563,7 @@ BEGIN
         getpos(parser, pos);
         check1(parser.unit.sysimport, parser, 54);
         Next(parser);
-        call := sysflag(parser);
+        call := sysflag(parser, TRUE);
-        IF program.target.bit_depth = 64 THEN
-            check1(call IN PROG.callconv64, parser, 117)
-        ELSIF program.target.bit_depth = 32 THEN
-            check1(call IN PROG.callconv32, parser, 63)
-        END;
         Next(parser);
         IF parser.sym = SCAN.lxMINUS THEN
             Next(parser);
@@ -539,20 +579,21 @@ BEGIN
             ExpectSym(parser, SCAN.lxSTRING);
             proc := parser.lex.s;
             Next(parser);
-            import := CODE.AddImp(dll, proc)
+            import := IL.AddImp(dll, proc)
         END;
         checklex(parser, SCAN.lxRSQUARE);
         Next(parser)
     ELSE
-        IF program.target.bit_depth = 32 THEN
+        CASE program.target.bit_depth OF
-            call := PROG.default
+        |16: call := PROG.default16
-        ELSIF program.target.bit_depth = 64 THEN
+        |32: call := PROG.default32
-            call := PROG.default64
+        |64: call := PROG.default64
         END
     END;
 
     IF import # NIL THEN
-        check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70)
+        check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
+            mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
     END
 
     RETURN call
@@ -570,12 +611,12 @@ VAR
     typeSize:   ARITH.VALUE;
     ident:      PROG.IDENT;
     unit:       PROG.UNIT;
-    pos, pos2:  SCAN.POSITION;
+    pos, pos2:  POSITION;
     fieldType:  PROG.TYPE_;
     baseIdent:  SCAN.IDENT;
     a, b:       INTEGER;
     RecFlag:    INTEGER;
-    import:     CODE.IMPORT_PROC;
+    import:     IL.IMPORT_PROC;
 
 BEGIN
     unit := parser.unit;
@@ -604,11 +645,11 @@ BEGIN
 
         ConstExpression(parser, arrLen);
 
-        check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43);
+        check(arrLen.typ = ARITH.tINTEGER, pos, 43);
-        check(ARITH.check(arrLen),         parser, pos, 39);
+        check(ARITH.check(arrLen),         pos, 39);
-        check(ARITH.getInt(arrLen) > 0,    parser, pos, 51);
+        check(ARITH.getInt(arrLen) > 0,    pos, 51);
 
-        t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
+        t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
 
         IF parser.sym = SCAN.lxCOMMA THEN
             type(parser, t.base, {comma, closed})
@@ -623,8 +664,8 @@ BEGIN
 
         a := t.length;
         b := t.base.size;
-        check(ARITH.mulInt(a, b), parser, pos2, 104);
+        check(ARITH.mulInt(a, b), pos2, 104);
-        check(ARITH.setInt(typeSize, a), parser, pos2, 104);
+        check(ARITH.setInt(typeSize, a), pos2, 104);
         t.size := a;
 
         t.closed := TRUE
@@ -633,19 +674,14 @@ BEGIN
         getpos(parser, pos2);
         Next(parser);
 
-        t := program.enterType(program, PROG.tRECORD, 0, 0, unit);
+        t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
         t.align := 1;
 
         IF parser.sym = SCAN.lxLSQUARE THEN
             check1(parser.unit.sysimport, parser, 54);
             Next(parser);
-            RecFlag := sysflag(parser);
+            RecFlag := sysflag(parser, FALSE);
-            IF RecFlag = PROG.noalign THEN
+            t.noalign := RecFlag = PROG.noalign;
-                t.noalign := TRUE
-            ELSE
-                check1(FALSE, parser, 110)
-            END;
-
             ExpectSym(parser, SCAN.lxRSQUARE);
             Next(parser)
         END;
@@ -657,14 +693,14 @@ BEGIN
 
             type(parser, t.base, {closed});
 
-            check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52);
+            check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
 
             IF t.base.typ = PROG.tPOINTER THEN
                 t.base := t.base.base;
-                check(t.base # NIL, parser, pos, 55)
+                check(t.base # NIL, pos, 55)
             END;
 
-            check(~t.base.noalign, parser, pos, 112);
+            check(~t.base.noalign, pos, 112);
 
             checklex(parser, SCAN.lxRROUND);
             Next(parser);
@@ -684,7 +720,7 @@ BEGIN
             Next(parser);
 
             type(parser, fieldType, {closed});
-            check(t.fields.set(t, fieldType), parser, pos2, 104);
+            check(PROG.setFields(t, fieldType), pos2, 104);
 
             IF (fieldType.align > t.align) & ~t.noalign THEN
                 t.align := fieldType.align
@@ -699,11 +735,11 @@ BEGIN
 
         t.closed := TRUE;
 
-        CODE.AddRec(t.base.num);
+        IL.AddRec(t.base.num);
 
         IF ~t.noalign THEN
-            check(MACHINE.Align(t.size, t.align), parser, pos2, 104);
+            check(UTILS.Align(t.size, t.align), pos2, 104);
-            check(ARITH.setInt(typeSize, t.size), parser, pos2, 104)
+            check(ARITH.setInt(typeSize, t.size), pos2, 104)
         END;
 
         checklex(parser, SCAN.lxEND);
@@ -713,7 +749,7 @@ BEGIN
         ExpectSym(parser, SCAN.lxTO);
         Next(parser);
 
-        t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
+        t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
         t.align := program.target.adr;
 
         getpos(parser, pos);
@@ -725,14 +761,14 @@ BEGIN
         type(parser, t.base, {forward});
 
         IF t.base # NIL THEN
-            check(t.base.typ = PROG.tRECORD, parser, pos, 58)
+            check(t.base.typ = PROG.tRECORD, pos, 58)
         ELSE
-            unit.pointers.add(unit, t, baseIdent, pos)
+            PROG.frwPtr(unit, t, baseIdent, pos)
         END
 
     ELSIF parser.sym = SCAN.lxPROCEDURE THEN
         NextPos(parser, pos);
-        t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
+        t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
         t.align := program.target.adr;
         t.call := procflag(parser, import, FALSE);
         FormalParameters(parser, t)
@@ -746,15 +782,15 @@ END type;
 PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
 VAR
     ident:  PROG.IDENT;
-    pos:    SCAN.POSITION;
+    pos:    POSITION;
 
 BEGIN
     ASSERT(parser.sym = SCAN.lxIDENT);
 
     name := parser.lex.ident;
     getpos(parser, pos);
-    ident := parser.unit.idents.add(parser.unit, name, typ);
+    ident := PROG.addIdent(parser.unit, name, typ);
-    check(ident # NIL, parser, pos, 30);
+    check(ident # NIL, pos, 30);
     ident.pos := pos;
     Next(parser);
 
@@ -772,7 +808,7 @@ PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
 VAR
     ident: PROG.IDENT;
     name:  SCAN.IDENT;
-    pos:    SCAN.POSITION;
+    pos:   POSITION;
 
 BEGIN
     IF const THEN
@@ -787,12 +823,12 @@ BEGIN
     IF const THEN
         ConstExpression(parser, ident.value);
         IF ident.value.typ = ARITH.tINTEGER THEN
-            check(ARITH.check(ident.value), parser, pos, 39)
+            check(ARITH.check(ident.value), pos, 39)
         ELSIF ident.value.typ = ARITH.tREAL THEN
-            check(ARITH.check(ident.value), parser, pos, 40)
+            check(ARITH.check(ident.value), pos, 40)
         END;
         ident.typ  := PROG.idCONST;
-        ident.type := program.getType(program, ident.value.typ)
+        ident.type := PROG.getType(program, ident.value.typ)
     ELSE
         type(parser, ident.type, {})
     END;
@@ -819,7 +855,7 @@ BEGIN
         ELSIF parser.sym = SCAN.lxCOLON THEN
             Next(parser);
             type(parser, t, {});
-            parser.unit.setvars(parser.unit, t);
+            PROG.setVarsType(parser.unit, t);
             checklex(parser, SCAN.lxSEMI);
             Next(parser)
         ELSE
@@ -835,6 +871,7 @@ PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
 VAR
     ptr: PROG.FRWPTR;
     endmod: BOOLEAN;
+    pos: POSITION;
 
 
     PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
@@ -842,20 +879,24 @@ VAR
         proc:       PROG.IDENT;
         endname,
         name:       SCAN.IDENT;
-        param:      LISTS.ITEM;
+        param:      PROG.PARAM;
         unit:       PROG.UNIT;
         ident:      PROG.IDENT;
         e:          EXPR;
-        pos:        SCAN.POSITION;
+        pos, pos1,
+        pos2:       POSITION;
         label:      INTEGER;
-        enter:      CODE.COMMAND;
+        enter:      IL.COMMAND;
         call:       INTEGER;
         t:          PROG.TYPE_;
-        import:     CODE.IMPORT_PROC;
+        import:     IL.IMPORT_PROC;
         endmod, b:  BOOLEAN;
         fparams:    SET;
         variables:  LISTS.LIST;
         int, flt:   INTEGER;
+        comma:      BOOLEAN;
+        code:       ARITH.VALUE;
+        codeProc:   BOOLEAN;
 
     BEGIN
         endmod := FALSE;
@@ -865,6 +906,7 @@ VAR
         call := procflag(parser, import, TRUE);
 
         getpos(parser, pos);
+        pos1 := pos;
         checklex(parser, SCAN.lxIDENT);
 
         IF import # NIL THEN
@@ -875,29 +917,56 @@ VAR
             proc := IdentDef(parser, PROG.idPROC, name)
         END;
 
-        check(unit.scope.open(unit, proc.proc), parser, pos, 116);
+        check(PROG.openScope(unit, proc.proc), pos, 116);
 
-        proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
+        proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
         t := proc.type;
         t.align := program.target.adr;
         t.call  := call;
 
         FormalParameters(parser, t);
 
+        codeProc := call IN {PROG.code, PROG._code};
+
         IF call IN {PROG.systemv, PROG._systemv} THEN
-            check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120)
+            check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
         END;
 
-        param := t.params.first;
+        param := t.params.first(PROG.PARAM);
         WHILE param # NIL DO
-            ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM);
+            ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
             ASSERT(ident # NIL);
-            ident.type := param(PROG.PARAM).type;
+            ident.type := param.type;
-            ident.offset := param(PROG.PARAM).offset;
+            ident.offset := param.offset;
-            IF param(PROG.PARAM).vPar THEN
+            IF param.vPar THEN
                 ident.typ := PROG.idVPAR
             END;
-            param := param.next
+            param := param.next(PROG.PARAM)
+        END;
+
+        IF import = NIL THEN
+            label := IL.NewLabel();
+            proc.proc.label := label
+        END;
+
+        IF codeProc THEN
+            enter := IL.EnterC(label);
+            comma := FALSE;
+            WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
+                getpos(parser, pos2);
+                ConstExpression(parser, code);
+                check(code.typ = ARITH.tINTEGER, pos2, 43);
+                IF program.target.sys # mConst.Target_iMSP430 THEN
+                    check(ARITH.range(code, 0, 255), pos2, 42)
+                END;
+                IL.AddCmd(IL.opCODE, ARITH.getInt(code));
+                comma := parser.sym = SCAN.lxCOMMA;
+                IF comma THEN
+                    Next(parser)
+                ELSE
+                    checklex(parser, SCAN.lxSEMI)
+                END
+            END
         END;
 
         checklex(parser, SCAN.lxSEMI);
@@ -905,55 +974,64 @@ VAR
 
         IF import = NIL THEN
 
-            label := CODE.NewLabel();
-            proc.proc.label := label;
-
             IF parser.main & proc.export & program.dll THEN
                 IF program.obj THEN
-                    check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114)
+                    check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
                 END;
-                CODE.AddExp(label, proc.name.s);
+                IL.AddExp(label, proc.name.s);
                 proc.proc.used := TRUE
             END;
 
-            b := DeclarationSequence(parser);
+            IF ~codeProc THEN
+                b := DeclarationSequence(parser)
+            END;
 
             program.locsize := 0;
             IF call IN {PROG._win64, PROG.win64} THEN
-                fparams := proc.type.params.getfparams(proc.type, 3, int, flt);
+                fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
-                enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4))
+                enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
             ELSIF call IN {PROG._systemv, PROG.systemv} THEN
-                fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
+                fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
-                enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size))
+                enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
+            ELSIF codeProc THEN
+
             ELSE
-                enter := CODE.Enter(label, 0)
+                enter := IL.Enter(label, 0)
             END;
             proc.proc.enter := enter;
 
-            IF parser.sym = SCAN.lxBEGIN THEN
+            IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
                 Next(parser);
                 parser.StatSeq(parser)
             END;
 
-            IF t.base # NIL THEN
+            IF ~codeProc & (t.base # NIL) THEN
                 checklex(parser, SCAN.lxRETURN);
                 NextPos(parser, pos);
                 parser.expression(parser, e);
-                check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87)
+                check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
             END;
 
-            proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL),
+            IF ~codeProc THEN
-                t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
+                proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
+                    t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
                 enter.param2 := program.locsize;
                 checklex(parser, SCAN.lxEND)
+            ELSE
+                proc.proc.leave := IL.LeaveC()
+            END;
+
+            IF program.target.sys = mConst.Target_iMSP430 THEN
+                check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
+            END
         END;
 
         IF parser.sym = SCAN.lxEND THEN
             ExpectSym(parser, SCAN.lxIDENT);
             getpos(parser, pos);
             endname := parser.lex.ident;
-            IF import = NIL THEN
+            IF ~codeProc & (import = NIL) THEN
-                check(endname = name, parser, pos, 60);
+                check(endname = name, pos, 60);
                 ExpectSym(parser, SCAN.lxSEMI);
                 Next(parser)
             ELSE
@@ -965,20 +1043,20 @@ VAR
                     ExpectSym(parser, SCAN.lxSEMI);
                     Next(parser)
                 ELSE
-                    check(FALSE, parser, pos, 60)
+                    error(pos, 60)
                 END
             END
         END;
 
-        IF import = NIL THEN
+        IF ~codeProc & (import = NIL) THEN
             variables := LISTS.create(NIL);
         ELSE
             variables := NIL
         END;
 
-        unit.scope.close(unit, variables);
+        PROG.closeScope(unit, variables);
 
-        IF import = NIL THEN
+        IF ~codeProc & (import = NIL) THEN
             enter.variables := variables
         END
 
@@ -1001,12 +1079,15 @@ BEGIN
         END
     END;
 
-    ptr := parser.unit.pointers.link(parser.unit);
+    ptr := PROG.linkPtr(parser.unit);
     IF ptr # NIL THEN
+        pos.line := ptr.pos.line;
+        pos.col  := ptr.pos.col;
+        pos.parser := parser;
         IF ptr.notRecord THEN
-            error(parser, ptr.pos, 58)
+            error(pos, 58)
         ELSE
-            error(parser, ptr.pos, 48)
+            error(pos, 48)
         END
     END;
 
@@ -1033,6 +1114,8 @@ VAR
     label:    INTEGER;
     name:     INTEGER;
     endmod:   BOOLEAN;
+    errlabel: INTEGER;
+    errno:    INTEGER;
 
 BEGIN
     ASSERT(parser # NIL);
@@ -1045,7 +1128,7 @@ BEGIN
         check1(parser.lex.s = parser.modname, parser, 23)
     END;
 
-    unit := program.units.create(program.units, parser.lex.ident);
+    unit := PROG.newUnit(program, parser.lex.ident);
 
     parser.unit := unit;
 
@@ -1062,19 +1145,26 @@ BEGIN
     END;
     CONSOLE.Ln;
 
-    label := CODE.NewLabel();
+    label := IL.NewLabel();
-    CODE.AddJmpCmd(CODE.opJMP, label);
+    IL.AddJmpCmd(IL.opJMP, label);
 
-    name := CODE.putstr(unit.name.s);
+    name := IL.putstr(unit.name.s);
 
-    CODE.SetErrLabel;
+    errlabel := IL.NewLabel();
-    CODE.AddCmd(CODE.opSADR, name);
+    IL.SetLabel(errlabel);
-    CODE.AddCmd(CODE.opPARAM, 1);
+    IL.StrAdr(name);
-    CODE.AddCmd0(CODE.opERR);
+    IL.Param1;
+    IL.AddCmd0(IL.opERR);
+
+    FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
+        IL.SetErrLabel(errno);
+        IL.AddCmd(IL.opPUSHC, errno);
+        IL.AddJmpCmd(IL.opJMP, errlabel)
+    END;
 
     endmod := DeclarationSequence(parser);
 
-    CODE.SetLabel(label);
+    IL.SetLabel(label);
 
     IF ~endmod THEN
 
@@ -1091,8 +1181,7 @@ BEGIN
 
     END;
 
-    unit.close(unit)
+    PROG.closeUnit(unit)
-
 END parse;
 
 
@@ -1156,9 +1245,9 @@ BEGIN
 END create;
 
 
-PROCEDURE init* (bit_depth, sys: INTEGER);
+PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
 BEGIN
-    program := PROG.create(bit_depth, sys);
+    program := PROG.create(bit_depth, target, options);
     parsers := C.create()
 END init;
 

programs/develop/oberon07/Source/PATHS.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 

programs/develop/oberon07/Source/PROG.ob07

@@ -7,7 +7,7 @@
 
 MODULE PROG;
 
-IMPORT SCAN, LISTS, ARITH, ERRORS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS, CODE, UTILS;
+IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS;
 
 
 CONST
@@ -39,9 +39,10 @@ CONST
     sysMOVE*   = 27;  stLENGTH*  = 28;  stMIN*   = 29;  stMAX*    = 30;
     sysSADR*   = 31;  sysTYPEID* = 32;  sysCOPY* = 33;  sysINF*   = 34;
     sysPUT8*   = 35;  sysPUT16*  = 36;  stCOPY*  = 37;  stWCHR*   = 38;
-    sysWSADR*  = 39;  sysPUT32*  = 40;
+    sysWSADR*  = 39;  sysPUT32*  = 40;  (*sysNOP*  = 41;  sysEINT*  = 42;
+    sysDINT*   = 43;*)
 
-    default*   =  2;
+    default32* =  2;
     stdcall*   =  4;  _stdcall*   = stdcall + 1;
     ccall*     =  6;  _ccall*     = ccall + 1;
     ccall16*   =  8;  _ccall16*   = ccall16 + 1;
@@ -49,19 +50,34 @@ CONST
     stdcall64* = 12;  _stdcall64* = stdcall64 + 1;
     default64* = 14;
     systemv*   = 16;  _systemv*   = systemv + 1;
+    default16* = 18;
+    code*      = 20;  _code*      = code + 1;
 
-    noalign* = 20;
+    noalign* = 22;
 
-    callee_clean_up* = {default, stdcall, _stdcall, default64, stdcall64, _stdcall64};
+    callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
-    caller_clean_up* = {ccall, ccall16, win64, systemv, _ccall, _ccall16, _win64, _systemv};
+
-    callconv32* = {default, stdcall, ccall, ccall16, _stdcall, _ccall, _ccall16};
+    sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall*   = 2; sf_ccall16* = 3;
-    callconv64* = {default64, win64, stdcall64, systemv, _win64, _stdcall64, _systemv};
+    sf_win64*   = 4; sf_systemv*   = 5; sf_windows* = 6; sf_linux*   = 7;
+    sf_code*    = 8;
+    sf_noalign* = 9;
+
+    proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code};
+    rec_flags*  = {sf_noalign};
 
     STACK_FRAME = 2;
 
 
 TYPE
 
+    OPTIONS* = RECORD
+
+        version*, stack*, base*, ram*, rom*: INTEGER;
+        pic*: BOOLEAN;
+        checking*: SET
+
+    END;
+
     IDENT* = POINTER TO rIDENT;
 
     UNIT* = POINTER TO rUNIT;
@@ -81,13 +97,6 @@ TYPE
 
     END;
 
-    IDENTS = POINTER TO RECORD (LISTS.LIST)
-
-        add*:   PROCEDURE (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
-        get*:   PROCEDURE (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT
-
-    END;
-
     PROC* = POINTER TO RECORD (LISTS.ITEM)
 
         label*:      INTEGER;
@@ -110,31 +119,13 @@ TYPE
 
         program*:    PROGRAM;
         name*:       SCAN.IDENT;
-        idents*:     IDENTS;
+        idents*:     LISTS.LIST;
         frwPointers: LISTS.LIST;
         gscope:      IDENT;
         closed*:     BOOLEAN;
         scopeLvl*:   INTEGER;
         sysimport*:  BOOLEAN;
-
+        scopes*:     ARRAY MAXSCOPE OF PROC
-        scopes*:     ARRAY MAXSCOPE OF PROC;
-
-        scope*:      RECORD
-
-            open*:   PROCEDURE (unit: UNIT; proc: PROC): BOOLEAN;
-            close*:  PROCEDURE (unit: UNIT; variables: LISTS.LIST)
-
-        END;
-
-        close*:      PROCEDURE (unit: UNIT);
-        setvars*:    PROCEDURE (unit: UNIT; type: TYPE_);
-
-        pointers*:   RECORD
-
-            add*:    PROCEDURE (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
-            link*:   PROCEDURE (unit: UNIT): FRWPTR
-
-        END
 
     END;
 
@@ -142,34 +133,16 @@ TYPE
 
     PARAM* = POINTER TO rPARAM;
 
-    FIELDS = POINTER TO RECORD (LISTS.LIST)
-
-        add*:        PROCEDURE (rec: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
-        get*:        PROCEDURE (rec: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
-        set*:        PROCEDURE (rec: TYPE_; type: TYPE_): BOOLEAN
-
-    END;
-
-    PARAMS = POINTER TO RECORD (LISTS.LIST)
-
-        size*:       INTEGER;
-
-        add*:        PROCEDURE (proc: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
-        get*:        PROCEDURE (proc: TYPE_; name: SCAN.IDENT): PARAM;
-        set*:        PROCEDURE (proc: TYPE_; type: TYPE_);
-        getfparams*: PROCEDURE (proc: TYPE_; maxparam: INTEGER; VAR int, flt: INTEGER): SET
-
-    END;
-
     rTYPE_ = RECORD (LISTS.ITEM)
 
         typ*:        INTEGER;
         size*:       INTEGER;
+        parSize*:    INTEGER;
         length*:     INTEGER;
         align*:      INTEGER;
         base*:       TYPE_;
-        fields*:     FIELDS;
+        fields*:     LISTS.LIST;
-        params*:     PARAMS;
+        params*:     LISTS.LIST;
         unit*:       UNIT;
         closed*:     BOOLEAN;
         num*:        INTEGER;
@@ -215,19 +188,10 @@ TYPE
 
     END;
 
-    UNITS* = POINTER TO RECORD (LISTS.LIST)
-
-        program:     PROGRAM;
-
-        create*:     PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT;
-        get*:        PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT
-
-    END;
-
     rPROGRAM = RECORD
 
         recCount:    INTEGER;
-        units*:      UNITS;
+        units*:      LISTS.LIST;
         types*:      LISTS.LIST;
         sysunit*:    UNIT;
         rtl*:        UNIT;
@@ -240,8 +204,8 @@ TYPE
 
         stTypes*:    RECORD
 
-            tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*,
+            tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
-            tCARD16*, tCARD32*, tANYREC*: TYPE_
+            tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_
 
         END;
 
@@ -250,12 +214,11 @@ TYPE
             bit_depth*:  INTEGER;
             word*:       INTEGER;
             adr*:        INTEGER;
-            sys*:        INTEGER
+            sys*:        INTEGER;
+            sysflags*:   SET;
+            options*:    OPTIONS
 
-        END;
+        END
-
-        enterType*:  PROCEDURE (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
-        getType*:    PROCEDURE (program: PROGRAM; typ: INTEGER): TYPE_
 
     END;
 
@@ -292,7 +255,7 @@ VAR
 BEGIN
     IF varIdent.offset = -1 THEN
         IF varIdent.global THEN
-            IF MACHINE.Align(program.bss, varIdent.type.align) THEN
+            IF UTILS.Align(program.bss, varIdent.type.align) THEN
                 IF UTILS.maxint - program.bss >= varIdent.type.size THEN
                     varIdent.offset := program.bss;
                     INC(program.bss, varIdent.type.size)
@@ -301,7 +264,7 @@ BEGIN
         ELSE
             word := program.target.word;
             size := varIdent.type.size;
-            IF MACHINE.Align(size, word) THEN
+            IF UTILS.Align(size, word) THEN
                 size := size DIV word;
                 IF UTILS.maxint - program.locsize >= size THEN
                     INC(program.locsize, size);
@@ -315,7 +278,7 @@ BEGIN
 END getOffset;
 
 
-PROCEDURE close (unit: UNIT);
+PROCEDURE closeUnit* (unit: UNIT);
 VAR
     ident, prev: IDENT;
     offset: INTEGER;
@@ -324,7 +287,7 @@ BEGIN
     ident := unit.idents.last(IDENT);
     WHILE (ident # NIL) & (ident.typ # idGUARD) DO
         IF (ident.typ = idVAR) & (ident.offset = -1) THEN
-            ERRORS.hintmsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
+            ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
             IF ident.export THEN
                 offset := getOffset(unit.program, ident)
             END
@@ -343,7 +306,7 @@ BEGIN
     END;
 
     unit.closed := TRUE
-END close;
+END closeUnit;
 
 
 PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN;
@@ -362,7 +325,7 @@ BEGIN
 END unique;
 
 
-PROCEDURE addIdent (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
+PROCEDURE addIdent* (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
 VAR
     item:  IDENT;
     res:   BOOLEAN;
@@ -438,7 +401,7 @@ BEGIN
 END UseProc;
 
 
-PROCEDURE setvars (unit: UNIT; type: TYPE_);
+PROCEDURE setVarsType* (unit: UNIT; type: TYPE_);
 VAR
     item: IDENT;
 
@@ -450,10 +413,10 @@ BEGIN
         item.type := type;
         item := item.prev(IDENT)
     END
-END setvars;
+END setVarsType;
 
 
-PROCEDURE getIdent (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
+PROCEDURE getIdent* (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
 VAR
     item: IDENT;
 
@@ -462,7 +425,7 @@ BEGIN
 
     item := unit.idents.last(IDENT);
 
-    ASSERT(item # NIL);
+    IF item # NIL THEN
 
         IF currentScope THEN
             WHILE (item.name # ident) & (item.typ # idGUARD) DO
@@ -477,11 +440,13 @@ BEGIN
             END
         END
 
+    END
+
     RETURN item
 END getIdent;
 
 
-PROCEDURE openScope (unit: UNIT; proc: PROC): BOOLEAN;
+PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN;
 VAR
     item: IDENT;
     res:  BOOLEAN;
@@ -508,11 +473,11 @@ BEGIN
 END openScope;
 
 
-PROCEDURE closeScope (unit: UNIT; variables: LISTS.LIST);
+PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST);
 VAR
     item: IDENT;
     del:  IDENT;
-    lvar: CODE.LOCALVAR;
+    lvar: IL.LOCALVAR;
 
 BEGIN
     item := unit.idents.last(IDENT);
@@ -521,11 +486,11 @@ BEGIN
         del  := item;
         item := item.prev(IDENT);
         IF (del.typ = idVAR) & (del.offset = -1) THEN
-            ERRORS.hintmsg(del.name.s, del.pos.line, del.pos.col, 0)
+            ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0)
         END;
         IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN
             IF del.type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
-                lvar := CODE.NewVar();
+                lvar := IL.NewVar();
                 lvar.offset := del.offset;
                 lvar.size   := del.type.size;
                 IF del.typ = idVAR THEN
@@ -548,7 +513,7 @@ BEGIN
 END closeScope;
 
 
-PROCEDURE frwptr (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
+PROCEDURE frwPtr* (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
 VAR
     newptr: FRWPTR;
 
@@ -566,10 +531,10 @@ BEGIN
     newptr.notRecord := FALSE;
 
     LISTS.push(unit.frwPointers, newptr)
-END frwptr;
+END frwPtr;
 
 
-PROCEDURE linkptr (unit: UNIT): FRWPTR;
+PROCEDURE linkPtr* (unit: UNIT): FRWPTR;
 VAR
     item:  FRWPTR;
     ident: IDENT;
@@ -580,7 +545,7 @@ BEGIN
     item := unit.frwPointers.last(FRWPTR);
 
     WHILE (item # NIL) & ~item.linked & (res = NIL) DO
-        ident := unit.idents.get(unit, item.baseIdent, TRUE);
+        ident := getIdent(unit, item.baseIdent, TRUE);
 
         IF (ident # NIL) THEN
             IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN
@@ -599,7 +564,7 @@ BEGIN
     END
 
     RETURN res
-END linkptr;
+END linkPtr;
 
 
 PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN;
@@ -617,7 +582,7 @@ BEGIN
         param1 := t1.params.first;
         param2 := t2.params.first;
 
-        res := (t1.call = t2.call) & ((param1 # NIL) = (param2 # NIL));
+        res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL));
 
         WHILE res & (param1 # NIL) & (param2 # NIL) DO
             res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type);
@@ -643,18 +608,21 @@ VAR
     res: BOOLEAN;
 
 BEGIN
-    res := ((t0.typ = tPOINTER) & (t1.typ = tPOINTER)) OR ((t0.typ = tRECORD) & (t1.typ = tRECORD));
+    res := (t0.typ = t1.typ) & (t0.typ IN {tPOINTER, tRECORD});
 
-    IF (t0.typ = tPOINTER) & (t1.typ = tPOINTER) THEN
+    IF res & (t0.typ = tPOINTER) THEN
         t0 := t0.base;
         t1 := t1.base
     END;
 
-    WHILE res & (t1 # NIL) & (t1 # t0) DO
+    IF res THEN
+        WHILE (t1 # NIL) & (t1 # t0) DO
             t1 := t1.base
+        END;
+        res := t1 # NIL
     END
 
-    RETURN res & (t1 = t0)
+    RETURN res
 END isBaseOf;
 
 
@@ -663,148 +631,141 @@ PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN;
 END isOpenArray;
 
 
-PROCEDURE getunit (units: UNITS; name: SCAN.IDENT): UNIT;
+PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
 VAR
     item: UNIT;
 
 BEGIN
     ASSERT(name # NIL);
 
-    item := units.first(UNIT);
+    item := program.units.first(UNIT);
 
     WHILE (item # NIL) & (item.name # name) DO
         item := item.next(UNIT)
     END;
 
     IF (item = NIL) & (name.s = "SYSTEM") THEN
-        item := units.program.sysunit
+        item := program.sysunit
     END
 
     RETURN item
-END getunit;
+END getUnit;
 
 
 PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM);
 VAR
     ident: IDENT;
-    stName:  SCAN.IDENT;
 
 BEGIN
-
+    ident      := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE);
-    stName     := SCAN.enterid("INTEGER");
-    ident      := addIdent(unit, stName, idTYPE);
     ident.type := program.stTypes.tINTEGER;
 
-    stName     := SCAN.enterid("BYTE");
+    ident      := addIdent(unit, SCAN.enterid("BYTE"), idTYPE);
-    ident      := addIdent(unit, stName, idTYPE);
     ident.type := program.stTypes.tBYTE;
 
-    stName     := SCAN.enterid("CHAR");
+    ident      := addIdent(unit, SCAN.enterid("CHAR"), idTYPE);
-    ident      := addIdent(unit, stName, idTYPE);
     ident.type := program.stTypes.tCHAR;
 
-    stName     := SCAN.enterid("WCHAR");
+    ident      := addIdent(unit, SCAN.enterid("SET"), idTYPE);
-    ident      := addIdent(unit, stName, idTYPE);
-    ident.type := program.stTypes.tWCHAR;
-
-    stName     := SCAN.enterid("SET");
-    ident      := addIdent(unit, stName, idTYPE);
     ident.type := program.stTypes.tSET;
 
-    stName     := SCAN.enterid("BOOLEAN");
+    ident      := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
-    ident      := addIdent(unit, stName, idTYPE);
     ident.type := program.stTypes.tBOOLEAN;
 
-    stName     := SCAN.enterid("REAL");
+    IF program.target.sys # mConst.Target_iMSP430 THEN
-    ident      := addIdent(unit, stName, idTYPE);
+        ident      := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
         ident.type := program.stTypes.tREAL;
 
+        ident      := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
+        ident.type := program.stTypes.tWCHAR
+    END
+
 END enterStTypes;
 
 
 PROCEDURE enterStProcs (unit: UNIT);
 
 
-    PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
+    PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
     VAR
         ident: IDENT;
     BEGIN
-        ident := addIdent(unit, SCAN.enterid(name), idtyp);
+        ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
         ident.stproc := proc
     END EnterProc;
 
 
-BEGIN
+    PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
-    EnterProc(unit, "ASSERT",   idSTPROC,  stASSERT);
+    VAR
-    EnterProc(unit, "DEC",      idSTPROC,  stDEC);
+        ident: IDENT;
-    EnterProc(unit, "EXCL",     idSTPROC,  stEXCL);
+    BEGIN
-    EnterProc(unit, "INC",      idSTPROC,  stINC);
+        ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
-    EnterProc(unit, "INCL",     idSTPROC,  stINCL);
+        ident.stproc := func
-    EnterProc(unit, "NEW",      idSTPROC,  stNEW);
+    END EnterFunc;
-    EnterProc(unit, "PACK",     idSTPROC,  stPACK);
+
-    EnterProc(unit, "UNPK",     idSTPROC,  stUNPK);
+
-    EnterProc(unit, "DISPOSE",  idSTPROC,  stDISPOSE);
+BEGIN
-    EnterProc(unit, "COPY",     idSTPROC,  stCOPY);
+    EnterProc(unit, "ASSERT", stASSERT);
+    EnterProc(unit, "DEC",    stDEC);
+    EnterProc(unit, "EXCL",   stEXCL);
+    EnterProc(unit, "INC",    stINC);
+    EnterProc(unit, "INCL",   stINCL);
+    EnterProc(unit, "NEW",    stNEW);
+    EnterProc(unit, "COPY",   stCOPY);
+
+    EnterFunc(unit, "ABS",    stABS);
+    EnterFunc(unit, "ASR",    stASR);
+    EnterFunc(unit, "CHR",    stCHR);
+    EnterFunc(unit, "LEN",    stLEN);
+    EnterFunc(unit, "LSL",    stLSL);
+    EnterFunc(unit, "ODD",    stODD);
+    EnterFunc(unit, "ORD",    stORD);
+    EnterFunc(unit, "ROR",    stROR);
+    EnterFunc(unit, "BITS",   stBITS);
+    EnterFunc(unit, "LSR",    stLSR);
+    EnterFunc(unit, "LENGTH", stLENGTH);
+    EnterFunc(unit, "MIN",    stMIN);
+    EnterFunc(unit, "MAX",    stMAX);
+
+    IF unit.program.target.sys # mConst.Target_iMSP430 THEN
+        EnterProc(unit, "PACK",    stPACK);
+        EnterProc(unit, "UNPK",    stUNPK);
+        EnterProc(unit, "DISPOSE", stDISPOSE);
+
+        EnterFunc(unit, "WCHR",    stWCHR);
+        EnterFunc(unit, "FLOOR",   stFLOOR);
+        EnterFunc(unit, "FLT",     stFLT)
+    END
 
-    EnterProc(unit, "ABS",      idSTFUNC,  stABS);
-    EnterProc(unit, "ASR",      idSTFUNC,  stASR);
-    EnterProc(unit, "CHR",      idSTFUNC,  stCHR);
-    EnterProc(unit, "WCHR",     idSTFUNC,  stWCHR);
-    EnterProc(unit, "FLOOR",    idSTFUNC,  stFLOOR);
-    EnterProc(unit, "FLT",      idSTFUNC,  stFLT);
-    EnterProc(unit, "LEN",      idSTFUNC,  stLEN);
-    EnterProc(unit, "LSL",      idSTFUNC,  stLSL);
-    EnterProc(unit, "ODD",      idSTFUNC,  stODD);
-    EnterProc(unit, "ORD",      idSTFUNC,  stORD);
-    EnterProc(unit, "ROR",      idSTFUNC,  stROR);
-    EnterProc(unit, "BITS",     idSTFUNC,  stBITS);
-    EnterProc(unit, "LSR",      idSTFUNC,  stLSR);
-    EnterProc(unit, "LENGTH",   idSTFUNC,  stLENGTH);
-    EnterProc(unit, "MIN",      idSTFUNC,  stMIN);
-    EnterProc(unit, "MAX",      idSTFUNC,  stMAX);
 END enterStProcs;
 
 
-PROCEDURE newunit (units: UNITS; name: SCAN.IDENT): UNIT;
+PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
 VAR
     unit: UNIT;
-    idents:  IDENTS;
 
 BEGIN
-    ASSERT(units # NIL);
+    ASSERT(program # NIL);
     ASSERT(name # NIL);
 
     NEW(unit);
 
-    NEW(idents);
+    unit.program     := program;
-    ASSERT(LISTS.create(idents) = idents);
-
-    idents.add       := addIdent;
-    idents.get       := getIdent;
-
-    unit.program     := units.program;
     unit.name        := name;
     unit.closed      := FALSE;
-    unit.idents      := idents;
+    unit.idents      := LISTS.create(NIL);
     unit.frwPointers := LISTS.create(NIL);
 
-    unit.scope.open    := openScope;
+    ASSERT(openScope(unit, NIL));
-    unit.scope.close   := closeScope;
-    unit.close         := close;
-    unit.setvars       := setvars;
-    unit.pointers.add  := frwptr;
-    unit.pointers.link := linkptr;
 
-    ASSERT(unit.scope.open(unit, NIL));
+    enterStTypes(unit, program);
-
-    enterStTypes(unit, units.program);
     enterStProcs(unit);
 
-    ASSERT(unit.scope.open(unit, NIL));
+    ASSERT(openScope(unit, NIL));
 
     unit.gscope := unit.idents.last(IDENT);
 
-    LISTS.push(units, unit);
+    LISTS.push(program.units, unit);
 
     unit.scopeLvl := 0;
     unit.scopes[0] := NIL;
@@ -812,14 +773,14 @@ BEGIN
     unit.sysimport := FALSE;
 
     IF unit.name.s = mConst.RTL_NAME THEN
-        unit.program.rtl := unit
+        program.rtl := unit
     END
 
     RETURN unit
-END newunit;
+END newUnit;
 
 
-PROCEDURE getField (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
+PROCEDURE getField* (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
 VAR
     field: FIELD;
 
@@ -851,7 +812,7 @@ BEGIN
 END getField;
 
 
-PROCEDURE addField (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
+PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
 VAR
     field: FIELD;
     res:   BOOLEAN;
@@ -876,7 +837,7 @@ BEGIN
 END addField;
 
 
-PROCEDURE setFields (self: TYPE_; type: TYPE_): BOOLEAN;
+PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN;
 VAR
     item: FIELD;
     res:  BOOLEAN;
@@ -895,7 +856,7 @@ BEGIN
     WHILE res & (item # NIL) & (item.type = NIL) DO
         item.type := type;
         IF ~self.noalign THEN
-            res := MACHINE.Align(self.size, type.align)
+            res := UTILS.Align(self.size, type.align)
         ELSE
             res := TRUE
         END;
@@ -911,7 +872,7 @@ BEGIN
 END setFields;
 
 
-PROCEDURE getParam (self: TYPE_; name: SCAN.IDENT): PARAM;
+PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM;
 VAR
     item: PARAM;
 
@@ -928,7 +889,7 @@ BEGIN
 END getParam;
 
 
-PROCEDURE addParam (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
+PROCEDURE addParam* (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
 VAR
     param: PARAM;
     res:   BOOLEAN;
@@ -936,7 +897,7 @@ VAR
 BEGIN
     ASSERT(name # NIL);
 
-    res := self.params.get(self, name) = NIL;
+    res := getParam(self, name) = NIL;
 
     IF res THEN
         NEW(param);
@@ -973,7 +934,7 @@ BEGIN
 END OpenBase;
 
 
-PROCEDURE getFloatParamsPos (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
+PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
 VAR
     res: SET;
     param: PARAM;
@@ -991,13 +952,13 @@ BEGIN
         param := param.next(PARAM)
     END;
 
-    int := self.params.size - flt
+    int := self.parSize - flt
 
     RETURN res
 END getFloatParamsPos;
 
 
-PROCEDURE setParams (self: TYPE_; type: TYPE_);
+PROCEDURE setParams* (self: TYPE_; type: TYPE_);
 VAR
     item: LISTS.ITEM;
     param: PARAM;
@@ -1006,7 +967,7 @@ VAR
 BEGIN
     ASSERT(type # NIL);
 
-    word := MACHINE.target.bit_depth DIV 8;
+    word := UTILS.target.bit_depth DIV 8;
 
     item := self.params.first;
 
@@ -1025,8 +986,8 @@ BEGIN
             ELSE
                 size := 1
             END;
-            param.offset := self.params.size + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
+            param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
-            INC(self.params.size, size)
+            INC(self.parSize, size)
         ELSE
             IF type.typ IN {tRECORD, tARRAY} THEN
                 IF isOpenArray(type) THEN
@@ -1036,11 +997,11 @@ BEGIN
                 END
             ELSE
                 size := type.size;
-                ASSERT(MACHINE.Align(size, word));
+                ASSERT(UTILS.Align(size, word));
                 size := size DIV word
             END;
-            param.offset := self.params.size + Dim(type) + STACK_FRAME;
+            param.offset := self.parSize + Dim(type) + STACK_FRAME;
-            INC(self.params.size, size)
+            INC(self.parSize, size)
         END;
 
         item := item.next
@@ -1049,47 +1010,32 @@ BEGIN
 END setParams;
 
 
-PROCEDURE enterType (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
+PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
 VAR
     t: TYPE_;
-    fields:   FIELDS;
-    params:   PARAMS;
 
 BEGIN
     NEW(t);
 
-    NEW(fields);
-    ASSERT(LISTS.create(fields) = fields);
-
-    NEW(params);
-    ASSERT(LISTS.create(params) = params);
-
     t.typ     := typ;
     t.size    := size;
     t.length  := length;
     t.align   := 0;
     t.base    := NIL;
-    t.fields  := fields;
+    t.fields  := LISTS.create(NIL);
-    t.params  := params;
+    t.params  := LISTS.create(NIL);
     t.unit    := unit;
     t.num     := 0;
-    IF program.target.bit_depth = 32 THEN
+
-        t.call := default
+    CASE program.target.bit_depth OF
-    ELSIF program.target.bit_depth = 64 THEN
+    |16: t.call := default16
-        t.call := default64
+    |32: t.call := default32
+    |64: t.call := default64
     END;
+
     t.import  := FALSE;
     t.noalign := FALSE;
-
+    t.parSize := 0;
-    t.fields.add := addField;
-    t.fields.get := getField;
-    t.fields.set := setFields;
-
-    t.params.add := addParam;
-    t.params.get := getParam;
-    t.params.getfparams := getFloatParamsPos;
-    t.params.set := setParams;
-    t.params.size := 0;
 
     IF typ IN {tARRAY, tRECORD} THEN
         t.closed := FALSE;
@@ -1107,7 +1053,7 @@ BEGIN
 END enterType;
 
 
-PROCEDURE getType (program: PROGRAM; typ: INTEGER): TYPE_;
+PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_;
 VAR
     res: TYPE_;
 
@@ -1154,22 +1100,30 @@ VAR
 
 
 BEGIN
-    unit := program.units.create(program.units, SCAN.enterid("$SYSTEM"));
+    unit := newUnit(program, SCAN.enterid("$SYSTEM"));
 
     EnterProc(unit, "ADR",    idSYSFUNC, sysADR);
     EnterProc(unit, "SIZE",   idSYSFUNC, sysSIZE);
     EnterProc(unit, "SADR",   idSYSFUNC, sysSADR);
-    EnterProc(unit, "WSADR",  idSYSFUNC, sysWSADR);
     EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID);
-    EnterProc(unit, "INF",    idSYSFUNC, sysINF);
 
     EnterProc(unit, "GET",    idSYSPROC, sysGET);
-    EnterProc(unit, "PUT",    idSYSPROC, sysPUT);
     EnterProc(unit, "PUT8",   idSYSPROC, sysPUT8);
-    EnterProc(unit, "PUT16",  idSYSPROC, sysPUT16);
+    EnterProc(unit, "PUT",    idSYSPROC, sysPUT);
-    EnterProc(unit, "PUT32",  idSYSPROC, sysPUT32);
     EnterProc(unit, "CODE",   idSYSPROC, sysCODE);
     EnterProc(unit, "MOVE",   idSYSPROC, sysMOVE);
+           (*
+    IF program.target.sys = mConst.Target_iMSP430 THEN
+        EnterProc(unit, "NOP",  idSYSPROC, sysNOP);
+        EnterProc(unit, "EINT", idSYSPROC, sysEINT);
+        EnterProc(unit, "DINT", idSYSPROC, sysDINT)
+    END;
+         *)
+    IF program.target.sys # mConst.Target_iMSP430 THEN
+        EnterProc(unit, "WSADR",  idSYSFUNC, sysWSADR);
+        EnterProc(unit, "INF",    idSYSFUNC, sysINF);
+        EnterProc(unit, "PUT32",  idSYSPROC, sysPUT32);
+        EnterProc(unit, "PUT16",  idSYSPROC, sysPUT16);
         EnterProc(unit, "COPY",   idSYSPROC, sysCOPY);
 
         ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE);
@@ -1178,9 +1132,10 @@ BEGIN
 
         ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
         ident.type := program.stTypes.tCARD32;
-    ident.export := TRUE;
+        ident.export := TRUE
+    END;
 
-    unit.close(unit);
+    closeUnit(unit);
 
     program.sysunit := unit
 END createSysUnit;
@@ -1211,7 +1166,6 @@ VAR
 BEGIN
 
     REPEAT
-
         flag := FALSE;
         proc := program.procs.first(PROC);
 
@@ -1230,7 +1184,7 @@ BEGIN
     WHILE proc # NIL DO
         IF ~proc.used THEN
             IF proc.import = NIL THEN
-                CODE.delete2(proc.enter, proc.leave)
+                IL.delete2(proc.enter, proc.leave)
             ELSE
                 DelImport(proc.import)
             END
@@ -1241,63 +1195,81 @@ BEGIN
 END DelUnused;
 
 
-PROCEDURE create* (bit_depth, sys: INTEGER): PROGRAM;
+PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM;
 VAR
     program: PROGRAM;
-    units:   UNITS;
 
 BEGIN
     idents := C.create();
 
-    MACHINE.SetBitDepth(bit_depth);
+    UTILS.SetBitDepth(bit_depth);
     NEW(program);
-    NEW(units);
-    ASSERT(LISTS.create(units) = units);
 
     program.target.bit_depth := bit_depth;
     program.target.word      := bit_depth DIV 8;
     program.target.adr       := bit_depth DIV 8;
-    program.target.sys       := sys;
+    program.target.sys       := target;
+    program.target.options   := options;
+
+    CASE target OF
+    |mConst.Target_iConsole,
+     mConst.Target_iGUI,
+     mConst.Target_iDLL:        program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
+
+    |mConst.Target_iELF32,
+     mConst.Target_iELFSO32:    program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
+
+    |mConst.Target_iKolibri,
+     mConst.Target_iObject:     program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
+
+    |mConst.Target_iConsole64,
+     mConst.Target_iGUI64,
+     mConst.Target_iDLL64:      program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
+
+    |mConst.Target_iELF64,
+     mConst.Target_iELFSO64:    program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
+
+    |mConst.Target_iMSP430:     program.target.sysflags := {sf_code}
+    END;
 
     program.recCount := -1;
     program.bss := 0;
 
-    program.units := units;
+    program.units := LISTS.create(NIL);
     program.types := LISTS.create(NIL);
-
     program.procs := LISTS.create(NIL);
 
-    program.enterType := enterType;
-    program.getType   := getType;
-
     program.stTypes.tINTEGER := enterType(program, tINTEGER,  program.target.word, 0, NIL);
     program.stTypes.tBYTE    := enterType(program, tBYTE,                       1, 0, NIL);
     program.stTypes.tCHAR    := enterType(program, tCHAR,                       1, 0, NIL);
-    program.stTypes.tWCHAR   := enterType(program, tWCHAR,                      2, 0, NIL);
     program.stTypes.tSET     := enterType(program, tSET,      program.target.word, 0, NIL);
     program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN,                    1, 0, NIL);
+
+    IF target # mConst.Target_iMSP430 THEN
+        program.stTypes.tWCHAR   := enterType(program, tWCHAR,  2, 0, NIL);
         program.stTypes.tREAL    := enterType(program, tREAL,   8, 0, NIL);
+        program.stTypes.tCARD16  := enterType(program, tCARD16, 2, 0, NIL);
+        program.stTypes.tCARD32  := enterType(program, tCARD32, 4, 0, NIL)
+    END;
+
     program.stTypes.tSTRING  := enterType(program, tSTRING, program.target.word, 0, NIL);
     program.stTypes.tNIL     := enterType(program, tNIL,    program.target.word, 0, NIL);
-    program.stTypes.tCARD16  := enterType(program, tCARD16,                     2, 0, NIL);
+
-    program.stTypes.tCARD32  := enterType(program, tCARD32,                     4, 0, NIL);
     program.stTypes.tANYREC  := enterType(program, tRECORD, 0, 0, NIL);
     program.stTypes.tANYREC.closed := TRUE;
 
     program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size;
     program.stTypes.tBYTE.align    := 1;
     program.stTypes.tCHAR.align    := program.stTypes.tCHAR.size;
-    program.stTypes.tWCHAR.align   := program.stTypes.tWCHAR.size;
     program.stTypes.tSET.align     := program.stTypes.tSET.size;
     program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size;
+
+    IF target # mConst.Target_iMSP430 THEN
+        program.stTypes.tWCHAR.align   := program.stTypes.tWCHAR.size;
         program.stTypes.tREAL.align    := program.stTypes.tREAL.size;
         program.stTypes.tCARD16.align  := program.stTypes.tCARD16.size;
-    program.stTypes.tCARD32.align   := program.stTypes.tCARD32.size;
+        program.stTypes.tCARD32.align  := program.stTypes.tCARD32.size
-
+    END;
-    units.program := program;
-
-    units.create := newunit;
-    units.get    := getunit;
 
     program.dll := FALSE;
     program.obj := FALSE;

programs/develop/oberon07/Source/REG.ob07

@@ -12,8 +12,10 @@ CONST
 
     N = 16;
 
-    R0* = 0; R1* = 1; R2* = 2;
+    R0*  =  0;  R1*  =  1;  R2*  =  2;  R3*  =  3;
+    R4*  =  4;  R5*  =  5;  R6*  =  6;  R7*  =  7;
     R8*  =  8;  R9*  =  9;  R10* = 10;  R11* = 11;
+    R12* = 12;  R13* = 13;  R14* = 14;  R15* = 15;
 
     NVR = 32;
 
@@ -24,7 +26,7 @@ TYPE
     OP2 = PROCEDURE (arg1, arg2: INTEGER);
     OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
 
-    REGS* = POINTER TO RECORD
+    REGS* = RECORD
 
         regs*:   SET;
         stk*:    ARRAY N OF INTEGER;
@@ -42,7 +44,7 @@ TYPE
     END;
 
 
-PROCEDURE push (R: REGS);
+PROCEDURE push (VAR R: REGS);
 VAR
     i, reg: INTEGER;
 
@@ -58,7 +60,7 @@ BEGIN
 END push;
 
 
-PROCEDURE pop (R: REGS; reg: INTEGER);
+PROCEDURE pop (VAR R: REGS; reg: INTEGER);
 VAR
     i: INTEGER;
 
@@ -111,7 +113,7 @@ BEGIN
 END GetFreeReg;
 
 
-PROCEDURE Put (R: REGS; reg: INTEGER);
+PROCEDURE Put (VAR R: REGS; reg: INTEGER);
 BEGIN
     EXCL(R.regs, reg);
     INC(R.top);
@@ -119,7 +121,7 @@ BEGIN
 END Put;
 
 
-PROCEDURE PopAnyReg (R: REGS): INTEGER;
+PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
 VAR
     reg: INTEGER;
 
@@ -134,7 +136,7 @@ BEGIN
 END PopAnyReg;
 
 
-PROCEDURE GetAnyReg* (R: REGS): INTEGER;
+PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
 VAR
     reg: INTEGER;
 
@@ -152,13 +154,13 @@ BEGIN
 END GetAnyReg;
 
 
-PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN;
+PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
 VAR
     free, n: INTEGER;
     res: BOOLEAN;
 
 
-    PROCEDURE exch (R: REGS; reg1, reg2: INTEGER);
+    PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
     VAR
         n1, n2: INTEGER;
 
@@ -201,7 +203,7 @@ BEGIN
 END GetReg;
 
 
-PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN;
+PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
 VAR
     n1, n2: INTEGER;
     res: BOOLEAN;
@@ -239,14 +241,14 @@ BEGIN
 END Exchange;
 
 
-PROCEDURE Drop* (R: REGS);
+PROCEDURE Drop* (VAR R: REGS);
 BEGIN
     INCL(R.regs, R.stk[R.top]);
     DEC(R.top)
 END Drop;
 
 
-PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER);
+PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
 BEGIN
     IF R.top > 0 THEN
         reg1 := R.stk[R.top - 1];
@@ -261,7 +263,7 @@ BEGIN
 END BinOp;
 
 
-PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER);
+PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
 BEGIN
     IF R.top >= 0 THEN
         reg := R.stk[R.top]
@@ -271,7 +273,7 @@ BEGIN
 END UnOp;
 
 
-PROCEDURE PushAll* (R: REGS);
+PROCEDURE PushAll* (VAR R: REGS);
 BEGIN
     WHILE R.top >= 0 DO
         push(R)
@@ -279,7 +281,15 @@ BEGIN
 END PushAll;
 
 
-PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER);
+PROCEDURE PushAll_1* (VAR R: REGS);
+BEGIN
+    WHILE R.top >= 1 DO
+        push(R)
+    END
+END PushAll_1;
+
+
+PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
 BEGIN
     ASSERT(reg IN R.vregs);
     ASSERT(offs # 0);
@@ -291,7 +301,7 @@ BEGIN
 END Lock;
 
 
-PROCEDURE Release* (R: REGS; reg: INTEGER);
+PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
 BEGIN
     ASSERT(reg IN R.vregs);
     R.offs[reg] := 0
@@ -350,7 +360,7 @@ BEGIN
 END Restore;
 
 
-PROCEDURE Reset* (R: REGS);
+PROCEDURE Reset* (VAR R: REGS);
 VAR
     i: INTEGER;
 
@@ -401,14 +411,11 @@ BEGIN
 END GetAnyVarReg;
 
 
-PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS;
+PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
 VAR
-    R: REGS;
     i: INTEGER;
 
 BEGIN
-    NEW(R);
-
     R.regs := regs;
     R.pushed := 0;
     R.top := -1;
@@ -427,8 +434,7 @@ BEGIN
         R.size[i] := 0
     END
 
-    RETURN R
+END Init;
-END Create;
 
 
 END REG.

programs/develop/oberon07/Source/SCAN.ob07

@@ -1,13 +1,13 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
 MODULE SCAN;
 
-IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS;
+IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
 
 
 CONST
@@ -18,29 +18,30 @@ CONST
     lxCHAR*    =  4;  lxFLOAT*   =  5;  lxSTRING*    =  6;  lxCOMMENT* =  7;
     lxEOF*     =  8;
 
-    lxKW       = 101;
+    lxPLUS*    = 21;  lxMINUS*   = 22;  lxMUL*       = 23;  lxSLASH*   = 24;
+    lxNOT*     = 25;  lxAND*     = 26;  lxPOINT*     = 27;  lxCOMMA*   = 28;
+    lxSEMI*    = 29;  lxBAR*     = 30;  lxLROUND*    = 31;  lxLSQUARE* = 32;
+    lxLCURLY*  = 33;  lxCARET*   = 34;  lxEQ*        = 35;  lxNE*      = 36;
+    lxLT*      = 37;  lxGT*      = 38;  lxCOLON*     = 39;  lxRROUND*  = 40;
+    lxRSQUARE* = 41;  lxRCURLY*  = 42;  lxLE*        = 43;  lxGE*      = 44;
+    lxASSIGN*  = 45;  lxRANGE*   = 46;
 
-    lxARRAY*   = 101;  lxBEGIN*   = 102;  lxBY*        = 103;  lxCASE*    = 104;
+    lxKW       = 51;
-    lxCONST*   = 105;  lxDIV*     = 106;  lxDO*        = 107;  lxELSE*    = 108;
-    lxELSIF*   = 109;  lxEND*     = 110;  lxFALSE*     = 111;  lxFOR*     = 112;
-    lxIF*      = 113;  lxIMPORT*  = 114;  lxIN*        = 115;  lxIS*      = 116;
-    lxMOD*     = 117;  lxMODULE*  = 118;  lxNIL*       = 119;  lxOF*      = 120;
-    lxOR*      = 121;  lxPOINTER* = 122;  lxPROCEDURE* = 123;  lxRECORD*  = 124;
-    lxREPEAT*  = 125;  lxRETURN*  = 126;  lxTHEN*      = 127;  lxTO*      = 128;
-    lxTRUE*    = 129;  lxTYPE*    = 130;  lxUNTIL*     = 131;  lxVAR*     = 132;
-    lxWHILE*   = 133;
 
-    lxPLUS*    = 201;  lxMINUS*   = 202;  lxMUL*       = 203;  lxSLASH*   = 204;
+    lxARRAY*   = 51;  lxBEGIN*   = 52;  lxBY*        = 53;  lxCASE*    = 54;
-    lxNOT*     = 205;  lxAND*     = 206;  lxPOINT*     = 207;  lxCOMMA*   = 208;
+    lxCONST*   = 55;  lxDIV*     = 56;  lxDO*        = 57;  lxELSE*    = 58;
-    lxSEMI*    = 209;  lxBAR*     = 210;  lxLROUND*    = 211;  lxLSQUARE* = 212;
+    lxELSIF*   = 59;  lxEND*     = 60;  lxFALSE*     = 61;  lxFOR*     = 62;
-    lxLCURLY*  = 213;  lxCARET*   = 214;  lxEQ*        = 215;  lxNE*      = 216;
+    lxIF*      = 63;  lxIMPORT*  = 64;  lxIN*        = 65;  lxIS*      = 66;
-    lxLT*      = 217;  lxGT*      = 218;  lxCOLON*     = 219;  lxRROUND*  = 220;
+    lxMOD*     = 67;  lxMODULE*  = 68;  lxNIL*       = 69;  lxOF*      = 70;
-    lxRSQUARE* = 221;  lxRCURLY*  = 222;  lxLE*        = 223;  lxGE*      = 224;
+    lxOR*      = 71;  lxPOINTER* = 72;  lxPROCEDURE* = 73;  lxRECORD*  = 74;
-    lxASSIGN*  = 225;  lxRANGE*   = 226;
+    lxREPEAT*  = 75;  lxRETURN*  = 76;  lxTHEN*      = 77;  lxTO*      = 78;
+    lxTRUE*    = 79;  lxTYPE*    = 80;  lxUNTIL*     = 81;  lxVAR*     = 82;
+    lxWHILE*   = 83;
 
-    lxERROR01 =  -1;  lxERROR02 =  -2;  lxERROR03   =  -3;  lxERROR04 =  -4;
+    lxERROR01* =  -1;  lxERROR02* =  -2;  lxERROR03* =  -3;  lxERROR04* =  -4;
-    lxERROR05 =  -5;  lxERROR06 =  -6;  lxERROR07   =  -7;  lxERROR08 =  -8;
+    lxERROR05* =  -5;  lxERROR06* =  -6;  lxERROR07* =  -7;  lxERROR08* =  -8;
-    lxERROR09 =  -9;  lxERROR10 = -10;  lxERROR11   = -11;  lxERROR12 = -12;
+    lxERROR09* =  -9;  lxERROR10* = -10;  lxERROR11* = -11;  lxERROR12* = -12;
+    lxERROR13* = -13;
 
 
 TYPE
@@ -75,12 +76,7 @@ TYPE
 
     END;
 
-    SCANNER* = POINTER TO RECORD (C.ITEM)
+    SCANNER* = TXT.TEXT;
-
-        text:            TEXTDRV.TEXT;
-        range:           BOOLEAN
-
-    END;
 
     KEYWORD = ARRAY 10 OF CHAR;
 
@@ -90,15 +86,13 @@ VAR
     vocabulary: RECORD
 
         KW:         ARRAY 33 OF KEYWORD;
-
         delimiters: ARRAY 256 OF BOOLEAN;
-
         idents:     AVL.NODE;
         ident:      IDENT
 
     END;
 
-    scanners: C.COLLECTION;
+    upto: BOOLEAN;
 
 
 PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
@@ -109,36 +103,27 @@ END nodecmp;
 PROCEDURE key (VAR lex: LEX);
 VAR
     L, R, M: INTEGER;
+    found: BOOLEAN;
 
 BEGIN
     L := 0;
     R := LEN(vocabulary.KW) - 1;
+    found := FALSE;
+
+    REPEAT
         M := (L + R) DIV 2;
 
-    WHILE L # M DO
+        IF lex.s # vocabulary.KW[M] THEN
             IF lex.s > vocabulary.KW[M] THEN
-            L := M;
+                L := M + 1
-            M := (L + R) DIV 2
-        ELSIF lex.s < vocabulary.KW[M] THEN
-            R := M;
-            M := (L + R) DIV 2
             ELSE
-            lex.sym := lxKW + M;
+                R := M - 1
-            L := M;
-            R := M
             END
-    END;
+        ELSE
-
+            found := TRUE;
-    IF L # R THEN
+            lex.sym := lxKW + M
-        IF lex.s = vocabulary.KW[L] THEN
-            lex.sym := lxKW + L
-        END;
-
-        IF lex.s = vocabulary.KW[R] THEN
-            lex.sym := lxKW + R
         END
-    END
+    UNTIL found OR (L > R)
-
 END key;
 
 
@@ -173,18 +158,24 @@ BEGIN
 END putchar;
 
 
-PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX);
+PROCEDURE nextc (text: TXT.TEXT): CHAR;
+BEGIN
+    TXT.next(text)
+    RETURN text.peak
+END nextc;
+
+
+PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
 VAR
     c: CHAR;
 
 BEGIN
-    c := text.peak(text);
+    c := text.peak;
     ASSERT(S.letter(c));
 
     WHILE S.letter(c) OR S.digit(c) DO
         putchar(lex, c);
-        text.nextc(text);
+        c := nextc(text)
-        c := text.peak(text)
     END;
 
     IF lex.over THEN
@@ -201,44 +192,40 @@ BEGIN
 END ident;
 
 
-PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
+PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
 VAR
     c: CHAR;
     hex: BOOLEAN;
     error: INTEGER;
 
 BEGIN
-    c := text.peak(text);
+    c := text.peak;
     ASSERT(S.digit(c));
 
     error := 0;
 
-    range := FALSE;
-
     lex.sym := lxINTEGER;
     hex := FALSE;
 
     WHILE S.digit(c) DO
         putchar(lex, c);
-        text.nextc(text);
+        c := nextc(text)
-        c := text.peak(text)
     END;
 
     WHILE S.hexdigit(c) DO
         putchar(lex, c);
-        text.nextc(text);
+        c := nextc(text);
-        c := text.peak(text);
         hex := TRUE
     END;
 
     IF c = "H" THEN
         putchar(lex, c);
-        text.nextc(text);
+        TXT.next(text);
         lex.sym := lxHEX
 
     ELSIF c = "X" THEN
         putchar(lex, c);
-        text.nextc(text);
+        TXT.next(text);
         lex.sym := lxCHAR
 
     ELSIF c = "." THEN
@@ -247,39 +234,35 @@ BEGIN
             lex.sym := lxERROR01
         ELSE
 
-            text.nextc(text);
+            c := nextc(text);
-            c := text.peak(text);
 
             IF c # "." THEN
                 putchar(lex, ".");
                 lex.sym := lxFLOAT
             ELSE
                 lex.sym := lxINTEGER;
-                range := TRUE
+                text.peak := 7FX;
+                upto := TRUE
             END;
 
             WHILE S.digit(c) DO
                 putchar(lex, c);
-                text.nextc(text);
+                c := nextc(text)
-                c := text.peak(text)
             END;
 
             IF c = "E" THEN
 
                 putchar(lex, c);
-                text.nextc(text);
+                c := nextc(text);
-                c := text.peak(text);
                 IF (c = "+") OR (c = "-") THEN
                     putchar(lex, c);
-                    text.nextc(text);
+                    c := nextc(text)
-                    c := text.peak(text)
                 END;
 
                 IF S.digit(c) THEN
                     WHILE S.digit(c) DO
                         putchar(lex, c);
-                        text.nextc(text);
+                        c := nextc(text)
-                        c := text.peak(text)
                     END
                 ELSE
                     lex.sym := lxERROR02
@@ -289,11 +272,8 @@ BEGIN
 
         END
 
-    ELSE
+    ELSIF hex THEN
-
-        IF hex THEN
         lex.sym := lxERROR01
-        END
 
     END;
 
@@ -321,31 +301,23 @@ BEGIN
 END number;
 
 
-PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX);
+PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
 VAR
-    c, c1: CHAR;
+    c: CHAR;
     n: INTEGER;
-    quot:  CHAR;
 
 BEGIN
-    quot := text.peak(text);
+    c  := nextc(text);
-
-    ASSERT((quot = '"') OR (quot = "'"));
-
-    text.nextc(text);
-    c := text.peak(text);
-    c1 := c;
     n  := 0;
 
     WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
         putchar(lex, c);
-        text.nextc(text);
+        c := nextc(text);
-        c := text.peak(text);
         INC(n)
     END;
 
     IF c = quot THEN
-        text.nextc(text);
+        TXT.next(text);
         IF lex.over THEN
             lex.sym := lxERROR05
         ELSE
@@ -353,7 +325,7 @@ BEGIN
                 lex.sym := lxSTRING
             ELSE
                 lex.sym := lxCHAR;
-                ARITH.setChar(lex.value, ORD(c1))
+                ARITH.setChar(lex.value, ORD(lex.s[0]))
             END
         END
     ELSE
@@ -369,7 +341,7 @@ BEGIN
 END string;
 
 
-PROCEDURE comment (text: TEXTDRV.TEXT);
+PROCEDURE comment (text: TXT.TEXT);
 VAR
     c: CHAR;
     cond, depth: INTEGER;
@@ -380,8 +352,8 @@ BEGIN
 
     REPEAT
 
-        c := text.peak(text);
+        c := text.peak;
-        text.nextc(text);
+        TXT.next(text);
 
         IF c = "*" THEN
             IF cond = 1 THEN
@@ -406,21 +378,12 @@ BEGIN
 END comment;
 
 
-PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
+PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
-VAR
-    c: CHAR;
-
 BEGIN
-    c := text.peak(text);
-
-    IF range THEN
-        ASSERT(c = ".")
-    END;
-
     putchar(lex, c);
-    text.nextc(text);
+    c := nextc(text);
 
-    CASE c OF
+    CASE lex.s[0] OF
     |"+":
         lex.sym := lxPLUS
 
@@ -433,10 +396,10 @@ BEGIN
     |"/":
         lex.sym := lxSLASH;
 
-        IF text.peak(text) = "/" THEN
+        IF c = "/" THEN
             lex.sym := lxCOMMENT;
             REPEAT
-                text.nextc(text)
+                TXT.next(text)
             UNTIL text.eol OR text.eof
         END
 
@@ -447,24 +410,12 @@ BEGIN
         lex.sym := lxAND
 
     |".":
-        IF range THEN
-
-            putchar(lex, ".");
-            lex.sym := lxRANGE;
-            range := FALSE;
-            DEC(lex.pos.col)
-
-        ELSE
-
         lex.sym := lxPOINT;
-            c := text.peak(text);
 
         IF c = "." THEN
             lex.sym := lxRANGE;
             putchar(lex, c);
-                text.nextc(text)
+            TXT.next(text)
-            END
-
         END
 
     |",":
@@ -478,12 +429,10 @@ BEGIN
 
     |"(":
         lex.sym := lxLROUND;
-        c := text.peak(text);
 
         IF c = "*" THEN
             lex.sym := lxCOMMENT;
-            putchar(lex, c);
+            TXT.next(text);
-            text.nextc(text);
             comment(text)
         END
 
@@ -504,32 +453,29 @@ BEGIN
 
     |"<":
         lex.sym := lxLT;
-        c := text.peak(text);
 
         IF c = "=" THEN
             lex.sym := lxLE;
             putchar(lex, c);
-            text.nextc(text)
+            TXT.next(text)
         END
 
     |">":
         lex.sym := lxGT;
-        c := text.peak(text);
 
         IF c = "=" THEN
             lex.sym := lxGE;
             putchar(lex, c);
-            text.nextc(text)
+            TXT.next(text)
         END
 
     |":":
         lex.sym := lxCOLON;
-        c := text.peak(text);
 
         IF c = "=" THEN
             lex.sym := lxASSIGN;
             putchar(lex, c);
-            text.nextc(text)
+            TXT.next(text)
         END
 
     |")":
@@ -546,26 +492,21 @@ BEGIN
 END delimiter;
 
 
-PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX);
+PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
 VAR
     c: CHAR;
-    text: TEXTDRV.TEXT;
 
 BEGIN
-    text := scanner.text;
 
     REPEAT
-
+        c := text.peak;
-        c := text.peak(text);
 
         WHILE S.space(c) DO
-            text.nextc(text);
+            c := nextc(text)
-            c := text.peak(text)
         END;
 
         lex.s[0]     := 0X;
         lex.length   := 0;
-        lex.sym      := lxUNDEF;
         lex.pos.line := text.line;
         lex.pos.col  := text.col;
         lex.ident    := NIL;
@@ -574,19 +515,26 @@ BEGIN
         IF S.letter(c) THEN
             ident(text, lex)
         ELSIF S.digit(c) THEN
-            number(text, lex, scanner.range)
+            number(text, lex)
         ELSIF (c = '"') OR (c = "'") THEN
-            string(text, lex)
+            string(text, lex, c)
         ELSIF vocabulary.delimiters[ORD(c)] THEN
-            delimiter(text, lex, scanner.range)
+            delimiter(text, lex, c)
         ELSIF c = 0X THEN
             lex.sym := lxEOF;
             IF text.eof THEN
                 INC(lex.pos.col)
             END
+        ELSIF (c = 7FX) & upto THEN
+            upto := FALSE;
+            lex.sym := lxRANGE;
+            putchar(lex, ".");
+            putchar(lex, ".");
+            DEC(lex.pos.col);
+            TXT.next(text)
         ELSE
             putchar(lex, c);
-            text.nextc(text);
+            TXT.next(text);
             lex.sym := lxERROR04
         END;
 
@@ -601,53 +549,14 @@ BEGIN
 END Next;
 
 
-PROCEDURE NewScanner (): SCANNER;
-VAR
-    scan:  SCANNER;
-    citem: C.ITEM;
-
-BEGIN
-    citem := C.pop(scanners);
-    IF citem = NIL THEN
-        NEW(scan)
-    ELSE
-        scan := citem(SCANNER)
-    END
-
-    RETURN scan
-END NewScanner;
-
-
 PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
-VAR
+    RETURN TXT.open(name)
-    scanner: SCANNER;
-    text:    TEXTDRV.TEXT;
-
-BEGIN
-    text := TEXTDRV.create();
-    IF text.open(text, name) THEN
-        scanner := NewScanner();
-        scanner.text   := text;
-        scanner.range  := FALSE
-    ELSE
-        scanner := NIL;
-        TEXTDRV.destroy(text)
-    END
-
-    RETURN scanner
 END open;
 
 
 PROCEDURE close* (VAR scanner: SCANNER);
 BEGIN
-    IF scanner # NIL THEN
+    TXT.close(scanner)
-        IF scanner.text # NIL THEN
-            TEXTDRV.destroy(scanner.text)
-        END;
-
-        C.push(scanners, scanner);
-        scanner := NIL
-    END
 END close;
 
 
@@ -656,14 +565,16 @@ VAR
     i: INTEGER;
     delim: ARRAY 23 OF CHAR;
 
+
     PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD);
     BEGIN
         vocabulary.KW[i] := kw;
         INC(i)
     END enterkw;
 
+
 BEGIN
-    scanners := C.create();
+    upto := FALSE;
 
     FOR i := 0 TO 255 DO
         vocabulary.delimiters[i] := FALSE

programs/develop/oberon07/Source/STRINGS.ob07

@@ -92,6 +92,29 @@ BEGIN
 END IntToStr;
 
 
+PROCEDURE hexdgt (n: BYTE): BYTE;
+BEGIN
+    IF n < 10 THEN
+        n := n + ORD("0")
+    ELSE
+        n := n - 10 + ORD("A")
+    END
+
+    RETURN n
+END hexdgt;
+
+
+PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
+BEGIN
+    str[n] := 0X;
+    WHILE n > 0 DO
+        str[n - 1] := CHR(hexdgt(x MOD 16));
+        x := x DIV 16;
+        DEC(n)
+    END
+END IntToHex;
+
+
 PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
 BEGIN
     WHILE count > 0 DO

programs/develop/oberon07/Source/TEXTDRV.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
@@ -30,10 +30,7 @@ TYPE
         line*, col*:  INTEGER;
         eof*:         BOOLEAN;
         eol*:         BOOLEAN;
-
+        peak*:        CHAR
-        open*:        PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
-        peak*:        PROCEDURE (text: TEXT): CHAR;
-        nextc*:       PROCEDURE (text: TEXT)
 
     END;
 
@@ -43,26 +40,6 @@ VAR
     texts: C.COLLECTION;
 
 
-PROCEDURE reset (text: TEXT);
-BEGIN
-    text.chunk[0] := 0;
-    text.pos  := 0;
-    text.size := 0;
-    text.file := NIL;
-    text.utf8 := FALSE;
-    text.CR   := FALSE;
-    text.line := 1;
-    text.col  := 1;
-    text.eof  := FALSE;
-    text.eol  := FALSE
-END reset;
-
-
-PROCEDURE peak (text: TEXT): CHAR;
-    RETURN CHR(text.chunk[text.pos])
-END peak;
-
-
 PROCEDURE load (text: TEXT);
 BEGIN
     IF ~text.eof THEN
@@ -71,24 +48,27 @@ BEGIN
         IF text.size = 0 THEN
             text.eof := TRUE;
             text.chunk[0] := 0
-        END
+        END;
+        text.peak := CHR(text.chunk[0])
     END
 END load;
 
 
-PROCEDURE next (text: TEXT);
+PROCEDURE next* (text: TEXT);
 VAR
     c: CHAR;
+
 BEGIN
     IF text.pos < text.size - 1 THEN
-        INC(text.pos)
+        INC(text.pos);
+        text.peak := CHR(text.chunk[text.pos])
     ELSE
         load(text)
     END;
 
     IF ~text.eof THEN
 
-        c := peak(text);
+        c := text.peak;
 
         IF c = CR THEN
             INC(text.line);
@@ -123,7 +103,6 @@ END next;
 
 PROCEDURE init (text: TEXT);
 BEGIN
-
     IF (text.pos = 0) & (text.size >= 3) THEN
         IF (text.chunk[0] = 0EFH) &
            (text.chunk[1] = 0BBH) &
@@ -140,27 +119,26 @@ BEGIN
     END;
 
     text.line := 1;
-    text.col  := 1
+    text.col  := 1;
 
+    text.peak := CHR(text.chunk[text.pos])
 END init;
 
 
-PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE close* (VAR text: TEXT);
 BEGIN
-    ASSERT(text # NIL);
+    IF text # NIL THEN
-
-    reset(text);
-    text.file := FILES.open(name);
         IF text.file # NIL THEN
-        load(text);
+            FILES.close(text.file)
-        init(text)
+        END;
+
+        C.push(texts, text);
+        text := NIL
     END
-
+END close;
-    RETURN text.file # NIL
-END open;
 
 
-PROCEDURE NewText (): TEXT;
+PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
 VAR
     text: TEXT;
     citem: C.ITEM;
@@ -171,37 +149,30 @@ BEGIN
         NEW(text)
     ELSE
         text := citem(TEXT)
-    END
-
-    RETURN text
-END NewText;
-
-
-PROCEDURE create* (): TEXT;
-VAR
-    text: TEXT;
-BEGIN
-    text := NewText();
-    reset(text);
-    text.open  := open;
-    text.peak  := peak;
-    text.nextc := next
-
-    RETURN text
-END create;
-
-
-PROCEDURE destroy* (VAR text: TEXT);
-BEGIN
-    IF text # NIL THEN
-        IF text.file # NIL THEN
-            FILES.close(text.file)
     END;
 
-        C.push(texts, text);
+    IF text # NIL THEN
-        text := NIL
+        text.chunk[0] := 0;
+        text.pos  := 0;
+        text.size := 0;
+        text.utf8 := FALSE;
+        text.CR   := FALSE;
+        text.line := 1;
+        text.col  := 1;
+        text.eof  := FALSE;
+        text.eol  := FALSE;
+        text.peak := 0X;
+        text.file := FILES.open(name);
+        IF text.file # NIL THEN
+            load(text);
+            init(text)
+        ELSE
+            close(text)
         END
-END destroy;
+    END
+
+    RETURN text
+END open;
 
 
 BEGIN

programs/develop/oberon07/Source/UNIXTIME.ob07

@@ -1,7 +1,7 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
@@ -55,12 +55,7 @@ END init;
 
 
 PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER;
-VAR
+    RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
-    d, s: INTEGER;
-BEGIN
-    d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4;
-    s := d * 86400 + hour * 3600 + min * 60 + sec
-    RETURN s
 END time;
 
 

programs/develop/oberon07/Source/UTILS.ob07

@@ -20,6 +20,9 @@ CONST
 
     OS = HOST.OS;
 
+    min32* = -2147483647-1;
+    max32* =  2147483647;
+
 
 VAR
 
@@ -29,6 +32,22 @@ VAR
 
     maxreal*: REAL;
 
+    target*:
+
+      RECORD
+
+          bit_depth*,
+          maxInt*,
+          minInt*,
+          maxSet*,
+          maxHex*:    INTEGER;
+
+          maxReal*:   REAL
+
+      END;
+
+    bit_diff*: INTEGER;
+
 
 PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
     RETURN HOST.FileRead(F, Buffer, bytes)
@@ -112,6 +131,76 @@ BEGIN
 END UnixTime;
 
 
+PROCEDURE SetBitDepth* (BitDepth: INTEGER);
+BEGIN
+    ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
+    bit_diff := bit_depth - BitDepth;
+    ASSERT(bit_diff >= 0);
+
+    target.bit_depth := BitDepth;
+    target.maxSet    := BitDepth - 1;
+    target.maxHex    := BitDepth DIV 4;
+    target.minInt    := ASR(minint, bit_diff);
+    target.maxInt    := ASR(maxint, bit_diff);
+    target.maxReal   := 1.9;
+    PACK(target.maxReal, 1023);
+END SetBitDepth;
+
+
+PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE;
+    RETURN ASR(n, 8 * idx) MOD 256
+END Byte;
+
+
+PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF bytes MOD align # 0 THEN
+        res := maxint - bytes >= align - (bytes MOD align);
+        IF res THEN
+            bytes := bytes + align - (bytes MOD align)
+        END
+    ELSE
+        res := TRUE
+    END
+
+    RETURN res
+END Align;
+
+
+PROCEDURE Long* (value: INTEGER): INTEGER;
+    RETURN ASR(LSL(value, bit_diff), bit_diff)
+END Long;
+
+
+PROCEDURE Short* (value: INTEGER): INTEGER;
+    RETURN LSR(LSL(value, bit_diff), bit_diff)
+END Short;
+
+
+PROCEDURE Log2* (x: INTEGER): INTEGER;
+VAR
+    n: INTEGER;
+
+BEGIN
+    ASSERT(x > 0);
+
+    n := 0;
+    WHILE ~ODD(x) DO
+        x := x DIV 2;
+        INC(n)
+    END;
+
+    IF x # 1 THEN
+        n := -1
+    END
+
+    RETURN n
+END Log2;
+
+
 BEGIN
     time := GetTickCount();
     COPY(HOST.eol, eol);

programs/develop/oberon07/Source/WRITER.ob07

@@ -1,13 +1,13 @@
 (*
     BSD 2-Clause License
 
-    Copyright (c) 2018, Anton Krotov
+    Copyright (c) 2018, 2019, Anton Krotov
     All rights reserved.
 *)
 
 MODULE WRITER;
 
-IMPORT FILES, ERRORS, MACHINE;
+IMPORT FILES, ERRORS, UTILS;
 
 
 TYPE
@@ -35,7 +35,7 @@ BEGIN
     IF FILES.WriteByte(file, n) THEN
         INC(counter)
     ELSE
-        ERRORS.error1("writing file error")
+        ERRORS.Error(201)
     END
 END WriteByte;
 
@@ -47,7 +47,7 @@ VAR
 BEGIN
     n := FILES.write(file, chunk, bytes);
     IF n # bytes THEN
-        ERRORS.error1("writing file error")
+        ERRORS.Error(201)
     END;
     INC(counter, n)
 END Write;
@@ -59,7 +59,7 @@ VAR
 
 BEGIN
     FOR i := 0 TO 7 DO
-        WriteByte(file, MACHINE.Byte(n, i))
+        WriteByte(file, UTILS.Byte(n, i))
     END
 END Write64LE;
 
@@ -70,15 +70,15 @@ VAR
 
 BEGIN
     FOR i := 0 TO 3 DO
-        WriteByte(file, MACHINE.Byte(n, i))
+        WriteByte(file, UTILS.Byte(n, i))
     END
 END Write32LE;
 
 
 PROCEDURE Write16LE* (file: FILE; n: INTEGER);
 BEGIN
-    WriteByte(file, MACHINE.Byte(n, 0));
+    WriteByte(file, UTILS.Byte(n, 0));
-    WriteByte(file, MACHINE.Byte(n, 1))
+    WriteByte(file, UTILS.Byte(n, 1))
 END Write16LE;