Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 7106 → Rev 7107

/programs/develop/oberon07/Compiler.kex
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/programs/develop/oberon07/Docs/About1251.txt
30,7 → 30,6
ïåðåäàåòñÿ. Ñîîáùåíèÿ êîìïèëÿòîðà âûâîäÿòñÿ íà êîíñîëü (Windows,
KolibriOS), â òåðìèíàë (Linux).
2. Ïàïêà Lib - áèáëèîòåêà ìîäóëåé
3. Ïàïêà Source - èñõîäíûé êîä êîìïèëÿòîðà
 
------------------------------------------------------------------------------
Îòëè÷èÿ îò îðèãèíàëà
45,6 → 44,8
7. Ñåìàíòèêà DIV è MOD óòî÷íåíà äëÿ îòðèöàòåëüíûõ ÷èñåë
8. Äîáàâëåíû îäíîñòðî÷íûå êîììåíòàðèè (íà÷èíàþòñÿ ñ ïàðû ñèìâîëîâ "//")
9. Ðàçðåøåí ýêñïîðò ïåðåìåííûõ òèïîâ ARRAY è RECORD (òîëüêî äëÿ ÷òåíèÿ)
10. Ðàçðåøåíî íàñëåäîâàíèå îò òèïà-óêàçàòåëÿ
11. Äîáàâëåíû ïñåâäîíèìû òèïîâ (TYPE A = B)
 
------------------------------------------------------------------------------
Îñîáåííîñòè ðåàëèçàöèè
103,6 → 104,11
Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest,
îáëàñòè Source è Dest íå äîëæíû ïåðåêðûâàòüñÿ
 
PROCEDURE COPY(VAR Source: ëþáîé òèï; VAR Dest: ëþáîé òèï; n: INTEGER)
Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest.
Ýêâèâàëåíòíî
SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
 
PROCEDURE CODE(s: ARRAY OF CHAR)
Âñòàâêà ìàøèííîãî êîäà
s - ñòðîêîâàÿ êîíñòàíòà øåñòíàäöàòèðè÷íûõ öèôð
198,6 → 204,12
LSR(x, n: INTEGER): INTEGER
Ëîãè÷åñêèé ñäâèã x íà n áèò âïðàâî.
 
MIN(a, b: INTEGER): INTEGER
Ìèíèìóì èç äâóõ çíà÷åíèé.
 
MAX(a, b: INTEGER): INTEGER
Ìàêñèìóì èç äâóõ çíà÷åíèé.
 
BITS(x: INTEGER): SET
Èíòåðïðåòèðóåò x êàê çíà÷åíèå òèïà SET.
Âûïîëíÿåòñÿ íà ýòàïå êîìïèëÿöèè.
853,4 → 865,6
MODULE RasterWorks - îáåðòêà áèáëèîòåêè Rasterworks.obj
------------------------------------------------------------------------------
MODULE libimg - îáåðòêà áèáëèîòåêè libimg.obj
------------------------------------------------------------------------------
MODULE NetDevices - îáåðòêà äëÿ ô.74 (ðàáîòà ñ ñåòåâûìè óñòðîéñòâàìè)
------------------------------------------------------------------------------
/programs/develop/oberon07/Docs/About866.txt
30,7 → 30,6
¯¥à¥¤ ¥âáï. ‘®®¡é¥­¨ï ª®¬¯¨«ïâ®à  ¢ë¢®¤ïâáï ­  ª®­á®«ì (Windows,
KolibriOS), ¢ â¥à¬¨­ « (Linux).
2.  ¯ª  Lib - ¡¨¡«¨®â¥ª  ¬®¤ã«¥©
3.  ¯ª  Source - ¨á室­ë© ª®¤ ª®¬¯¨«ïâ®à 
 
------------------------------------------------------------------------------
Žâ«¨ç¨ï ®â ®à¨£¨­ « 
45,6 → 44,8
7. ‘¥¬ ­â¨ª  DIV ¨ MOD ãâ®ç­¥­  ¤«ï ®âà¨æ â¥«ì­ëå ç¨á¥«
8. „®¡ ¢«¥­ë ®¤­®áâà®ç­ë¥ ª®¬¬¥­â à¨¨ (­ ç¨­ îâáï á ¯ àë ᨬ¢®«®¢ "//")
9.  §à¥è¥­ íªá¯®àâ ¯¥à¥¬¥­­ëå ⨯®¢ ARRAY ¨ RECORD (⮫쪮 ¤«ï ç⥭¨ï)
10.  §à¥è¥­® ­ á«¥¤®¢ ­¨¥ ®â ⨯ -㪠§ â¥«ï
11. „®¡ ¢«¥­ë ¯á¥¢¤®­¨¬ë ⨯®¢ (TYPE A = B)
 
------------------------------------------------------------------------------
Žá®¡¥­­®á⨠ॠ«¨§ æ¨¨
103,6 → 104,11
Š®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest,
®¡« á⨠Source ¨ Dest ­¥ ¤®«¦­ë ¯¥à¥ªà뢠âìáï
 
PROCEDURE COPY(VAR Source: «î¡®© ⨯; VAR Dest: «î¡®© ⨯; n: INTEGER)
Š®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest.
ª¢¨¢ «¥­â­®
SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
 
PROCEDURE CODE(s: ARRAY OF CHAR)
‚áâ ¢ª  ¬ è¨­­®£® ª®¤ 
s - áâப®¢ ï ª®­áâ ­â  è¥áâ­ ¤æ â¨à¨ç­ëå æ¨äà
198,6 → 204,12
LSR(x, n: INTEGER): INTEGER
‹®£¨ç¥áª¨© ᤢ¨£ x ­  n ¡¨â ¢¯à ¢®.
 
MIN(a, b: INTEGER): INTEGER
Œ¨­¨¬ã¬ ¨§ ¤¢ãå §­ ç¥­¨©.
 
MAX(a, b: INTEGER): INTEGER
Œ ªá¨¬ã¬ ¨§ ¤¢ãå §­ ç¥­¨©.
 
BITS(x: INTEGER): SET
ˆ­â¥à¯à¥â¨àã¥â x ª ª §­ ç¥­¨¥ ⨯  SET.
‚믮«­ï¥âáï ­  íâ ¯¥ ª®¬¯¨«ï樨.
853,4 → 865,6
MODULE RasterWorks - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ Rasterworks.obj
------------------------------------------------------------------------------
MODULE libimg - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ libimg.obj
------------------------------------------------------------------------------
MODULE NetDevices - ®¡¥à⪠ ¤«ï ä.74 (à ¡®â  á á¥â¥¢ë¬¨ ãáâனá⢠¬¨)
------------------------------------------------------------------------------
/programs/develop/oberon07/Lib/KolibriOS/API.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
166,6 → 166,11
p1 := sysfunc1(-1)
END ExitProcess;
 
PROCEDURE ExitThread*(p1: INTEGER);
BEGIN
p1 := sysfunc1(-1)
END ExitThread;
 
PROCEDURE OutChar(c: CHAR);
VAR res: INTEGER;
BEGIN
/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
41,40 → 41,6
 
fsize, sec*, dsec*: INTEGER;
 
PROCEDURE [stdcall] sysfunc1(arg1: INTEGER): INTEGER;
BEGIN
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20400"); (* ret 04h *)
RETURN 0
END sysfunc1;
 
PROCEDURE [stdcall] sysfunc2(arg1, arg2: INTEGER): INTEGER;
BEGIN
sys.CODE("53"); (* push ebx *)
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("5B"); (* pop ebx *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20800"); (* ret 08h *)
RETURN 0
END sysfunc2;
 
PROCEDURE [stdcall] sysfunc3(arg1, arg2, arg3: INTEGER): INTEGER;
BEGIN
sys.CODE("53"); (* push ebx *)
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *)
sys.CODE("CD40"); (* int 40h *)
sys.CODE("5B"); (* pop ebx *)
sys.CODE("C9"); (* leave *)
sys.CODE("C20C00"); (* ret 0Ch *)
RETURN 0
END sysfunc3;
 
PROCEDURE [stdcall] sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
BEGIN
sys.CODE("53"); (* push ebx *)
122,7 → 88,7
PROCEDURE Time*(VAR sec, dsec: INTEGER);
VAR t: INTEGER;
BEGIN
t := sysfunc2(26, 9);
t := API.sysfunc2(26, 9);
sec := t DIV 100;
dsec := t MOD 100
END Time;
139,7 → 105,7
 
BEGIN
Time(sec, dsec);
Lib := sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
Lib := API.sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
IF Lib # 0 THEN
GetProc(sys.ADR(con_init), "con_init");
GetProc(sys.ADR(con_exit), "con_exit");
155,7 → 121,7
IF con_exit # NIL THEN
con_exit(FALSE)
END;
n := sysfunc1(-1)
API.ExitProcess(0)
END ExitProcess;
 
PROCEDURE GetCommandLine*(): INTEGER;
173,7 → 139,7
END GetName;
 
PROCEDURE malloc*(size: INTEGER): INTEGER;
RETURN sysfunc3(68, 12, size)
RETURN API.sysfunc3(68, 12, size)
END malloc;
 
PROCEDURE CloseFile*(hObject: INTEGER);
/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07
0,0 → 1,107
(*
Copyright 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
 
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
 
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
 
MODULE NetDevices;
 
IMPORT sys := SYSTEM, K := KOSAPI;
 
 
CONST
 
//net devices types
 
LOOPBACK* = 0;
ETH* = 1;
SLIP* = 2;
 
//Link status
 
LINK_DOWN* = 0;
LINK_UNKNOWN* = 1;
LINK_FD* = 2; //full duplex flag
LINK_10M* = 4;
LINK_100M* = 8;
LINK_1G* = 12;
 
 
TYPE
 
DEVICENAME* = ARRAY 64 OF CHAR;
 
 
PROCEDURE Number* (): INTEGER;
RETURN K.sysfunc2(74, -1)
END Number;
 
 
PROCEDURE Type* (num: INTEGER): INTEGER;
RETURN K.sysfunc2(74, num * 256)
END Type;
 
 
PROCEDURE Name* (num: INTEGER; VAR name: DEVICENAME): BOOLEAN;
VAR err: BOOLEAN;
BEGIN
err := K.sysfunc3(74, num * 256 + 1, sys.ADR(name[0])) = -1;
IF err THEN
name := ""
END
RETURN ~err
END Name;
 
 
PROCEDURE Reset* (num: INTEGER): BOOLEAN;
RETURN K.sysfunc2(74, num * 256 + 2) # -1
END Reset;
 
 
PROCEDURE Stop* (num: INTEGER): BOOLEAN;
RETURN K.sysfunc2(74, num * 256 + 3) # -1
END Stop;
 
 
PROCEDURE Pointer* (num: INTEGER): INTEGER;
RETURN K.sysfunc2(74, num * 256 + 4)
END Pointer;
 
 
PROCEDURE SentPackets* (num: INTEGER): INTEGER;
RETURN K.sysfunc2(74, num * 256 + 6)
END SentPackets;
 
 
PROCEDURE ReceivedPackets* (num: INTEGER): INTEGER;
RETURN K.sysfunc2(74, num * 256 + 7)
END ReceivedPackets;
 
 
PROCEDURE SentBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
RETURN K.sysfunc22(74, num * 256 + 8, hValue)
END SentBytes;
 
 
PROCEDURE ReceivedBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
RETURN K.sysfunc22(74, num * 256 + 9, hValue)
END ReceivedBytes;
 
 
PROCEDURE LinkStatus* (num: INTEGER): INTEGER;
RETURN K.sysfunc2(74, num * 256 + 10)
END LinkStatus;
 
 
END NetDevices.
/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
28,6 → 28,7
VAR
 
SelfName, rtab: INTEGER; CloseProc: PROC;
init: BOOLEAN;
 
PROCEDURE [stdcall] _halt*(n: INTEGER);
BEGIN
116,14 → 117,6
END
END _arrayrot;
 
PROCEDURE Min(a, b: INTEGER): INTEGER;
BEGIN
IF a > b THEN
a := b
END
RETURN a
END Min;
 
PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
BEGIN
sys.CODE("8B4508"); // mov eax, [ebp + 08h]
144,7 → 137,7
 
PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
BEGIN
_savearr(Min(alen, blen), a, b);
_savearr(MIN(alen, blen), a, b);
IF blen > alen THEN
sys.PUT(b + alen, 0X)
END
153,7 → 146,7
PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; Res: BOOLEAN;
BEGIN
i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));
i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
IF i = 0 THEN
i := _length(a) - _length(b)
END;
252,7 → 245,8
Int(code, int);
StrAppend(int)
END;
API.DebugMsg(sys.ADR(msg), SelfName)
API.DebugMsg(sys.ADR(msg), SelfName);
API.ExitThread(0)
END _assrt;
 
PROCEDURE [stdcall] _close*;
264,11 → 258,14
 
PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
BEGIN
IF ~init THEN
API.zeromem(gsize, gadr);
init := TRUE;
API.init(esp);
SelfName := self;
rtab := rec;
CloseProc := NIL
END
END _init;
 
PROCEDURE SetClose*(proc: PROC);
/programs/develop/oberon07/Lib/Linux32/API.ob07
1,4 → 1,4
(*
(*
Copyright 2016 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
103,6 → 103,11
exit(code)
END ExitProcess;
 
PROCEDURE ExitThread* (code: INTEGER);
BEGIN
exit(code)
END ExitThread;
 
PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER);
VAR H: INTEGER;
BEGIN
/programs/develop/oberon07/Lib/Linux32/RTL.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
(*
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
28,6 → 28,7
VAR
 
SelfName, rtab: INTEGER; CloseProc: PROC;
init: BOOLEAN;
 
PROCEDURE [stdcall] _halt*(n: INTEGER);
BEGIN
116,14 → 117,6
END
END _arrayrot;
 
PROCEDURE Min(a, b: INTEGER): INTEGER;
BEGIN
IF a > b THEN
a := b
END
RETURN a
END Min;
 
PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
BEGIN
sys.CODE("8B4508"); // mov eax, [ebp + 08h]
144,7 → 137,7
 
PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
BEGIN
_savearr(Min(alen, blen), a, b);
_savearr(MIN(alen, blen), a, b);
IF blen > alen THEN
sys.PUT(b + alen, 0X)
END
153,7 → 146,7
PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; Res: BOOLEAN;
BEGIN
i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));
i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
IF i = 0 THEN
i := _length(a) - _length(b)
END;
252,7 → 245,8
Int(code, int);
StrAppend(int)
END;
API.DebugMsg(sys.ADR(msg), SelfName)
API.DebugMsg(sys.ADR(msg), SelfName);
API.ExitThread(0)
END _assrt;
 
PROCEDURE [stdcall] _close*;
264,11 → 258,14
 
PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
BEGIN
IF ~init THEN
API.zeromem(gsize, gadr);
init := TRUE;
API.init(esp);
SelfName := self;
rtab := rec;
CloseProc := NIL;
CloseProc := NIL
END
END _init;
 
PROCEDURE SetClose*(proc: PROC);
/programs/develop/oberon07/Lib/Windows32/API.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
(*
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
25,6 → 25,8
Free*: PROCEDURE [winapi] (hMem: INTEGER): INTEGER;
MessageBoxA*: PROCEDURE [winapi] (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
ExitThread*: PROCEDURE [winapi] (code: INTEGER);
GetCurrentThreadId*: PROCEDURE [winapi] (): INTEGER;
strncmp*: PROCEDURE [cdecl] (a, b, n: INTEGER): INTEGER;
 
GetProcAddress*: PROCEDURE [winapi] (hModule, name: INTEGER): INTEGER;
62,6 → 64,8
 
lib := LoadLibraryA(sys.ADR("kernel32.dll"));
GetProc("ExitProcess", lib, sys.ADR(ExitProcess));
GetProc("ExitThread", lib, sys.ADR(ExitThread));
GetProc("GetCurrentThreadId", lib, sys.ADR(GetCurrentThreadId));
GetProc("GlobalAlloc", lib, sys.ADR(Alloc));
GetProc("GlobalFree", lib, sys.ADR(Free));
 
/programs/develop/oberon07/Lib/Windows32/HOST.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
(*
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
49,7 → 49,6
ReadFile, WriteFile: PROCEDURE [winapi] (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped: INTEGER): INTEGER;
GetCommandLine*: PROCEDURE [winapi] (): INTEGER;
GetTickCount: PROCEDURE [winapi] (): INTEGER;
Alloc: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER;
ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
 
112,7 → 111,7
END Time;
 
PROCEDURE malloc*(size: INTEGER): INTEGER;
RETURN Alloc(64, size)
RETURN API.Alloc(64, size)
END malloc;
 
PROCEDURE init*;
128,9 → 127,8
GetProc("ReadFile", lib, sys.ADR(ReadFile));
GetProc("WriteFile", lib, sys.ADR(WriteFile));
GetProc("GetCommandLineA", lib, sys.ADR(GetCommandLine));
GetProc("ExitProcess", lib, sys.ADR(ExitProcess));
GetProc("GlobalAlloc", lib, sys.ADR(Alloc));
GetProc("SetFilePointer", lib, sys.ADR(SetFilePointer));
ExitProcess := API.ExitProcess;
hConsoleOutput := GetStdHandle(-11)
END init;
 
/programs/develop/oberon07/Lib/Windows32/RTL.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
(*
Copyright 2016, 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
28,6 → 28,8
VAR
 
SelfName, rtab: INTEGER; CloseProc: PROC;
init: BOOLEAN;
main_thread_id: INTEGER;
 
PROCEDURE [stdcall] _halt*(n: INTEGER);
BEGIN
116,14 → 118,6
END
END _arrayrot;
 
PROCEDURE Min(a, b: INTEGER): INTEGER;
BEGIN
IF a > b THEN
a := b
END
RETURN a
END Min;
 
PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
BEGIN
sys.CODE("8B4508"); // mov eax, [ebp + 08h]
144,7 → 138,7
 
PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
BEGIN
_savearr(Min(alen, blen), a, b);
_savearr(MIN(alen, blen), a, b);
IF blen > alen THEN
sys.PUT(b + alen, 0X)
END
153,7 → 147,7
PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; Res: BOOLEAN;
BEGIN
i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));
i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
IF i = 0 THEN
i := _length(a) - _length(b)
END;
252,7 → 246,11
Int(code, int);
StrAppend(int)
END;
API.DebugMsg(sys.ADR(msg), SelfName)
IF API.GetCurrentThreadId() = main_thread_id THEN
API.ExitProcess(0)
ELSE
API.ExitThread(0)
END
END _assrt;
 
PROCEDURE [stdcall] _close*;
264,11 → 262,15
 
PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
BEGIN
IF ~init THEN
API.zeromem(gsize, gadr);
init := TRUE;
API.init(esp);
main_thread_id := API.GetCurrentThreadId();
SelfName := self;
rtab := rec;
CloseProc := NIL;
CloseProc := NIL
END
END _init;
 
PROCEDURE SetClose*(proc: PROC);
/programs/develop/oberon07/Source/Compiler.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This file is part of Compiler.
 
52,10 → 52,10
stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8;
stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15;
stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22;
stBITS = 23; stLSR = 24; stLENGTH = 25;
stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27;
 
sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109;
 
TYPE
 
394,7 → 394,9
IntType(b.T, coord);
IF b.eType = eCONST THEN
Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53);
IF a.eType = eCONST THEN
Assert(a.Value <= b.Value, coord, 54)
END
END;
Load(b)
ELSE
615,6 → 617,32
Str(e1);
e.T := inttype;
X86.StFunc(X86.stLENGTH)
|stMIN, stMAX:
pExpr(e1);
IntType(e1.T, coord);
Load(e1);
Check(lxComma);
NextCoord(coord);
pExpr(e2);
IntType(e2.T, coord);
Load(e2);
IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN
a := FLOOR(e1.Value);
b := FLOOR(e2.Value);
CASE func OF
|stMIN: a := MIN(a, b)
|stMAX: a := MAX(a, b)
ELSE
END;
e.Value := LONG(FLT(a));
e.eType := eCONST
END;
IF func = stMIN THEN
X86.StFunc(X86.stMIN)
ELSE
X86.StFunc(X86.stMAX)
END;
e.T := inttype
|sysADR:
Assert((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxSTRING) OR (SCAN.tLex = lxCHX), coord, 43);
IF SCAN.tLex = lxIDENT THEN
1636,12 → 1664,29
Expr(e1);
IntType(e1.T, coord);
Load(e1);
|sysCOPY:
begcall := X86.current;
Designator(e1);
Assert(e1.eType = eVAR, coord, 63);
Check(lxComma);
X86.PushCall(begcall);
X86.Param;
NextCoord(coord);
Designator(e1);
Assert(e1.eType = eVAR, coord, 63);
Assert(~e1.Read, coord, 115);
Check(lxComma);
X86.EndCall;
NextCoord(coord);
Expr(e1);
IntType(e1.T, coord);
Load(e1);
ELSE
Assert(FALSE, coord2, 132)
END;
Check(lxRRound);
Next;
IF proc = sysMOVE THEN
IF (proc = sysMOVE) OR (proc = sysCOPY) THEN
X86.StProc(X86.sysMOVE)
END
END StProc;
1678,7 → 1723,7
IF s.Len = 1 THEN
X86.Mono(s.Number)
END;
X86.PushConst(UTILS.min(s.Len + 1, e1.T.Len))
X86.PushConst(MIN(s.Len + 1, e1.T.Len))
END;
X86.Save(e1.T.tType)
ELSIF e1.eType = ePROC THEN
/programs/develop/oberon07/Source/DECL.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This file is part of Compiler.
 
43,10 → 43,10
stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8;
stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15;
stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22;
stBITS = 23; stLSR = 24; stLENGTH = 25;
stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27;
 
sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108;
sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109;
 
TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; TNIL = 8;
TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
417,6 → 417,8
PushStProc("BITS", stBITS);
PushStProc("LSR", stLSR);
PushStProc("LENGTH", stLENGTH);
PushStProc("MIN", stMIN);
PushStProc("MAX", stMAX);
Guard
END StIdent;
 
1054,6 → 1056,9
Check(lxIDENT);
nov.Base := IdType(coord);
Assert(nov.Base # NIL, coord, 42);
IF (nov.Base.tType = TPOINTER) & (nov.Base.Base.tType = TRECORD) THEN
nov.Base := nov.Base.Base
END;
Assert(nov.Base.tType = TRECORD, coord, 80);
Assert(notrecurs(TRUE, nov.Base), coord, 96);
nov.Size := nov.Base.Size;
1194,10 → 1199,16
last := unit.Idents.Last(IDENT);
Check(lxEQ);
Next;
 
IF SCAN.tLex = lxIDENT THEN
last.T := ParseType(coord)
ELSE
NEW(NewType);
MemErr(NewType = NIL);
last.T := NewType;
T := StructType(FALSE, NewType);
T := StructType(FALSE, NewType)
END;
 
Check(lxSemi);
Next
END
1416,6 → 1427,7
PushSysProc("PUT", sysPUT);
PushSysProc("CODE", sysCODE);
PushSysProc("MOVE", sysMOVE);
PushSysProc("COPY", sysCOPY);
PushSysProc("INF", sysINF);
PushSysType("CARD16", TCARD16);
sys := unit;
/programs/develop/oberon07/Source/ERRORS.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This file is part of Compiler.
 
200,7 → 200,7
| 77: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ "
| 78: str := "¤«¨­  ⨯ -¬ áᨢ  ¤®«¦­  ¡ëâì ¡®«ìè¥ ­ã«ï"
| 79: str := "®¦¨¤ «®áì 'OF' ¨«¨ ','"
| 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨"
| 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨ ¨«¨ ⨯ -㪠§ â¥«ï"
| 81: str := "¡ §®¢ë© ⨯ ⨯ -㪠§ â¥«ï ¤®«¦¥­ ¡ëâì § ¯¨áìî"
| 82: str := "⨯ १ã«ìâ â  ¯à®æ¥¤ãàë ­¥ ¬®¦¥â ¡ëâì § ¯¨áìî ¨«¨ ¬ áᨢ®¬"
| 83: str := "à §¬¥à ⨯  ᫨誮¬ ¢¥«¨ª"
/programs/develop/oberon07/Source/UTILS.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This file is part of Compiler.
 
28,7 → 28,7
Ext* = ".ob07";
MAX_PATH = 1024;
MAX_PARAM = 1024;
Date* = 1451606400; (* 2016-01-01 *)
Date* = 1509580800; (* 2017-11-02 *)
 
TYPE
 
199,14 → 199,6
Line := newLine
END UnitLine;
 
PROCEDURE min*(a, b: INTEGER): INTEGER;
BEGIN
IF a > b THEN
a := b
END
RETURN a
END min;
 
PROCEDURE Align*(n: INTEGER): INTEGER;
RETURN (4 - n MOD 4) MOD 4
END Align;
/programs/develop/oberon07/Source/X86.ob07
1,5 → 1,5
(*
Copyright 2016 Anton Krotov
Copyright 2016, 2017 Anton Krotov
 
This file is part of Compiler.
 
36,7 → 36,7
stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19;
stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24;
stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29;
stLENGTH* = 30;
stLENGTH* = 30; stMIN* = 31; stMAX* = 32;
 
sysMOVE* = 108;
 
1232,7 → 1232,9
|stASR: PopECX; OutCode("58D3F8"); PushEAX
|stLSL: PopECX; OutCode("58D3E0"); PushEAX
|stLSR: PopECX; OutCode("58D3E8"); PushEAX
|stORD: PopEDX; OutCode("85D274036A015A"); PushEDX
|stORD: PopEDX; OutCode("85D274036A015A"); PushEDX;
|stMIN: PopEDX; OutCode("3914247E025852");
|stMAX: PopEDX; OutCode("3B14247E025852");
|stLENGTH: CallRTL(_length); PushEAX
ELSE
END
1269,12 → 1271,12
|TCHAR, TBOOLEAN:
IF lastcmd.tcmd = ECMD THEN
del;
OutCode("33D28A");
OutCode("0FB6");
IntByte("55", "95", offset);
PushEDX
ELSE
PopEDX;
OutCode("33C98A0A");
OutCode("0FB60A");
PushECX
END
|TLONGREAL: